-ddump-eval

src/Compiler/RLPC.hs

@@ -187,9 +187,9 @@ prettyRlpcMsg m                                  = render $ docRlpcErr m
 
 prettyRlpcDebugMsg :: MsgEnvelope RlpcError -> String
 prettyRlpcDebugMsg msg =
-        T.unpack . foldMap mkLine $ ts
+        T.unpack . foldMap mkLine $ [ t' | t <- ts, t' <- T.lines t ]
     where
-        mkLine s = tag <> ": " <> s <> "\n"
+        mkLine s = "-d" <> tag <> ": " <> s <> "\n"
         Text ts = msg ^. msgDiagnostic
         SevDebug tag = msg ^. msgSeverity
 

src/GM.hs

@@ -8,6 +8,7 @@ Description : The G-Machine
 module GM
     ( hdbgProg
     , evalProg
+    , evalProgR
     , Node(..)
     , gmEvalProg
     , finalStateOf
@@ -34,6 +35,7 @@ import System.IO                    (Handle, hPutStrLn)
 import Data.String                  (IsString)
 import Data.Heap
 import Debug.Trace
+import Compiler.RLPC
 import Core2Core
 import Core
 ----------------------------------------------------------------------------------
@@ -156,6 +158,21 @@ hdbgProg p hio = do
         [resAddr] = final ^. gmStack
         res = hLookupUnsafe resAddr h
 
+evalProgR :: (Monad m) => Program' -> RLPCT m (Node, Stats)
+evalProgR p = do
+    (renderOut . showState) `traverse_` states
+    renderOut . showStats $ sts
+    pure (res, sts)
+    where
+        renderOut r = addDebugMsg "dump-eval" $ render r ++ "\n"
+        states = eval . compile $ p
+        final = last states
+
+        sts = final ^. gmStats
+        -- the address of the result should be the one and only stack entry
+        [resAddr] = final ^. gmStack
+        res = hLookupUnsafe resAddr (final ^. gmHeap)
+
 eval :: GmState -> [GmState]
 eval st = st : rest
     where