some refactors

lib/Quox/Syntax/Term/Tighten.idr

@@ -244,25 +244,41 @@ mutual
   dtightenDS = assert_total $ tightenScope dtightenT
 
 
-export [TermD] Tighten (\d => Term d n) where tighten p t = dtightenT p t
-export [ElimD] Tighten (\d => Elim d n) where tighten p e = dtightenE p e
+export Tighten (\d => Term d n) where tighten p t = dtightenT p t
+export Tighten (\d => Elim d n) where tighten p e = dtightenE p e
+
+
+parameters {auto _ : Tighten f} {s : Nat}
+  export
+  squeeze : Scoped s f n -> Either (BContext s, f (s + n)) (f n)
+  squeeze (S ns (N t)) = Right t
+  squeeze (S ns (Y t)) = maybe (Left (ns, t)) Right $ tightenN s t
+
+  export
+  squeeze' : Scoped s f n -> Scoped s f n
+  squeeze' = either (uncurry SY) SN . squeeze
+
+parameters {0 f : Nat -> Nat -> Type}
+           {auto tt : Tighten (\d => f d n)} {s : Nat}
+  export
+  dsqueeze : Scoped s (\d => f d n) d ->
+             Either (BContext s, f (s + d) n) (f d n)
+  dsqueeze = squeeze
+
+  export
+  dsqueeze' : Scoped s (\d => f d n) d -> Scoped s (\d => f d n) d
+  dsqueeze' = squeeze'
 
 
 -- versions of SY, etc, that try to tighten and use SN automatically
 
 public export
 ST : Tighten f => {s : Nat} -> BContext s -> f (s + n) -> Scoped s f n
-ST names body =
-  case tightenN s body of
-    Just body => S names $ N body
-    Nothing   => S names $ Y body
+ST names body = squeeze' $ SY names body
 
 public export
 DST : {s : Nat} -> BContext s -> Term (s + d) n -> DScopeTermN s d n
-DST names body =
-  case tightenN @{TermD} s body of
-    Just body => S names $ N body
-    Nothing   => S names $ Y body
+DST names body = dsqueeze' {f = Term} $ SY names body
 
 public export %inline
 PiT : (qty : Qty) -> (x : BindName) ->
@@ -302,38 +318,11 @@ typeCase1T ty ret k ns body loc {def} =
   typeCase ty ret [(k ** ST ns body)] def loc
 
 
-export
-squeeze : {s : Nat} -> ScopeTermN s d n -> ScopeTermN s d n
-squeeze (S names (Y body)) = S names $ maybe (Y body) N $ tightenN s body
-squeeze (S names (N body)) = S names $ N body
-
-export
-dsqueeze : {s : Nat} -> DScopeTermN s d n -> DScopeTermN s d n
-dsqueeze (S names (Y body)) =
-  S names $ maybe (Y body) N $ tightenN s body @{TermD}
-dsqueeze (S names (N body)) = S names $ N body
-
-
-export
-squeezed : {s : Nat} -> ScopeTermN s d n ->
-           Either (BContext s, Term d (s + n)) (Term d n)
-squeezed (S ns (N t)) = Right t
-squeezed (S ns (Y t)) = maybe (Left (ns, t)) Right $ tightenN s t
-
-export
-dsqueezed : {s : Nat} -> DScopeTermN s d n ->
-            Either (BContext s, Term (s + d) n) (Term d n)
-dsqueezed (S ns (N t)) = Right t
-dsqueezed (S ns (Y t)) = maybe (Left (ns, t)) Right $ tightenN s t @{TermD}
-
-
-
 public export %inline
 CompH' : (ty : DScopeTerm d n) -> (p, q : Dim d) -> (val : Term d n) ->
          (r : Dim d) -> (zero, one : DScopeTerm d n) -> (loc : Loc) -> Elim d n
 CompH' {ty, p, q, val, r, zero, one, loc} =
-  -- [fixme] maintain location of existing B VZ
-  let ty' = DST ty.names $ ty.term // (B VZ ty.loc ::: shift 2) in
+  let ty' = DST ty.names $ ty.term // (B VZ ty.name.loc ::: shift 2) in
   Comp {
     ty = dsub1 ty q, p, q,
     val = E $ Coe ty p q val val.loc, r,