add Functor etc for IfConsistent

lib/Quox/Syntax/DimEq.idr

@@ -29,10 +29,36 @@ data DimEq : Nat -> Type where
 
 
 public export
-data IfConsistent : DimEq d -> a -> Type where
+consistent : DimEq d -> Bool
+consistent ZeroIsOne = False
+consistent (C eqs)   = True
+
+
+public export
+data IfConsistent : DimEq d -> Type -> Type where
   Nothing :      IfConsistent ZeroIsOne a
   Just    : a -> IfConsistent (C eqs)   a
 
+export
+Functor (IfConsistent eqs) where
+  map f Nothing  = Nothing
+  map f (Just x) = Just (f x)
+
+export
+Foldable (IfConsistent eqs) where
+  foldr f z Nothing  = z
+  foldr f z (Just x) = f x z
+
+export
+Traversable (IfConsistent eqs) where
+  traverse f Nothing  = pure Nothing
+  traverse f (Just x) = Just <$> f x
+
+public export
+ifConsistent : Applicative f => (eqs : DimEq d) -> f a -> f (IfConsistent eqs a)
+ifConsistent ZeroIsOne act = pure Nothing
+ifConsistent (C _)     act = Just <$> act
+
 
 export %inline
 zeroEq : DimEq 0

lib/Quox/Typechecker.idr

@@ -62,10 +62,7 @@ parameters {auto _ : IsQty q} {auto _ : CanTC q m}
   export covering %inline
   check : (ctx : TyContext q d n) -> SQty q -> Term q d n -> Term q d n ->
           m (CheckResult ctx.dctx q n)
-  check ctx@(MkTyContext {dctx, _}) sg subj ty =
-    case dctx of
-      ZeroIsOne => pure Nothing
-      C _       => Just <$> checkC ctx sg subj ty
+  check ctx sg subj ty = ifConsistent ctx.dctx $ checkC ctx sg subj ty
 
   ||| "Ψ | Γ ⊢₀ s ⇐ A"
   |||
@@ -95,10 +92,7 @@ parameters {auto _ : IsQty q} {auto _ : CanTC q m}
   export covering %inline
   infer : (ctx : TyContext q d n) -> SQty q -> Elim q d n ->
           m (InferResult ctx.dctx q d n)
-  infer ctx@(MkTyContext {dctx, _}) sg subj =
-    case dctx of
-      ZeroIsOne => pure Nothing
-      C _       => Just <$> inferC ctx sg subj
+  infer ctx sg subj = ifConsistent ctx.dctx $ inferC ctx sg subj
 
   ||| `infer`, assuming the dimension context is consistent
   export covering %inline