actually print out minor stuff
This commit is contained in:
parent
fdf96f5a77
commit
2298aa0d56
|
@ -2,11 +2,14 @@ module Builtins where
|
||||||
|
|
||||||
import Code
|
import Code
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
import Control.Monad.Trans.Class
|
||||||
import Control.Monad.Trans.State.Lazy
|
import Control.Monad.Trans.State.Lazy
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Env hiding (PrlgEnv)
|
import Env hiding (PrlgEnv)
|
||||||
|
import qualified IR
|
||||||
import Interpreter (backtrack)
|
import Interpreter (backtrack)
|
||||||
import qualified Operators as O
|
import qualified Operators as O
|
||||||
|
import System.Console.Haskeline
|
||||||
|
|
||||||
bi = Builtin
|
bi = Builtin
|
||||||
|
|
||||||
|
@ -17,8 +20,20 @@ hello = do
|
||||||
|
|
||||||
printLocals :: BuiltinFn
|
printLocals :: BuiltinFn
|
||||||
printLocals = do
|
printLocals = do
|
||||||
|
scope <- gets (gvar . cur)
|
||||||
|
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)
|
||||||
return Nothing
|
return Nothing
|
||||||
|
|
||||||
|
promptRetry :: BuiltinFn
|
||||||
|
promptRetry = do
|
||||||
|
x <- lift $ getInputChar "? "
|
||||||
|
case x of
|
||||||
|
Just ';' -> backtrack
|
||||||
|
_ -> return Nothing
|
||||||
|
|
||||||
addBuiltins :: PrlgEnv ()
|
addBuiltins :: PrlgEnv ()
|
||||||
addBuiltins = do
|
addBuiltins = do
|
||||||
a1 <- findStruct "a" 1
|
a1 <- findStruct "a" 1
|
||||||
|
@ -34,6 +49,7 @@ addBuiltins = do
|
||||||
true0 <- findStruct "true" 0
|
true0 <- findStruct "true" 0
|
||||||
printlocals0 <- findStruct "print_locals" 0
|
printlocals0 <- findStruct "print_locals" 0
|
||||||
debugprint0 <- findStruct "interpreter_state" 0
|
debugprint0 <- findStruct "interpreter_state" 0
|
||||||
|
promptretry0 <- findStruct "prompt_retry" 0
|
||||||
modify $ \s ->
|
modify $ \s ->
|
||||||
s
|
s
|
||||||
{ defs =
|
{ defs =
|
||||||
|
@ -50,6 +66,8 @@ addBuiltins = do
|
||||||
, (true0, [[Invoke $ bi (pure Nothing)]])
|
, (true0, [[Invoke $ bi (pure Nothing)]])
|
||||||
, ( debugprint0
|
, ( debugprint0
|
||||||
, [[Invoke $ bi (get >>= liftIO . print >> pure Nothing)]])
|
, [[Invoke $ bi (get >>= liftIO . print >> pure Nothing)]])
|
||||||
|
, (printlocals0, [[Invoke $ bi printLocals]])
|
||||||
|
, (promptretry0, [[Invoke $ bi promptRetry]])
|
||||||
]
|
]
|
||||||
, ops = [(O.xfy "," 1000), (O.xfx "=" 700)]
|
, ops = [(O.xfy "," 1000), (O.xfx "=" 700)]
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue