A couple of other spots we expand to Case

This commit is contained in:
2024-10-08 22:03:31 -07:00
parent 125a8c5ac5
commit a7d2e065e6

View File

@@ -48,12 +48,22 @@ forceMeta (VMeta fc ix sp) = case !(lookupMeta ix) of
(Solved k t) => vappSpine t sp >>= forceMeta (Solved k t) => vappSpine t sp >>= forceMeta
forceMeta x = pure x forceMeta x = pure x
tryEval : String -> SnocList Val -> M (Maybe Val)
tryEval k sp =
case lookup k !(get) of
Just (MkEntry name ty (Fn tm)) => do
vtm <- eval [] CBN tm
case !(vappSpine vtm sp) of
VCase{} => pure Nothing
v => pure $ Just v
_ => pure Nothing
-- Lennart needed more forcing for recursive nat, -- Lennart needed more forcing for recursive nat,
forceType : Val -> M Val forceType : Val -> M Val
forceType (VRef fc nm def sp) = forceType tm@(VRef fc nm def sp) =
case lookup nm !(get) of case !(tryEval nm sp) of
(Just (MkEntry name type (Fn t))) => vappSpine !(eval [] CBN t) sp Just tm => pure tm
_ => pure (VRef fc nm def sp) _ => pure tm
forceType (VMeta fc ix sp) = case !(lookupMeta ix) of forceType (VMeta fc ix sp) = case !(lookupMeta ix) of
(Unsolved x k xs _) => pure (VMeta fc ix sp) (Unsolved x k xs _) => pure (VMeta fc ix sp)
(Solved k t) => vappSpine t sp >>= forceType (Solved k t) => vappSpine t sp >>= forceType
@@ -208,17 +218,12 @@ parameters (ctx: Context)
if k == k' then do if k == k' then do
debug "unify \{show l} spine at \{k} \{show sp} \{show sp'}" debug "unify \{show l} spine at \{k} \{show sp} \{show sp'}"
unifySpine l (k == k') sp sp' unifySpine l (k == k') sp sp'
else case lookup k !(get) of else do
Just (MkEntry name ty (Fn tm)) => do Nothing <- tryEval k sp
vtm <- eval [] CBN tm | Just v => unify l v u'
v <- vappSpine vtm sp Nothing <- tryEval k' sp'
unify l v u' | Just v => unify l t' v
_ => case lookup k' !(get) of error fc "vref mismatch \{show k} \{show k'} -- \{show sp} \{show sp'}"
Just (MkEntry name ty (Fn tm)) => do
vtm <- eval [] CBN tm
v <- vappSpine vtm sp'
unify l t' v
_ => error fc "vref mismatch \{show k} \{show k'} -- \{show sp} \{show sp'}"
(VU _, VU _) => pure neutral (VU _, VU _) => pure neutral
-- Lennart.newt cursed type references itself -- Lennart.newt cursed type references itself