36 lines
1.2 KiB
Haskell
36 lines
1.2 KiB
Haskell
module APL.InterpPure (runEval) where
|
|
|
|
import APL.Monad
|
|
|
|
runEval :: EvalM a -> ([String], Either Error a)
|
|
runEval = runEval' envEmpty stateInitial
|
|
where
|
|
runEval' :: Env -> State -> EvalM a -> ([String], Either Error a)
|
|
runEval' _ _ (Pure x) = ([], pure x)
|
|
runEval' r s (Free (ReadOp k)) = runEval' r s $ k r
|
|
runEval' r s (Free (StateGetOp k)) = runEval' r s $ k s
|
|
runEval' r _ (Free (StatePutOp s' m)) = runEval' r s' m
|
|
runEval' r s (Free (PrintOp p m)) =
|
|
let (ps, res) = runEval' r s m
|
|
in (p : ps, res)
|
|
runEval' r s (Free (TryCatchOp m l)) =
|
|
case (runEval' r s m) of
|
|
(_, Left _) -> runEval' r s l
|
|
a -> a
|
|
runEval' r s (Free (KvGetOp key k)) =
|
|
case (lookup key s) of
|
|
Just val -> runEval' r s $ k val
|
|
Nothing -> ([], Left ("Cannot find key: "++(show key)))
|
|
runEval' r s (Free (KvPutOp key val m)) =
|
|
runEval' r ((key,val):s) m
|
|
runEval' r s (Free (TransactionOp l m)) =
|
|
let (p, resl) = runEval' r s (do l >> getState)
|
|
in case resl of
|
|
Right s' ->
|
|
let (ps, resm) = runEval' r s' m
|
|
in (p ++ ps, resm)
|
|
Left _ ->
|
|
let (ps, resm) = runEval' r s m
|
|
in (p ++ ps, resm)
|
|
runEval' _ _ (Free (ErrorOp e)) = ([], Left e)
|