tweaks to output, fix scope issue in pprint

This commit is contained in:
2024-11-15 16:49:31 -08:00
parent e6944bc842
commit 9faee86886
6 changed files with 18 additions and 15 deletions

View File

@@ -18,6 +18,8 @@
- There is also a bit where kovacs uses the implicit on the type (a value) to decide to insert - There is also a bit where kovacs uses the implicit on the type (a value) to decide to insert
- [ ] consider binders in environment, to better mark let and to provide names - [ ] consider binders in environment, to better mark let and to provide names
- [ ] move some top-level chattiness to `debug` - [ ] move some top-level chattiness to `debug`
- [ ] consider optionally compiling to eliminators for a second type-checking pass. This
would help catch bugs.
- [x] Allow unicode operators/names - [x] Allow unicode operators/names
- Web playground - Web playground
- [x] editor - [x] editor

View File

@@ -39,7 +39,6 @@ data Term : Ctx -> Type -> U where
Lam : {Γ : Ctx} {σ τ : Type} -> Term (σ :: Γ) τ -> Term Γ (σ ~> τ) Lam : {Γ : Ctx} {σ τ : Type} -> Term (σ :: Γ) τ -> Term Γ (σ ~> τ)
Var : {Γ : Ctx} {σ : Type} -> Ref σ Γ Term Γ σ Var : {Γ : Ctx} {σ : Type} -> Ref σ Γ Term Γ σ
-- FIXME, I wasn't getting an error when I had Nil shadowing Nil
infixr 7 _:::_ infixr 7 _:::_
data Env : Ctx -> U where data Env : Ctx -> U where
ENil : Env Nil ENil : Env Nil

View File

