add jump to def and type on hover for top level

This commit is contained in:
2024-12-07 12:23:47 -08:00
parent 45390066ae
commit 421f5ea208
14 changed files with 378 additions and 174 deletions

View File

@@ -331,13 +331,13 @@ unify env mode t u = do
unify' t u@(VRef fc' k' def sp') = do
debug "expand \{show t} =?= %ref \{k'}"
case lookup k' !(get) of
Just (MkEntry name ty (Fn tm)) => unify env mode t !(vappSpine !(eval [] CBN tm) sp')
Just (MkEntry _ name ty (Fn tm)) => unify env mode t !(vappSpine !(eval [] CBN tm) sp')
_ => error fc' "unify failed \{show t} =?= \{show u} [no Fn]\n env is \{show env}"
unify' t@(VRef fc k def sp) u = do
debug "expand %ref \{k} \{show sp} =?= \{show u}"
case lookup k !(get) of
Just (MkEntry name ty (Fn tm)) => unify env mode !(vappSpine !(eval [] CBN tm) sp) u
Just (MkEntry _ name ty (Fn tm)) => unify env mode !(vappSpine !(eval [] CBN tm) sp) u
_ => error fc "unify failed \{show t} [no Fn] =?= \{show u}\n env is \{show env}"
-- REVIEW I'd like to quote this back, but we have l that aren't in the environment.
@@ -397,7 +397,7 @@ insert ctx tm ty = do
primType : FC -> String -> M Val
primType fc nm = case lookup nm !(get) of
Just (MkEntry name ty PrimTCon) => pure $ VRef fc name PrimTCon [<]
Just (MkEntry _ name ty PrimTCon) => pure $ VRef fc name PrimTCon [<]
_ => error fc "Primitive type \{show nm} not in scope"
export
@@ -470,12 +470,12 @@ getConstructors ctx scfc (VRef fc nm _ _) = do
where
lookupTCon : String -> M (List String)
lookupTCon str = case lookup nm !get of
(Just (MkEntry name type (TCon names))) => pure names
(Just (MkEntry _ name type (TCon names))) => pure names
_ => error scfc "Not a type constructor \{nm}"
lookupDCon : String -> M (String, Nat, Tm)
lookupDCon nm = do
case lookup nm !get of
(Just (MkEntry name type (DCon k str))) => pure (name, k, type)
(Just (MkEntry _ name type (DCon k str))) => pure (name, k, type)
Just _ => error fc "Internal Error: \{nm} is not a DCon"
Nothing => error fc "Internal Error: DCon \{nm} not found"
getConstructors ctx scfc tm = error scfc "Can't split - not VRef: \{!(pprint ctx tm)}"
@@ -676,7 +676,7 @@ mkPat : TopContext -> (Raw, Icit) -> M Pattern
mkPat top (tm, icit) = do
case splitArgs tm [] of
((RVar fc nm), b) => case lookup nm top of
(Just (MkEntry name type (DCon k str))) =>
(Just (MkEntry _ name type (DCon k str))) =>
-- TODO check arity, also figure out why we need reverse
pure $ PatCon fc icit nm !(traverse (mkPat top) b)
-- This fires when a global is shadowed by a pattern var
@@ -994,21 +994,10 @@ check ctx tm ty = case (tm, !(forceType ctx.env ty)) of
pure $ Lam (getFC tm) nm' Auto rig sc
(tm,ty) => do
-- We need to insert if tm is not an Implicit Lam
-- assuming all of the implicit ty have been handled above
(tm', ty') <- infer ctx tm
(tm', ty') <- insert ctx tm' ty'
let names = toList $ map fst ctx.types
(tm', ty') <- case !(infer ctx tm) of
-- Kovacs doesn't insert on tm = Implicit Lam, we don't have Plicity in Lam
-- so I'll check the inferred type for an implicit pi
-- This seems wrong, the ty' is what insert runs on, so we're just short circuiting here
-- REVIEW - I think we need icit on Lam, check that they match and drop the two "edge" above?
-- (tm'@(Lam{}), ty'@(VPi _ _ Implicit rig _ _)) => do debug "CheckMe 1"; pure (tm', ty')
-- (tm'@(Lam{}), ty'@(VPi _ _ Auto rig _ _)) => do debug "CheckMe 2"; pure (tm', ty')
(tm', ty') => do
debug "RUN INSERT ON \{pprint names tm'} at \{show ty'}"
insert ctx tm' ty'
debug "INFER \{show tm} to (\{pprint names tm'} : \{show ty'}) expect \{show ty}"
unifyCatch (getFC tm) ctx ty' ty
pure tm'
@@ -1017,7 +1006,7 @@ infer ctx (RVar fc nm) = go 0 ctx.types
where
go : Nat -> Vect n (String, Val) -> M (Tm, Val)
go i [] = case lookup nm !(get) of
Just (MkEntry name ty def) => do
Just (MkEntry _ name ty def) => do
debug "lookup \{name} as \{show def}"
pure (Ref fc nm def, !(eval [] CBN ty))
Nothing => error fc "\{show nm} not in scope"