arith
This commit is contained in:
+23
-3
@@ -91,8 +91,9 @@ eval g (ExpLetRec bs e) = eval g' e
|
|||||||
|
|
||||||
eval g (Halt rs) = traverse (evalVal g) rs
|
eval g (Halt rs) = traverse (evalVal g) rs
|
||||||
|
|
||||||
eval g (ExpContinue k xs) = evalVal g k >>= \case
|
eval g (ExpContinue k xs) =
|
||||||
ObjImm (ImmLabel "halt") -> traverse (evalVal g) xs
|
case k of
|
||||||
|
ValVar x -> continueWith g (KexpVar x) xs
|
||||||
|
|
||||||
eval g (ExpApply f xs ktail) = do
|
eval g (ExpApply f xs ktail) = do
|
||||||
f' <- evalVal g f
|
f' <- evalVal g f
|
||||||
@@ -106,12 +107,31 @@ eval g (ExpApply f xs ktail) = do
|
|||||||
& #store <>~ H.fromList (zip bxs xs')
|
& #store <>~ H.fromList (zip bxs xs')
|
||||||
& maybe id (\b -> #store . at b ?~ ktail') bktail
|
& maybe id (\b -> #store . at b ?~ ktail') bktail
|
||||||
|
|
||||||
|
eval g (ExpPrim p k) = traverse (evalVal g) p >>= \case
|
||||||
|
PrimAdd x y -> arith2 (+) x y
|
||||||
|
PrimMul x y -> arith2 (*) x y
|
||||||
|
PrimSub x y -> arith2 (-) x y
|
||||||
|
PrimDiv x y -> arith2 div x y
|
||||||
|
where
|
||||||
|
arith2 f (ObjImm (ImmInt x)) (ObjImm (ImmInt y)) =
|
||||||
|
pure1 . ObjImm . ImmInt $ f x y
|
||||||
|
|
||||||
eval g e = err [i|unimplemented exp: #{S.encodeOrShow' @Text S.datumIso e}|]
|
eval g e = err [i|unimplemented exp: #{S.encodeOrShow' @Text S.datumIso e}|]
|
||||||
|
|
||||||
|
continueWith :: Jalmot :> es => Env -> Kexp -> List Val -> Eff es (List Obj)
|
||||||
|
continueWith g kexp xs = do
|
||||||
|
xs' <- traverse (evalVal g) xs
|
||||||
|
evalKexp g kexp >>= \case
|
||||||
|
ObjImm (ImmLabel "halt") -> traverse (evalVal g) xs
|
||||||
|
ObjHob (HobClosure {code,env}) -> eval env' e
|
||||||
|
where
|
||||||
|
MkAbs bxs bktail e = code
|
||||||
|
env' = env & #store <>~ H.fromList (zip bxs xs')
|
||||||
|
|
||||||
evalKexp :: Jalmot :> es => Env -> Kexp -> Eff es Obj
|
evalKexp :: Jalmot :> es => Env -> Kexp -> Eff es Obj
|
||||||
evalKexp g = \case
|
evalKexp g = \case
|
||||||
KexpVar x -> var g x
|
KexpVar x -> var g x
|
||||||
KexpKappa kap -> _
|
KexpKappa kap -> pure . ObjHob $ HobClosure (AbsKappa kap) g
|
||||||
|
|
||||||
evalVal
|
evalVal
|
||||||
:: Jalmot :> es
|
:: Jalmot :> es
|
||||||
|
|||||||
Reference in New Issue
Block a user