diff options
| -rw-r--r-- | app/Builtins.hs | 18 |
1 files changed, 18 insertions, 0 deletions
diff --git a/app/Builtins.hs b/app/Builtins.hs index 53ebe82..2dd1e61 100644 --- a/app/Builtins.hs +++ b/app/Builtins.hs @@ -2,11 +2,14 @@ module Builtins where import Code import Control.Monad.IO.Class +import Control.Monad.Trans.Class import Control.Monad.Trans.State.Lazy import qualified Data.Map as M import Env hiding (PrlgEnv) +import qualified IR import Interpreter (backtrack) import qualified Operators as O +import System.Console.Haskeline bi = Builtin @@ -17,8 +20,20 @@ hello = do printLocals :: BuiltinFn 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 +promptRetry :: BuiltinFn +promptRetry = do + x <- lift $ getInputChar "? " + case x of + Just ';' -> backtrack + _ -> return Nothing + addBuiltins :: PrlgEnv () addBuiltins = do a1 <- findStruct "a" 1 @@ -34,6 +49,7 @@ addBuiltins = do true0 <- findStruct "true" 0 printlocals0 <- findStruct "print_locals" 0 debugprint0 <- findStruct "interpreter_state" 0 + promptretry0 <- findStruct "prompt_retry" 0 modify $ \s -> s { defs = @@ -50,6 +66,8 @@ addBuiltins = do , (true0, [[Invoke $ bi (pure Nothing)]]) , ( debugprint0 , [[Invoke $ bi (get >>= liftIO . print >> pure Nothing)]]) + , (printlocals0, [[Invoke $ bi printLocals]]) + , (promptretry0, [[Invoke $ bi promptRetry]]) ] , ops = [(O.xfy "," 1000), (O.xfx "=" 700)] } |