Interpreter.hs~

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

runInterp :: InterpC p => p -> InterpM Value
runInterp p = do
	          initEnvironment
--                  addBuiltIn
                  interp p
                 

runProgram' p = runIdentity $ runStateT  (runErrorT (runInterp p)) emptyState 

runProgram :: InterpC a => Bool -> a  -> IO Bool
runProgram flags  p = do 
                           let (ret,state) = runProgram' p
			   case ret of 
                                 Left err -> do let (_,_,pos) = state
                                                putStrLn $ "Position: " ++ (show pos) 
                                                putStrLn (show err ) 
                                                handleRunResult flags (undefinedValue, state)
                                 Right r  -> handleRunResult flags (r,state)

handleRunResult True (v,(ec,s,p)) = do 
 				              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 False (v,(ec,s,p)) = do
 				              let out = getOut s
                                              case out of 
                                                   Nothing -> return ()
					           (Just out') -> putStrLn $ "Output: " ++ (show out')
					      case (prj v) of 
                                                   (Just b :: Maybe Bool) -> return b
                                                   _ -> return False

getOut s = out where (out::Maybe String) = do  
	                                     go <- M.lookup globalObj s
                                             (o,_) <- M.lookup "_output" (properties go)
                                             return $ show o