make coercion computation type-directed like it should be

lib/Quox/Whnf/Interface.idr

@@ -147,25 +147,50 @@ isK (K {}) = True
 isK _      = False
 
 
+||| if `ty` is a type constructor, and `val` is a value of that type where a
+||| coercion can be reduced. which is the case if any of:
+||| - `ty` is an atomic type
+||| - `ty` has η
+||| - `val` is a constructor form
+public export %inline
+canPushCoe : (ty, val : Term {}) -> Bool
+canPushCoe (TYPE  {}) _         = True
+canPushCoe (Pi    {}) _         = True
+canPushCoe (Lam   {}) _         = False
+canPushCoe (Sig   {}) (Pair {}) = True
+canPushCoe (Sig   {}) _         = False
+canPushCoe (Pair  {}) _         = False
+canPushCoe (Enum  {}) _         = True
+canPushCoe (Tag   {}) _         = False
+canPushCoe (Eq    {}) _         = True
+canPushCoe (DLam  {}) _         = False
+canPushCoe (Nat   {}) _         = True
+canPushCoe (Zero  {}) _         = False
+canPushCoe (Succ  {}) _         = False
+canPushCoe (BOX   {}) _         = True
+canPushCoe (Box   {}) _         = False
+canPushCoe (E     {}) _         = False
+canPushCoe (CloT  {}) _         = False
+canPushCoe (DCloT {}) _         = False
+
+
 mutual
   ||| a reducible elimination
   |||
-  ||| - a free variable, if its definition is known
-  ||| - an application whose head is an annotated lambda,
-  |||   a case expression whose head is an annotated constructor form, etc
-  ||| - a redundant annotation, or one whose term or type is reducible
-  ||| - coercions `coe (𝑖 ⇒ A) @p @q s` where:
-  |||     - `A` is in whnf, or
-  |||     - `𝑖` is not mentioned in `A`, or
-  |||     - `p = q`
-  |||     - [fixme] this is not true right now but that's because i wrote it
-  |||       wrong
-  ||| - compositions `comp A @p @q s @r {⋯}` where:
-  |||     - `A` is in whnf, or
-  |||     - `p = q`, or
-  |||     - `r = 0` or `r = 1`
-  |||     - [fixme] the p=q condition is also missing here
-  ||| - closures
+  ||| 1. a free variable, if its definition is known
+  ||| 2. an elimination whose head is reducible
+  ||| 3. an "active" elimination:
+  |||    an application whose head is an annotated lambda,
+  |||    a case expression whose head is an annotated constructor form, etc
+  ||| 4. a redundant annotation, or one whose term or type is reducible
+  ||| 5. a coercion `coe (𝑖 ⇒ A) @p @q s` where:
+  |||      a. `A` is reducible or a type constructor, or
+  |||      b. `𝑖` is not mentioned in `A`
+  |||         ([fixme] should be A‹0/𝑖› = A‹1/𝑖›), or
+  |||      c. `p = q`
+  ||| 6. a composition `comp A @p @q s @r {⋯}`
+  |||    where `p = q`, `r = 0`, or `r = 1`
+  ||| 7. a closure
   public export
   isRedexE : RedexTest Elim
   isRedexE defs (F {x, _}) {d, n} =
@@ -185,10 +210,11 @@ mutual
     isRedexE defs fun || isDLamHead fun || isK arg
   isRedexE defs (Ann {tm, ty, _}) =
     isE tm || isRedexT defs tm || isRedexT defs ty
-  isRedexE defs (Coe {val, _}) =
-    isRedexT defs val || not (isE val)
-  isRedexE defs (Comp {ty, r, _}) =
-    isRedexT defs ty || isK r
+  isRedexE defs (Coe {ty = S _ (N _), _}) = True
+  isRedexE defs (Coe {ty = S _ (Y ty), p, q, val, _}) =
+    isRedexT defs ty || canPushCoe ty val || isYes (p `decEqv` q)
+  isRedexE defs (Comp {ty, r, p, q, _}) =
+    isYes (p `decEqv` q) || isK r
   isRedexE defs (TypeCase {ty, ret, _}) =
     isRedexE defs ty || isRedexT defs ret || isAnnTyCon ty
   isRedexE _ (CloE  {}) = True
@@ -196,10 +222,10 @@ mutual
 
   ||| a reducible term
   |||
-  ||| - a reducible elimination, as `isRedexE`
-  ||| - an annotated elimination
-  |||   (the annotation is redundant in a checkable context)
-  ||| - a closure
+  ||| 1. a reducible elimination, as `isRedexE`
+  ||| 2. an annotated elimination
+  |||    (the annotation is redundant in a checkable context)
+  ||| 3. a closure
   public export
   isRedexT : RedexTest Term
   isRedexT _    (CloT  {}) = True