module HJS.Interpreter where
import Control.Monad.Identity
import Control.Monad.Error
import Control.Monad.State
import qualified Data.Map as M
import HJS.Interpreter.InterpMDecl
import HJS.Interpreter.InterpM
import HJS.Interpreter.Interp
import HJS.Interpreter.Host
import Debug.Trace
runInterp :: InterpC p => p -> InterpM Value
runInterp p = do
initEnvironment
interp p
startState f = let db = if elem Debug f then [DBBreak (1)] else []
in emptyState { flags = f, debug = db }
runProgram' f p = runStateT (runErrorT (runInterp p)) (startState f)
runProgram :: InterpC a => [RunFlag] -> a -> IO Bool
runProgram flags p = do
(ret,state) <- runProgram' flags p
case ret of
Left err -> do
putStrLn $ "Position: " ++ (show $ pos state)
putStrLn (show err )
handleRunResult flags (undefinedValue, state)
Right r -> handleRunResult flags (r,state)
handleRunResult (ShowHeap : cs) (v,st) = do
let ec = ctx st
s = oheap st
p = pos st
let out = getOut s
putStrLn $ "Return: " ++ (show v)
putStrLn $ "Output: " ++ (show out)
putStrLn $ "Execution Context" ++ (show ec)
putStrLn $ "Heap: "
mapM_ (\(i,o) -> do
putStr $ (show i) ++ " -> "
putStrLn (show o)) (M.toList s)
case (prj v) of
(Just b :: Maybe Bool) -> return b
_ -> return False
handleRunResult [] (v,st) = do
let ec = ctx st
s = oheap st
p = pos st
let out = getOut s
putStrLn $ show $ debug st
case out of
Nothing -> return ()
(Just out') -> putStrLn $ "Output: " ++ (show out')
case (prj v) of
(Just b :: Maybe Bool) -> return b
_ -> return False
handleRunResult (f:fs) (v,st) = handleRunResult fs (v,st)
getOut s = out where (out::Maybe String) = do
go <- M.lookup globalObj s
(o,_) <- M.lookup "_output" (properties go)
return $ show o