diff --git a/README.md b/README.md index 6791eeb..e3b40ce 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,14 @@ -- Support primitives +"Unifiers as Equivalences" has unification with types. Look into adapting some of that (or at least read/understand it). Indexed types are mentioned here. + +"Elaborating Dependent (Co)pattern Matching" describes building case trees. Section 5.2 has the algorithm. + +"A prettier printer" was the basis of the pretty printer. + +"Elaboration Zoo" was a resource for typechecking and elaboration. In particular pattern unification and handling of implicits is based on that. + + +- [x] Support primitives - Make DCon/TCon separate from Ref? (Or add flavor to VRef/Ref? If processing is often the same. I think I want arity though. I don't think a checked DCon can be overapplied, but it could be underapplied without special form. And special form is possibly difficult if not collecting a stack on the way down... diff --git a/newt/Fix.newt b/newt/Fix.newt new file mode 100644 index 0000000..b3ed612 --- /dev/null +++ b/newt/Fix.newt @@ -0,0 +1,50 @@ +module Fix + +-- from piforall Fix.pi +Type: U +Type = U + +-- TODO piforall makes the A in scope for the constructors +-- and has it on the let of the : +-- I think we want that for parameters? +data D : (A : Type) -> Type where + F : {A : Type} -> (D A -> D A) -> D A + V : {A : Type} -> A -> D A + + +-- Here we have two A in play, so y is type of the +-- A in V and the expected return value is the other. +-- We do need to sort this out + +unV : { A : U} -> D A -> A +unV = \ v => case v of + V y => ? -- y + -- F f => TRUSTME + +-- And here we have D A:4 and D A:1 +unF : {A : Type} -> D A -> D A -> D A +unF = \ {A} v x => + case v of + F {A} f => ? -- f x + -- V y => TRUSTME + +-- fix : {A : U} -> (A -> A) -> A +-- fix = \ {A} g => +-- -- RLet is not yet implemented... +-- let omega = -- : D A -> D A = +-- (\ x => V (g (unv {A} (unF {A} x x)))) +-- in unV {A} (omega (F omega)) + +-- data Nat : Type where +-- Zero : Nat +-- Succ : Nat -> Nat + +-- fix_add : Nat -> Nat -> Nat +-- fix_add = fix [Nat -> Nat -> Nat] +-- \radd. \x. \y. +-- case x of +-- Zero -> y +-- Succ n -> Succ (radd n y) + +-- test : fix_add 5 2 = 7 +-- test = Refl diff --git a/newt/testcase.newt b/newt/testcase.newt index 42ba0bc..b437cad 100644 --- a/newt/testcase.newt +++ b/newt/testcase.newt @@ -1,5 +1,10 @@ module Scratch +-- I'm testing cases here, but using examples carefully design to be +-- simple case trees. Patterns are a var or a constructor applied to vars. + +-- There are indexes below, but we're got pulling constraints out of them yet. + data Nat : U where Z : Nat S : Nat -> Nat diff --git a/newt/testprim.newt b/newt/testprim.newt new file mode 100644 index 0000000..0116af8 --- /dev/null +++ b/newt/testprim.newt @@ -0,0 +1,43 @@ +module TestPrim + + +-- we need to be able to declare a primitive type +-- distinct from inductive type. there are no constructors per-se but it is inhabited + +ptype String +ptype Int + +pfunc strlen : String -> Int := "(x) => x.length()" + +-- why is there an eta in here? +foo : String -> Int +foo = \ x => strlen x + +bar : String -> String -> Int +bar = \ x y => strlen x + +pfunc append : String -> String -> String := "(a,b) => a + b" + +blah : String +blah = append "hello" "world" + +pfunc plus : Int -> Int -> Int := "(a,b) => a + b" + +answer : Int +answer = plus 40 2 + +-- I'd like to define prim operators too + +-- codegen test cases +-- works, but two looks like () => (eta1) => (eta0) => one(eta1, eta0) +pfunc one : Int -> Int -> Int := "(x,y) => x + y" + +two : Int -> Int -> Int +two = one + +three : Int -> Int -> Int +three = \ x => two x + +four : Int -> Int -> Int +four = \x y => three x y + diff --git a/papers/elaborating-dependent-copattern-matching.pdf b/papers/elaborating-dependent-copattern-matching.pdf new file mode 100644 index 0000000..40988e1 Binary files /dev/null and b/papers/elaborating-dependent-copattern-matching.pdf differ diff --git a/papers/unifiers-as-equivalences.pdf b/papers/unifiers-as-equivalences.pdf new file mode 100644 index 0000000..aaade95 Binary files /dev/null and b/papers/unifiers-as-equivalences.pdf differ diff --git a/piforall/Fix.pi b/piforall/Fix.pi new file mode 100644 index 0000000..72ce3fd --- /dev/null +++ b/piforall/Fix.pi @@ -0,0 +1,54 @@ +-- Can we define the Y combinator in pi-forall? +-- Yes! See below. +-- Note: pi-forall allows recursive definitions, +-- so this is not necessary at all. + +module Fix where + +-- To type check the Y combinator, we need to have a type +-- D such that D ~~ D -> D + + +data D (A : Type) : Type where + F of (_ : D A -> D A) + V of (_ : A) + +unV : [A:Type] -> D A -> A +unV = \[A] v. + case v of + V y -> y + F f -> TRUSTME + +unF :[A:Type] -> D A -> D A -> D A +unF = \[A] v x . + case v of + F f -> f x + V y -> TRUSTME + +-- Here's the Y-combinator. To make it type +-- check, we need to add the appropriate conversions +-- into and out of the D type. + +fix : [A:Type] -> (A -> A) -> A +fix = \ [A] g. + let omega = + ( \x. V (g (unV [A] (unF [A] x x))) + : D A -> D A) in + unV [A] (omega (F omega)) + +-- Example use case + + +data Nat : Type where + Zero + Succ of ( _ : Nat) + +fix_add : Nat -> Nat -> Nat +fix_add = fix [Nat -> Nat -> Nat] + \radd. \x. \y. + case x of + Zero -> y + Succ n -> Succ (radd n y) + +test : fix_add 5 2 = 7 +test = Refl diff --git a/piforall/Lennart.pi b/piforall/Lennart.pi new file mode 100644 index 0000000..f8ecbf4 --- /dev/null +++ b/piforall/Lennart.pi @@ -0,0 +1,74 @@ +module Lennart where + +-- stack exec -- pi-forall Lennart.pi +-- with unbind / subst +-- 7.81s user 0.52s system 97% cpu 8.568 total +-- with substBind +-- 3.81s user 0.28s system 94% cpu 4.321 total +import Fix + +bool : Type +bool = [C : Type] -> C -> C -> C + +false : bool +false = \[C]. \f.\t.f +true : bool +true = \[C]. \f.\t.t + +nat : Type +nat = [C : Type] -> C -> (nat -> C) -> C +zero : nat +zero = \[C].\z.\s.z +succ : nat -> nat +succ = \n.\[C].\z.\s. s n +one : nat +one = succ zero +two : nat +two = succ one +three : nat +three = succ two +isZero : nat -> bool +isZero = \n.n [bool] true (\m.false) +const : [A:Type] -> A -> A -> A +const = \[A].\x.\y.x +prod : Type -> Type -> Type +prod = \A B. [C:Type] -> (A -> B -> C) -> C +pair : [A :Type] -> [B: Type] -> A -> B -> prod A B +pair = \[A][B] a b. \[C] p. p a b +fst : [A:Type] -> [B:Type] -> prod A B -> A +fst = \[A][B] ab. ab [A] (\a.\b.a) +snd : [A:Type] -> [B:Type] -> prod A B -> B +snd = \[A][B] ab.ab [B] (\a.\b.b) +add : nat -> nat -> nat +add = fix [nat -> nat -> nat] + \radd . \x.\y. x [nat] y (\ n. succ (radd n y)) +mul : nat -> nat -> nat +mul = fix [nat -> nat -> nat] + \rmul. \x.\y. x [nat] zero (\ n. add y (rmul n y)) +fac : nat -> nat +fac = fix [nat -> nat] + \rfac. \x. x [nat] one (\ n. mul x (rfac n)) +eqnat : nat -> nat -> bool +eqnat = fix [nat -> nat -> bool] + \reqnat. \x. \y. + x [bool] + (y [bool] true (\b.false)) + (\x1.y [bool] false (\y1. reqnat x1 y1)) +sumto : nat -> nat +sumto = fix [nat -> nat] + \rsumto. \x. x [nat] zero (\n. add x (rsumto n)) +n5 : nat +n5 = add two three +n6 : nat +n6 = add three three +n17 : nat +n17 = add n6 (add n6 n5) +n37 : nat +n37 = succ (mul n6 n6) +n703 : nat +n703 = sumto n37 +n720 : nat +n720 = fac n6 + +t : (eqnat n720 (add n703 n17)) = true +t = Refl \ No newline at end of file diff --git a/src/Lib/Check.idr b/src/Lib/Check.idr index bcfe9fd..d30c8bb 100644 --- a/src/Lib/Check.idr +++ b/src/Lib/Check.idr @@ -283,8 +283,8 @@ check ctx tm ty = case (tm, !(forceType ty)) of let names = (toList $ map fst ctx.types) env <- for ctx.types $ \(n,ty) => pure " \{n} : \{pprint names !(quote ctx.lvl ty)}" let msg = unlines (toList $ reverse env) ++ " -----------\n" ++ " goal \{pprint names ty'}" - debug "INFO at \{show fc}: " - debug msg + liftIO $ putStrLn "INFO at \{show fc}: " + liftIO $ putStrLn msg -- let context = unlines foo -- need to print 'warning' with position -- fixme - just put a name on it like idris and stuff it into top.