This commit is contained in:
crumbtoo
2024-02-13 12:52:06 -07:00
parent 8267548fab
commit 4c9ceb74d1
4 changed files with 8 additions and 4 deletions

View File

@@ -7,5 +7,5 @@ foldr f z l = case l of
list = Cons 1 (Cons 2 (Cons 3 Nil)) list = Cons 1 (Cons 2 (Cons 3 Nil))
main = foldr (+#) 0 list main = print# (foldr (+#) 0 list)

View File

@@ -32,7 +32,7 @@ import Rlp.Parse
import Rlp2Core import Rlp2Core
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------
justHdbg :: String -> IO (Node, Stats) justHdbg :: String -> IO GmState
justHdbg s = do justHdbg s = do
p <- evalRLPCIO def (parseRlpProgR >=> desugarRlpProgR $ T.pack s) p <- evalRLPCIO def (parseRlpProgR >=> desugarRlpProgR $ T.pack s)
withFile "/tmp/t.log" WriteMode $ hdbgProg p withFile "/tmp/t.log" WriteMode $ hdbgProg p

View File

@@ -9,7 +9,10 @@ module GM
( hdbgProg ( hdbgProg
, evalProg , evalProg
, evalProgR , evalProgR
, GmState(..)
, gmCode, gmStack, gmDump, gmHeap, gmEnv, gmStats
, Node(..) , Node(..)
, showState
, gmEvalProg , gmEvalProg
, Stats(..) , Stats(..)
, finalStateOf , finalStateOf
@@ -153,7 +156,7 @@ evalProg p = res <&> (,sts)
resAddr = final ^. gmStack ^? _head resAddr = final ^. gmStack ^? _head
res = resAddr >>= flip hLookup h res = resAddr >>= flip hLookup h
hdbgProg :: Program' -> Handle -> IO (Node, Stats) hdbgProg :: Program' -> Handle -> IO GmState
hdbgProg p hio = do hdbgProg p hio = do
(renderOut . showState) `traverse_` states (renderOut . showState) `traverse_` states
-- TODO: i'd like the statistics to be at the top of the file, but `sts` -- TODO: i'd like the statistics to be at the top of the file, but `sts`
@@ -161,7 +164,7 @@ hdbgProg p hio = do
-- *can't* get partial logs in the case of a crash. this is in opposition to -- *can't* get partial logs in the case of a crash. this is in opposition to
-- the above traversal which *will* produce partial logs. i love laziness :3 -- the above traversal which *will* produce partial logs. i love laziness :3
renderOut . showStats $ sts renderOut . showStats $ sts
pure (res, sts) pure final
where where
renderOut r = hPutStrLn hio $ render r ++ "\n" renderOut r = hPutStrLn hio $ render r ++ "\n"

View File

@@ -41,6 +41,7 @@ evalArith (a ::* b) = evalArith a * evalArith b
evalArith (a ::- b) = evalArith a - evalArith b evalArith (a ::- b) = evalArith a - evalArith b
instance Arbitrary ArithExpr where instance Arbitrary ArithExpr where
-- TODO: implement shrink
arbitrary = gen 4 arbitrary = gen 4
where where
gen :: Int -> Gen ArithExpr gen :: Int -> Gen ArithExpr