prints

app/Builtins.hs

@@ -4,6 +4,7 @@ import Code
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.State.Lazy
+import Data.List (intercalate)
 import qualified Data.Map as M
 import Env hiding (PrlgEnv)
 import qualified IR
@@ -13,10 +14,20 @@ import System.Console.Haskeline
 
 bi = Builtin
 
-hello :: BuiltinFn
-hello = do
-  liftIO $ putStrLn "hllo prlg"
-  return Nothing
+showTerm itos heap visited ref
+  | ref `elem` visited = "_Rec" ++ show ref
+  | HeapRef r <- heap M.! ref =
+    if r == ref
+      then "_X" ++ show ref
+      else showTerm itos heap (ref : visited) r
+  | Struct (IR.Id h arity) <- heap M.! ref =
+    itos M.! h ++
+    "(" ++
+    intercalate
+      ","
+      [showTerm itos heap (ref : visited) (ref + i) | i <- [1 .. arity]] ++
+    ")"
+  | Atom a <- heap M.! ref = itos M.! a
 
 printLocals :: BuiltinFn
 printLocals = do
@@ -24,7 +35,7 @@ printLocals = do
   Heap _ heap <- gets (heap . cur)
   IR.StrTable _ _ itos <- gets strtable
   flip traverse (M.elems scope) $ \(ref, name) ->
-    lift . outputStrLn $ (itos M.! name) ++ " = " ++ show (heap M.! ref)
+    lift . outputStrLn $ (itos M.! name) ++ " = " ++ showTerm itos heap [] ref
   return Nothing
 
 promptRetry :: BuiltinFn
@@ -34,6 +45,22 @@ promptRetry = do
     Just ';' -> backtrack
     _ -> return Nothing
 
+write :: BuiltinFn
+write = do
+  scope <- gets (hvar . cur)
+  Heap _ heap <- gets (heap . cur)
+  IR.StrTable _ _ itos <- gets strtable
+  lift . outputStr $ showTerm itos heap [] (fst $ scope M.! 0)
+  return Nothing
+
+nl :: BuiltinFn
+nl = do
+  lift $ outputStrLn ""
+  return Nothing
+
+writeln :: BuiltinFn
+writeln = write >> nl
+
 addBuiltins :: PrlgEnv ()
 addBuiltins = do
   a1 <- findStruct "a" 1
@@ -50,24 +77,29 @@ addBuiltins = do
   printlocals0 <- findStruct "print_locals" 0
   debugprint0 <- findStruct "interpreter_state" 0
   promptretry0 <- findStruct "prompt_retry" 0
+  write1 <- findStruct "write" 1
+  writeln1 <- findStruct "writeln" 1
+  nl0 <- findStruct "nl" 0
   modify $ \s ->
     s
       { defs =
           M.fromList
             [ (eq2, [[U (LocalRef 0 varX), U (LocalRef 0 varX), NoGoal]])
-            , (a1, [[U (Atom a), NoGoal], [U (Atom b), NoGoal]])
-            , ( b0
-              , [ [Goal, U (Struct a1), U (Atom c), LastCall]
-                , [Goal, U (Struct a1), U (Atom b), LastCall]
-                ])
             , (any1, [[U VoidRef, NoGoal]])
-            , (hello0, [[Invoke $ bi hello]])
             , (fail0, [[Invoke $ bi backtrack]])
             , (true0, [[Invoke $ bi (pure Nothing)]])
             , ( debugprint0
               , [[Invoke $ bi (get >>= liftIO . print >> pure Nothing)]])
             , (printlocals0, [[Invoke $ bi printLocals]])
             , (promptretry0, [[Invoke $ bi promptRetry]])
+            , (write1, [[U (LocalRef 0 varX), Invoke $ bi write]])
+            , (writeln1, [[U (LocalRef 0 varX), Invoke $ bi writeln]])
+            , (nl0, [[Invoke $ bi nl]])
+            , (a1, [[U (Atom a), NoGoal], [U (Atom b), NoGoal]])
+            , ( b0
+              , [ [Goal, U (Struct a1), U (Atom c), LastCall]
+                , [Goal, U (Struct a1), U (Atom b), LastCall]
+                ])
             ]
       , ops = [(O.xfy "," 1000), (O.xfx "=" 700)]
       }

app/Frontend.hs

@@ -73,7 +73,7 @@ interpreterStart = do
 
 interpreterLoop :: PrlgEnv ()
 interpreterLoop = do
-  minput <- lift $ getInputLine "prlg> "
+  minput <- lift $ getInputLine "π> "
   case minput of
     Nothing -> return ()
     Just input -> do