dunham/newt
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

Remove unused argument that was blowing up serialization.

Browse Source
This commit is contained in:
Steve Dunham
2025-01-18 15:21:15 -08:00
parent f9279bb255
commit f991ca0d52
8 changed files with 39 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
port/Lib/Elab.newt
View File

@@ -128,7 +128,7 @@ unifyCatch : FC -> Context -> Val -> Val -> M Unit
isCandidate : Val -> Tm -> Bool
isCandidate ty (Pi fc nm Explicit rig t u) = False
isCandidate ty (Pi fc nm icit rig t u) = isCandidate ty u
isCandidate (VRef _ nm _ _) (Ref fc nm' def) = nm == nm'
isCandidate (VRef _ nm _) (Ref fc nm') = nm == nm'
isCandidate ty (App fc t u) = isCandidate ty t
isCandidate _ _ = False
@@ -358,7 +358,7 @@ renameSpine meta ren lvl tm (xs :< x) = do
rename meta ren lvl (VVar fc k sp) = case findIndex' (_==_ k) ren of
Nothing => error fc "scope/skolem thinger VVar \{show k} ren \{show ren}"
Just x => renameSpine meta ren lvl (Bnd fc x) sp
rename meta ren lvl (VRef fc nm def sp) = renameSpine meta ren lvl (Ref fc nm def) sp
rename meta ren lvl (VRef fc nm sp) = renameSpine meta ren lvl (Ref fc nm) sp
rename meta ren lvl (VMeta fc ix sp) = do
-- So sometimes we have an unsolved meta in here which reference vars out of scope.
debug $ \ _ => "rename Meta \{show ix} spine \{show sp}"
@@ -523,7 +523,7 @@ unify env mode t u = do
unifyRest t' u' = error (getFC t') "unify failed \{show t'} =?= \{show u'} \n env is \{show env}"
unifyRef : Val -> Val -> M UnifyResult
unifyRef t'@(VRef fc k def sp) u'@(VRef fc' k' def' sp') =
unifyRef t'@(VRef fc k sp) u'@(VRef fc' k' sp') =
-- unifySpine is a problem for cmp (S x) (S y) =?= cmp x y
do
-- catchError(unifySpine env mode (k == k') sp sp') $ \ err => do
@@ -539,7 +539,7 @@ unify env mode t u = do
-- Lennart.newt cursed type references itself
-- We _could_ look up the ref, eval against Nil and vappSpine...
unifyRef t u@(VRef fc' k' def sp') = do
unifyRef t u@(VRef fc' k' sp') = do
debug $ \ _ => "expand \{show t} =?= %ref \{show k'}"
top <- get
case lookup k' top of
@@ -549,7 +549,7 @@ unify env mode t u = do
unify env mode t appvtm
_ => error fc' "unify failed \{show t} =?= \{show u} (no Fn :: Nil)\n env is \{show env}"
unifyRef t@(VRef fc k def sp) u = do
unifyRef t@(VRef fc k sp) u = do
debug $ \ _ => "expand %ref \{show k} \{show sp} =?= \{show u}"
top <- get
case lookup k top of
@@ -692,7 +692,7 @@ primType : FC -> QName -> M Val
primType fc nm = do
top <- get
case lookup nm top of
Just (MkEntry _ name ty PrimTCon) => pure $ VRef fc name PrimTCon Lin
Just (MkEntry _ name ty PrimTCon) => pure $ VRef fc name Lin
_ => error fc "Primitive type \{show nm} not in scope"
@@ -757,7 +757,7 @@ findSplit (x :: xs) = findSplit xs
-- TODO, we may need to filter these against the type to rule out
-- impossible cases
getConstructors : Context -> FC -> Val -> M (List (QName × Int × Tm))
getConstructors ctx scfc (VRef fc nm _ _) = do
getConstructors ctx scfc (VRef fc nm _) = do
names <- lookupTCon nm
traverse lookupDCon names
where
@@ -801,7 +801,7 @@ substVal k v tm = go tm
go (VLet fc nm a b) = VLet fc nm (go a) b
go (VPi fc nm icit rig a b) = VPi fc nm icit rig (go a) b
go (VMeta fc ix sp) = VMeta fc ix (map go sp)
go (VRef fc nm y sp) = VRef fc nm y (map go sp)
go (VRef fc nm sp) = VRef fc nm (map go sp)
go tm = tm
-- FIXME - do I need a Val closure like idris?
-- or env in unify...
@@ -874,10 +874,10 @@ buildCase ctx prob scnm scty (dcName, arity, ty) = do
-- if the value is already constrained to a different constructor, return Nothing
debug $ \ _ => "scrut \{scnm} constrained to \{show $ lookupDef ctx scnm}"
let (VRef _ sctynm _ _) = scty | _ => error (getFC scty) "case split on non-inductive \{show scty}"
let (VRef _ sctynm _) = scty | _ => error (getFC scty) "case split on non-inductive \{show scty}"
case lookupDef ctx scnm of
Just val@(VRef fc nm y sp) =>
Just val@(VRef fc nm sp) =>
if nm /= dcName
then do
debug $ \ _ => "SKIP \{show dcName} because \{scnm} forced to \{show val}"
@@ -912,7 +912,7 @@ buildCase ctx prob scnm scty (dcName, arity, ty) = do
let (Just x) = findIndex' ((_==_ scnm) ∘ fst) ctx'.types
| Nothing => error ctx.ctxFC "\{scnm} not is scope?"
let lvl = lvl2ix (length' ctx'.env) x
let scon = (lvl, VRef ctx.ctxFC dcName (DCon arity dcName) sc)
let scon = (lvl, VRef ctx.ctxFC dcName sc) -- (DCon arity dcName)
debug $ \ _ => "scty \{show scty}"
debug $ \ _ => "UNIFY results \{show res.constraints}"
@@ -1298,7 +1298,7 @@ buildTree ctx prob@(MkProb ((MkClause fc constraints Nil expr) :: cs) ty) = do
PatLit fc v => do
let tyname = litTyName v
case scty' of
(VRef fc1 nm x sp) => when (nm /= tyname) $ \ _ => error fc "expected \{show scty} and got \{show tyname}"
(VRef fc1 nm sp) => when (nm /= tyname) $ \ _ => error fc "expected \{show scty} and got \{show tyname}"
_ => error fc "expected \{show scty} and got \{show tyname}"
-- need to run through all of the PatLits in this slot and then find a fallback
-- walk the list of patterns, stop if we hit a PatVar / PatWild, fail if we don't
@@ -1450,7 +1450,7 @@ infer ctx (RVar fc nm) = go 0 ctx.types
Just (MkEntry _ name ty def) => do
debug $ \ _ => "lookup \{show name} as \{show def}"
vty <- eval Nil CBN ty
pure (Ref fc name def, vty)
pure (Ref fc name, vty)
Nothing => error fc "\{show nm} not in scope"
go i ((x, ty) :: xs) = if x == nm then pure $ (Bnd fc i, ty)
else go (i + 1) xs