@@ -54,7 +54,7 @@ plus (S n) m = S (plus n m)
plus' : Nat -> Nat -> Nat plus' : Nat -> Nat -> Nat
plus' = \ n m => case n of plus' = \ n m => case n of
Z => m Z => m
S n => S (plus n m) S n => S (plus' n m)
-- We can define operators, currently only infix -- We can define operators, currently only infix
-- and we allow unicode and letters in operators -- and we allow unicode and letters in operators

View File

@@ -871,6 +871,7 @@ check ctx tm ty = case (tm, !(forceType ctx.env ty)) of
top <- get top <- get
clauses <- traverse (\(MkAlt pat rawRHS) => pure $ MkClause (getFC pat) [(scnm, !(mkPat top (pat, Explicit)))] [] rawRHS ) alts clauses <- traverse (\(MkAlt pat rawRHS) => pure $ MkClause (getFC pat) [(scnm, !(mkPat top (pat, Explicit)))] [] rawRHS ) alts
-- buildCase expects scrutinee to be a name in the context, so we need to let it. -- buildCase expects scrutinee to be a name in the context, so we need to let it.
-- if it's a Bnd and not shadowed we could skip the let, but that's messy.
let ctx' = extend ctx scnm scty let ctx' = extend ctx scnm scty
pure $ Let fc scnm sc !(buildTree ctx' $ MkProb clauses ty) pure $ Let fc scnm sc !(buildTree ctx' $ MkProb clauses ty)

View File

@@ -165,6 +165,8 @@ processDecl : Decl -> M ()
processDecl (PMixFix{}) = pure () processDecl (PMixFix{}) = pure ()
processDecl (TypeSig fc names tm) = do processDecl (TypeSig fc names tm) = do
putStrLn "-----"
putStrLn "TypeSig \{unwords names} : \{show tm}"
top <- get top <- get
mc <- readIORef top.metas mc <- readIORef top.metas
let mstart = length mc.metas let mstart = length mc.metas
@@ -172,12 +174,10 @@ processDecl (TypeSig fc names tm) = do
let Nothing := lookup nm top let Nothing := lookup nm top
| _ => error fc "\{show nm} is already defined" | _ => error fc "\{show nm} is already defined"
pure () pure ()
putStrLn "-----"
putStrLn "TypeSig \{unwords names} : \{show tm}"
ty <- check (mkCtx top.metas fc) tm (VU fc) ty <- check (mkCtx top.metas fc) tm (VU fc)
debug "got \{pprint [] ty}" debug "got \{pprint [] ty}"
for_ names $ \nm => setDef nm fc ty Axiom for_ names $ \nm => setDef nm fc ty Axiom
-- Zoo4eg has metas in TypeSig, need to decide if I want to support that going forward. -- Zoo4eg has metas in TypeSig, need to decide if I want to support leaving them unsolved here
-- logMetas mstart -- logMetas mstart
processDecl (PType fc nm ty) = do processDecl (PType fc nm ty) = do
@@ -194,7 +194,7 @@ processDecl (PFunc fc nm ty src) = do
processDecl (Def fc nm clauses) = do processDecl (Def fc nm clauses) = do
putStrLn "-----" putStrLn "-----"
putStrLn "def \{show nm}" putStrLn "Def \{show nm}"
top <- get top <- get
mc <- readIORef top.metas mc <- readIORef top.metas
let mstart = length mc.metas let mstart = length mc.metas
@@ -203,23 +203,24 @@ processDecl (Def fc nm clauses) = do
let (MkEntry name ty Axiom) := entry let (MkEntry name ty Axiom) := entry
| _ => throwError $ E fc "\{nm} already defined" | _ => throwError $ E fc "\{nm} already defined"
putStrLn "check \{nm} ... at \{pprint [] ty}" putStrLn "check \{nm} at \{pprint [] ty}"
vty <- eval empty CBN ty vty <- eval empty CBN ty
putStrLn "vty is \{show vty}" debug "\{nm} vty is \{show vty}"
-- I can take LHS apart syntactically or elaborate it with an infer -- I can take LHS apart syntactically or elaborate it with an infer
clauses' <- traverse (makeClause top) clauses clauses' <- traverse (makeClause top) clauses
tm <- buildTree (mkCtx top.metas fc) (MkProb clauses' vty) tm <- buildTree (mkCtx top.metas fc) (MkProb clauses' vty)
putStrLn "Ok \{pprint [] tm}" -- putStrLn "Ok \{pprint [] tm}"
mc <- readIORef top.metas mc <- readIORef top.metas
let mlen = length mc.metas `minus` mstart let mlen = length mc.metas `minus` mstart
solveAutos mlen (take mlen mc.metas) solveAutos mlen (take mlen mc.metas)
-- Expand metas -- TODO - make nf that expands all metas and drop zonk
-- tm' <- nf [] tm -- TODO - make nf that expands all metas, Day1.newt is a test case -- Day1.newt is a test case
-- tm' <- nf [] tm
tm' <- zonk top 0 [] tm tm' <- zonk top 0 [] tm
putStrLn "NF \{pprint[] tm'}" putStrLn "NF\n\{pprint[] tm'}"
debug "Add def \{nm} \{pprint [] tm'} : \{pprint [] ty}" debug "Add def \{nm} \{pprint [] tm'} : \{pprint [] ty}"
updateDef nm fc ty (Fn tm') updateDef nm fc ty (Fn tm')
logMetas mstart logMetas mstart
@@ -241,7 +242,7 @@ processDecl (DCheck fc tm ty) = do
processDecl (Data fc nm ty cons) = do processDecl (Data fc nm ty cons) = do
putStrLn "-----" putStrLn "-----"
putStrLn "process data \{nm}" putStrLn "Data \{nm}"
top <- get top <- get
mc <- readIORef top.metas mc <- readIORef top.metas
let mstart = length mc.metas let mstart = length mc.metas

View File

@@ -202,9 +202,9 @@ pprint names tm = render 80 $ go 0 names tm
go p names (Pi _ nm Explicit t u) = go p names (Pi _ nm Explicit t u) =
text "((" <+> text nm <+> ":" <+> go p names t <+> ")" <+> "->" <+> go p (nm :: names) u <+> ")" text "((" <+> text nm <+> ":" <+> go p names t <+> ")" <+> "->" <+> go p (nm :: names) u <+> ")"
-- FIXME - probably way wrong on the names here. There is implicit binding going on -- FIXME - probably way wrong on the names here. There is implicit binding going on
go p names (Case _ sc alts) = parens 0 p $ text "case" <+> go 0 names sc <+> text "of" </> (nest 2 (line ++ stack (map (goAlt 0 names) alts))) go p names (Case _ sc alts) = parens 0 p $ text "case" <+> go 0 names sc <+> text "of" ++ (nest 2 (line ++ stack (map (goAlt 0 names) alts)))
go p names (Lit _ lit) = text (show lit) go p names (Lit _ lit) = text (show lit)
go p names (Let _ nm t u) = parens 0 p $ text "let" <+> text nm <+> ":=" <+> go 0 names t </> (nest 2 $ go 0 names u) go p names (Let _ nm t u) = parens 0 p $ text "let" <+> text nm <+> ":=" <+> go 0 names t </> (nest 2 $ go 0 (nm :: names) u)
-- public export -- public export
-- data Closure : Nat -> Type -- data Closure : Nat -> Type