164 lines
4.7 KiB
Idris
164 lines
4.7 KiB
Idris
module Quox.Syntax.Term.Reduce
|
|
|
|
import Quox.Syntax.Term.Base
|
|
import Quox.Syntax.Term.Subst
|
|
|
|
%default total
|
|
|
|
|
|
mutual
|
|
||| true if a term has a closure or dimension closure at the top level,
|
|
||| or is `E` applied to such an elimination
|
|
public export %inline
|
|
topCloT : Term d n -> Bool
|
|
topCloT (CloT _ _) = True
|
|
topCloT (DCloT _ _) = True
|
|
topCloT (E e) = topCloE e
|
|
topCloT _ = False
|
|
|
|
||| true if an elimination has a closure or dimension closure at the top level
|
|
public export %inline
|
|
topCloE : Elim d n -> Bool
|
|
topCloE (CloE _ _) = True
|
|
topCloE (DCloE _ _) = True
|
|
topCloE _ = False
|
|
|
|
|
|
public export IsNotCloT : Term d n -> Type
|
|
IsNotCloT = So . not . topCloT
|
|
|
|
||| a term which is not a top level closure
|
|
public export NotCloTerm : Nat -> Nat -> Type
|
|
NotCloTerm d n = Subset (Term d n) IsNotCloT
|
|
|
|
public export IsNotCloE : Elim d n -> Type
|
|
IsNotCloE = So . not . topCloE
|
|
|
|
||| an elimination which is not a top level closure
|
|
public export NotCloElim : Nat -> Nat -> Type
|
|
NotCloElim d n = Subset (Elim d n) IsNotCloE
|
|
|
|
public export %inline
|
|
ncloT : (t : Term d n) -> (0 _ : IsNotCloT t) => NotCloTerm d n
|
|
ncloT t @{p} = Element t p
|
|
|
|
public export %inline
|
|
ncloE : (t : Elim d n) -> (0 _ : IsNotCloE t) => NotCloElim d n
|
|
ncloE e @{p} = Element e p
|
|
|
|
|
|
|
|
mutual
|
|
||| if the input term has any top-level closures, push them under one layer of
|
|
||| syntax
|
|
export %inline
|
|
pushSubstsT : Term d n -> NotCloTerm d n
|
|
pushSubstsT s = pushSubstsTWith id id s
|
|
|
|
||| if the input elimination has any top-level closures, push them under one
|
|
||| layer of syntax
|
|
export %inline
|
|
pushSubstsE : Elim d n -> NotCloElim d n
|
|
pushSubstsE e = pushSubstsEWith id id e
|
|
|
|
export
|
|
pushSubstsTWith : DSubst dfrom dto -> TSubst dto from to ->
|
|
Term dfrom from -> NotCloTerm dto to
|
|
pushSubstsTWith th ph (TYPE l) =
|
|
ncloT $ TYPE l
|
|
pushSubstsTWith th ph (Pi qty x a body) =
|
|
ncloT $ Pi qty x (subs a th ph) (subs body th ph)
|
|
pushSubstsTWith th ph (Lam x body) =
|
|
ncloT $ Lam x $ subs body th ph
|
|
pushSubstsTWith th ph (E e) =
|
|
let Element e _ = pushSubstsEWith th ph e in ncloT $ E e
|
|
pushSubstsTWith th ph (CloT s ps) =
|
|
pushSubstsTWith th (comp' th ps ph) s
|
|
pushSubstsTWith th ph (DCloT s ps) =
|
|
pushSubstsTWith (ps . th) ph s
|
|
|
|
export
|
|
pushSubstsEWith : DSubst dfrom dto -> TSubst dto from to ->
|
|
Elim dfrom from -> NotCloElim dto to
|
|
pushSubstsEWith th ph (F x) =
|
|
ncloE $ F x
|
|
pushSubstsEWith th ph (B i) =
|
|
assert_total pushSubstsE $ ph !! i
|
|
pushSubstsEWith th ph (f :@ s) =
|
|
ncloE $ subs f th ph :@ subs s th ph
|
|
pushSubstsEWith th ph (s :# a) =
|
|
ncloE $ subs s th ph :# subs a th ph
|
|
pushSubstsEWith th ph (CloE e ps) =
|
|
pushSubstsEWith th (comp' th ps ph) e
|
|
pushSubstsEWith th ph (DCloE e ps) =
|
|
pushSubstsEWith (ps . th) ph e
|
|
|
|
|
|
parameters (th : DSubst dfrom dto) (ph : TSubst dto from to)
|
|
public export %inline
|
|
pushSubstsTWith' : Term dfrom from -> Term dto to
|
|
pushSubstsTWith' s = (pushSubstsTWith th ph s).fst
|
|
|
|
public export %inline
|
|
pushSubstsEWith' : Elim dfrom from -> Elim dto to
|
|
pushSubstsEWith' e = (pushSubstsEWith th ph e).fst
|
|
|
|
|
|
public export %inline
|
|
pushSubstsT' : Term d n -> Term d n
|
|
pushSubstsT' s = (pushSubstsT s).fst
|
|
|
|
public export %inline
|
|
pushSubstsE' : Elim d n -> Elim d n
|
|
pushSubstsE' e = (pushSubstsE e).fst
|
|
|
|
|
|
mutual
|
|
-- tightening a term/elim also causes substitutions to be pushed through.
|
|
-- this is because otherwise a variable in an unused part of the subst
|
|
-- would cause it to incorrectly fail
|
|
|
|
export covering
|
|
Tighten (Term d) where
|
|
tighten p (TYPE l) =
|
|
pure $ TYPE l
|
|
tighten p (Pi qty x arg res) =
|
|
Pi qty x <$> tighten p arg
|
|
<*> tighten p res
|
|
tighten p (Lam x body) =
|
|
Lam x <$> tighten p body
|
|
tighten p (E e) =
|
|
E <$> tighten p e
|
|
tighten p (CloT tm th) =
|
|
tighten p $ pushSubstsTWith' id th tm
|
|
tighten p (DCloT tm th) =
|
|
tighten p $ pushSubstsTWith' th id tm
|
|
|
|
export covering
|
|
Tighten (Elim d) where
|
|
tighten p (F x) =
|
|
pure $ F x
|
|
tighten p (B i) =
|
|
B <$> tighten p i
|
|
tighten p (fun :@ arg) =
|
|
[|tighten p fun :@ tighten p arg|]
|
|
tighten p (tm :# ty) =
|
|
[|tighten p tm :# tighten p ty|]
|
|
tighten p (CloE el th) =
|
|
tighten p $ pushSubstsEWith' id th el
|
|
tighten p (DCloE el th) =
|
|
tighten p $ pushSubstsEWith' th id el
|
|
|
|
export covering
|
|
Tighten (ScopeTerm d) where
|
|
tighten p (TUsed body) = TUsed <$> tighten (Keep p) body
|
|
tighten p (TUnused body) = TUnused <$> tighten p body
|
|
|
|
|
|
public export %inline
|
|
weakT : Term d n -> Term d (S n)
|
|
weakT t = t //. shift 1
|
|
|
|
public export %inline
|
|
weakE : Elim d n -> Elim d (S n)
|
|
weakE t = t //. shift 1
|