Fix issue in case eval
This commit is contained in:
@@ -673,8 +673,6 @@ checkDone ctx [] body ty = do
|
||||
debug "DONE-> check body \{show body} at \{show ty}"
|
||||
-- TODO dump context function
|
||||
debugM $ dumpCtx ctx
|
||||
debug "ENV \{show ctx.env}"
|
||||
debug "TY \{show ctx.types}"
|
||||
-- I'm running an eval here to run case statements that are
|
||||
-- unblocked by lets in the env. (Tree.newt:cmp)
|
||||
-- The case eval code only works in the Tm -> Val case at the moment.
|
||||
|
||||
@@ -45,15 +45,17 @@ vappSpine t [<] = pure t
|
||||
vappSpine t (xs :< x) = vapp !(vappSpine t xs) x
|
||||
|
||||
evalCase : Env -> Mode -> Val -> List CaseAlt -> M (Maybe Val)
|
||||
evalCase env mode sc@(VRef _ nm y sp) (cc@(CaseCons name nms t) :: xs) =
|
||||
evalCase env mode sc@(VRef _ nm _ sp) (cc@(CaseCons name nms t) :: xs) =
|
||||
if nm == name
|
||||
then go env sp nms
|
||||
then do
|
||||
debug "ECase \{nm} \{show sp} \{show nms} \{showTm t}"
|
||||
go env (sp <>> []) nms
|
||||
else evalCase env mode sc xs
|
||||
where
|
||||
go : Env -> SnocList Val -> List String -> M (Maybe Val)
|
||||
go env (args :< arg) (nm :: nms) = go (arg :: env) args nms
|
||||
go env args [] = Just <$> vappSpine !(eval env mode t) args
|
||||
go env [<] rest = pure Nothing
|
||||
go : Env -> List Val -> List String -> M (Maybe Val)
|
||||
go env (arg :: args) (nm :: nms) = go (arg :: env) args nms
|
||||
go env args [] = Just <$> vappSpine !(eval env mode t) ([<] <>< args)
|
||||
go env [] rest = pure Nothing
|
||||
|
||||
evalCase env mode sc (CaseDefault u :: xs) = pure $ Just !(eval (sc :: env) mode u)
|
||||
evalCase env mode sc cc = do
|
||||
|
||||
Reference in New Issue
Block a user