diff --git a/README.md b/README.md index 322de90..0a44488 100644 --- a/README.md +++ b/README.md @@ -38,12 +38,15 @@ I have `Let` in the core language. Partly because I'd like this to make it into I've got no idea what I'm doing here. I worked off of Jesper Cockx "Elaborating Dependent (Co)pattern Matching", leaving out codata for now. -For the dependent thing, I've change unify to return `VVar` constraints. I think this is an error typechecking on -RHS (meta solutions are handled separately). On the LHS, I'm rewriting the environment to turn the var from a bind -to a define. Unification has been tweaked to look up `VVar` in environment. Bind will hand back the same `VVar`. +For the dependent thing, I've change unify to return `VVar` constraints. I think such constraints would be an error while typechecking on RHS (meta solutions are handled separately). On the LHS, I'm rewriting the environment to turn the var from a bind to a define. Unification has been tweaked to look up `VVar` in environment. Bind will hand back the same `VVar`. -Some of this I could probably do with subst, but the RHS is `Raw`, it takes typechecking to turn it into a clean `Tm`, -and I need this information for the typechecking. +Some of this I could probably do with subst, but the RHS is `Raw`, it takes typechecking to turn it into a clean `Tm`, and I need this information for the typechecking. To substitute into the goal type for the RHS, I am now +doing a quote and eval to get case to expand. This is a bit of a stopgap because case is only eval'd when going +from `Tm` to `Val`. I think I'll need a way to eval a VCase during unification, as we do with function applications. + +## Evaluation + +Following kovacs, I'm putting `VVar` into context env when I go under binders. This avoids substitution. ## Issues diff --git a/TODO.md b/TODO.md index 8840c2b..1c96454 100644 --- a/TODO.md +++ b/TODO.md @@ -30,6 +30,7 @@ - keep as implicit and do auto if the type constructor is flagged auto - keep as implicit and mark auto, behavior overlaps a lot with implicit - have separate type of implict with `{{}}` + - `TypeClass.newt` is the exercise for this - [ ] do blocks - [ ] some solution for `+` problem (classes? ambiguity?) - [x] show compiler failure in the editor (exit code != 0) diff --git a/newt-vscode/language-configuration.json b/newt-vscode/language-configuration.json index 23a89b7..c7fccff 100644 --- a/newt-vscode/language-configuration.json +++ b/newt-vscode/language-configuration.json @@ -26,5 +26,13 @@ ["(", ")"], ["\"", "\""], ["'", "'"] + ], + "onEnterRules": [ + { + "beforeText": "^\\s+$", + "action": { + "indent": "outdent" + } + } ] -} \ No newline at end of file +} diff --git a/newt/Tree.newt b/newt/Tree.newt new file mode 100644 index 0000000..d6f9333 --- /dev/null +++ b/newt/Tree.newt @@ -0,0 +1,70 @@ +module Tree + +-- https://youtu.be/v2yXrOkzt5w?t=3013 + +data Nat : U where + Z : Nat + S : Nat -> Nat + +data Unit : U where + MkUnit : Unit + +data Void : U where + +infixl 4 _+_ + +data _+_ : U -> U -> U where + inl : {A B : U} -> A -> A + B + inr : {A B : U} -> B -> A + B + +infix 4 _<=_ + +_<=_ : Nat -> Nat -> U +Z <= y = Unit +S x <= Z = Void +S x <= S y = x <= y + +cmp : (x y : Nat) -> (x <= y) + (y <= x) +cmp Z y = inl MkUnit +cmp (S z) Z = inr MkUnit +cmp (S x) (S y) = cmp x y + +-- 53:21 + +data Bnd : U where + Bot : Bnd + N : Nat -> Bnd + Top : Bnd + +infix 4 _<<=_ + +_<<=_ : Bnd -> Bnd -> U +Bot <<= _ = Unit +N x <<= N y = x <= y +_ <<= Top = Unit +_ <<= _ = Void + +data Intv : Bnd -> Bnd -> U where + MkInt : {l u : Bnd} (x : Nat) (lx : l <<= N x) (xu : N x <<= u) -> Intv l u + +data T23 : Bnd -> Bnd -> Nat -> U where + leaf : {l u : Bnd} {h : Nat} (lu : l <<= u) -> T23 l u Z + node2 : {l u : Bnd} {h : Nat} (x : _) + (tlx : T23 l (N x) h) (txu : T23 (N x) u h) -> + T23 l u (S h) + node3 : {l u : Bnd} {h : Nat} (x y : _) + (tlx : T23 l (N x) h) (txy : T23 (N x) (N y) h) (tyu : T23 (N y) u h) -> + T23 l u (S h) + +-- -- 56: + +infixl 5 _*_ +infixl 1 _,_ +data Sg : (A : U) -> (A -> U) -> U where + _,_ : {A : U} {B : A -> U} -> (a : A) -> B a -> Sg A B + +data _*_ : (A B : U) -> U where + Foo : {A B : U} -> A -> B -> A * B + +TooBig : Bnd -> Bnd -> Nat -> U +TooBig l u h = Sg Nat (\ x => T23 l (N x) h * T23 (N x) u h) diff --git a/src/Lib/Elab.idr b/src/Lib/Elab.idr index 9407951..ce9a36e 100644 --- a/src/Lib/Elab.idr +++ b/src/Lib/Elab.idr @@ -255,7 +255,7 @@ unifyCatch fc ctx ty' ty = do debug "fail \{show ty'} \{show ty}" a <- quote ctx.lvl ty' b <- quote ctx.lvl ty - let msg = "unification failure\n failed to unify \{pprint names a}\n with \{pprint names b}\n " <+> str + let msg = "unification failure: \{str}\n failed to unify \{pprint names a}\n with \{pprint names b}\n " throwError (E fc msg) case res of MkResult [] => pure () @@ -402,7 +402,7 @@ forcedName ctx nm = case lookupName ctx nm of -- return Nothing if dcon doesn't unify with scrut buildCase : Context -> Problem -> String -> Val -> (String, Nat, Tm) -> M (Maybe CaseAlt) buildCase ctx prob scnm scty (dcName, arity, ty) = do - debug "CASE \{scnm} \{dcName} \{pprint (names ctx) ty}" + debug "CASE \{scnm} match \{dcName} ty \{pprint (names ctx) ty}" vty <- eval [] CBN ty (ctx', ty', vars, sc) <- extendPi ctx (vty) [<] [<] @@ -573,6 +573,15 @@ checkDone ctx [] body ty = do 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. + -- we don't have anything like `vapp` + -- NOW In Tree.newt we have a case/case unification that might + -- have succeeded if it was left as a functino call. + ty <- quote (length ctx.env) ty + ty <- eval ctx.env CBV ty + debug "check at \{show ty}" got <- check ctx body ty debug "DONE<- got \{pprint (names ctx) got}" pure got @@ -602,7 +611,6 @@ buildTree ctx prob@(MkProb ((MkClause fc cons (x :: xs) expr) :: cs) (VPi _ str Lam fc nm <$> buildTree ctx' ({ clauses := clauses, ty := vb } prob) buildTree ctx prob@(MkProb ((MkClause fc cons pats@(x :: xs) expr) :: cs) ty) = error fc "Extra pattern variables \{show pats}" -buildTree ctx prob@(MkProb ((MkClause fc [] [] expr) :: cs) ty) = check (withPos ctx fc) expr ty -- need to find some name we can split in (x :: xs) -- so LHS of constraint is name (or VVar - if we do Val) -- then run the split diff --git a/src/Lib/Eval.idr b/src/Lib/Eval.idr index 700b39f..263f833 100644 --- a/src/Lib/Eval.idr +++ b/src/Lib/Eval.idr @@ -56,7 +56,11 @@ evalCase env mode sc@(VRef _ nm y sp) (cc@(CaseCons name nms t) :: xs) = go env [<] rest = pure Nothing evalCase env mode sc (CaseDefault u :: xs) = pure $ Just !(eval (sc :: env) mode u) -evalCase env mode sc _ = pure Nothing +evalCase env mode sc cc = do + debug "CASE BAIL sc \{show sc} vs \{show cc}" + debug "env is \{show env}" + pure Nothing + bind : Val -> Env -> Env bind v env = v :: env diff --git a/src/Lib/Parser.idr b/src/Lib/Parser.idr index 96b50aa..3bd1d23 100644 --- a/src/Lib/Parser.idr +++ b/src/Lib/Parser.idr @@ -93,6 +93,7 @@ parseOp = parseApp >>= go 0 let Just (p,fix) = lookup op' ops -- this is eaten, but we need `->` and `:=` to not be an operator to have fatal here | Nothing => case op of + -- Location is poor on these because we pull off of the remaining token list... "->" => fail "no infix decl for \{op}" ":=" => fail "no infix decl for \{op}" op => fatal "no infix decl for \{op}" @@ -312,7 +313,7 @@ parseData : Parser Decl parseData = do fc <- getPos keyword "data" - name <- uident + name <- uident <|> token MixFix keyword ":" ty <- typeExpr keyword "where" diff --git a/src/Lib/Types.idr b/src/Lib/Types.idr index d809084..e0a8ac6 100644 --- a/src/Lib/Types.idr +++ b/src/Lib/Types.idr @@ -102,13 +102,12 @@ HasFC Tm where covering Show Tm -covering +public export covering Show CaseAlt where show (CaseDefault tm) = "_ => \{show tm}" show (CaseCons nm args tm) = "\{nm} \{unwords args} => \{show tm}" --- public export -covering +public export covering Show Tm where show (Bnd _ k) = "(Bnd \{show k})" show (Ref _ str _) = "(Ref \{show str})" diff --git a/tests/black/TestCase4.newt b/tests/black/TestCase4.newt index 4f56c21..2b1ebdd 100644 --- a/tests/black/TestCase4.newt +++ b/tests/black/TestCase4.newt @@ -47,11 +47,9 @@ zipWith : {a b c : U} {m : Nat} -> (a -> b -> c) -> Vect m a -> Vect m b -> Vect zipWith f Nil Nil = Nil zipWith f (x :: xs) (y :: ys) = f x y :: zipWith f xs ys --- NOW cases very broken here - empty switches transpose : {a : U} {m n : Nat} -> Vect m (Vect n a) -> Vect n (Vect m a) transpose {a} {Z} {n} Nil = vec n Nil transpose {a} {S z} {n} (_::_ {a'} {j} x xs) = zipWith (_::_) x (transpose xs) --- transpose {a} {m} {n} (_::_ {a'} {j} x xs) = zipWith (_::_) x (transpose xs) ptype Int