Fix RHole, add test files, papers, piforall examples

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...
 
 

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

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

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
+

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

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

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.