bikeshedding

src/Quox/Context.idr

@@ -36,25 +36,25 @@ Context' a = Context (\_ => a)
 
 
 export
-toSnocList : Telescope tm _ _ -> SnocList (Exists tm)
+toSnocList : Telescope {tm, _} -> SnocList (Exists tm)
 toSnocList [<]        = [<]
 toSnocList (tel :< t) = toSnocList tel :< Evidence _ t
 
 private
-toListAcc : Telescope tm _ _ -> List (Exists tm) -> List (Exists tm)
+toListAcc : Telescope {tm, _} -> List (Exists tm) -> List (Exists tm)
 toListAcc [<]        acc = acc
 toListAcc (tel :< t) acc = toListAcc tel (Evidence _ t :: acc)
 
 export %inline
-toList : Telescope tm _ _ -> List (Exists tm)
+toList : Telescope {tm, _} -> List (Exists tm)
 toList tel = toListAcc tel []
 
 export %inline
-toSnocList' : Telescope' a _ _ -> SnocList a
+toSnocList' : Telescope' {a, _} -> SnocList a
 toSnocList' = map snd . toSnocList
 
 export %inline
-toList' : Telescope' a _ _ -> List a
+toList' : Telescope' {a, _} -> List a
 toList' = map snd . toList
 
 
@@ -65,15 +65,15 @@ tel1 . [<]         = tel1
 tel1 . (tel2 :< s) = (tel1 . tel2) :< s
 
 
-export
+public export
-getWith : CanShift tm => Context tm len -> Var len -> Shift len out -> tm out
+getShift : CanShift tm => Context tm len -> Var len -> Shift len out -> tm out
-getWith (ctx :< t) VZ     th = t // drop1 th
+getShift (ctx :< t) VZ     by = t // drop1 by
-getWith (ctx :< t) (VS i) th = getWith ctx i (drop1 th)
+getShift (ctx :< t) (VS i) by = getShift ctx i (drop1 by)
 
 infixl 8 !!
-export %inline
+public export %inline
 (!!) : CanShift tm => Context tm len -> Var len -> tm len
-ctx !! i = getWith ctx i SZ
+ctx !! i = getShift ctx i SZ
 
 
 ||| a triangle of bindings. each type binding in a context counts the ues of
@@ -173,36 +173,35 @@ zipWith3Lazy f = zipWith3 $ \x, y, z => delay $ f x y z
 
 
 export
-lengthPrf : Telescope _ from to -> Subset Nat $ \len => len + from = to
+lengthPrf : Telescope _ from to -> (len : Nat ** len + from = to)
-lengthPrf [<]        = Element 0 Refl
+lengthPrf [<]        = (0 ** Refl)
-lengthPrf (tel :< _) = let len = lengthPrf tel in
+lengthPrf (tel :< _) =
-                       Element (S len.fst) (cong S len.snd)
+  let len = lengthPrf tel in (S len.fst ** cong S len.snd)
 
 public export %inline
 length : Telescope {} -> Nat
 length = fst . lengthPrf
 
 
-parameters {0 acc : Nat -> Type}
+export
-  export
+foldl : {0 acc : Nat -> Type} ->
-  foldl : (forall m, n. acc m -> tm n -> acc (S m)) ->
+        (f : forall n. acc n -> tm (n + from) -> acc (S n)) ->
-          acc 0 -> (tel : Telescope tm from to) -> acc (length tel)
+        (z : acc 0) -> (tel : Telescope tm from to) -> acc (length tel)
-  foldl f z [<]        = z
+foldl f z [<]        = z
-  foldl f z (tel :< t) = f (foldl f z tel) t
+foldl f z (tel :< t) = f (foldl f z tel) (rewrite (lengthPrf tel).snd in t)
 
-parameters {auto _ : Monoid a}
+export %inline
-  export %inline
+foldMap : Monoid a => (forall n. tm n -> a) -> Telescope tm from to -> a
-  foldMap : (forall n. tm n -> a) -> Telescope tm from to -> a
+foldMap f = foldl (\acc, tm => acc <+> f tm) neutral
-  foldMap f = foldl (\acc, tm => acc <+> f tm) neutral
 
-  export %inline
+export %inline
-  fold : Telescope' a from to -> a
+fold : Monoid a => Telescope' a from to -> a
-  fold = foldMap id
+fold = foldMap id
 
-  ||| like `fold` but calculate the elements only when actually appending
+||| like `fold` but calculate the elements only when actually appending
-  export %inline
+export %inline
-  foldLazy : Telescope' (Lazy a) from to -> a
+foldLazy : Monoid a => Telescope' (Lazy a) from to -> a
-  foldLazy = foldMap force
+foldLazy = foldMap force
 
 
 export %inline