rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

ScopeTerms that can bind multiple vars

Browse source
This commit is contained in:
rhiannon morris 2023-01-23 03:22:50 +01:00
parent 92617a2e4a
commit f0f49d9abf
5 changed files with 86 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lib/Quox/Equal.idr
View file

@ -165,13 +165,14 @@ parameters {0 isGlobal : _} (defs : Definitions' q isGlobal)
compare0 : CanEqual q m => Eq q => Elim q 0 n -> Elim q 0 n -> m ()
compare0 e f = compareN (whnf defs e) (whnf defs f)
namespace ScopeTerm
namespace ScopeTermN
export covering %inline
compare0 : CanEqual q m => Eq q =>
ScopeTerm q 0 n -> ScopeTerm q 0 n -> m ()
compare0 : {s : Nat} -> CanEqual q m => Eq q =>
ScopeTermN s q 0 n -> ScopeTermN s q 0 n -> m ()
compare0 (TUnused body0) (TUnused body1) = compare0 body0 body1
compare0 body0 body1 = compare0 body0.term body1.term
-- [todo] extend to multi-var scopes
namespace DScopeTerm
export covering %inline
compare0 : CanEqual q m => Eq q =>

11
lib/Quox/Syntax/Subst.idr
View file

@ -5,6 +5,7 @@ import Quox.Syntax.Var
import Quox.Name
import Quox.Pretty
import Data.Nat
import Data.List
%default total
@ -84,6 +85,16 @@ public export %inline
push : CanSubst1 f => Subst f from to -> Subst f (S from) (S to)
push th = fromVar VZ ::: (th . shift 1)
-- [fixme] a better way to do this?
public export
pushN : CanSubst1 f => (s : Nat) ->
Subst f from to -> Subst f (s + from) (s + to)
pushN 0 th = th
pushN (S s) th =
rewrite plusSuccRightSucc s from in
rewrite plusSuccRightSucc s to in
pushN s $ fromVar VZ ::: (th . shift 1)
public export
drop1 : Subst f (S from) to -> Subst f from to
drop1 (Shift by) = Shift $ ssDown by

36
lib/Quox/Syntax/Term/Base.idr
View file

@ -92,26 +92,34 @@ mutual
DCloE : (el : Elim q dfrom n) -> (th : Lazy (DSubst dfrom dto)) ->
Elim q dto n
||| a scope with one more bound variable
||| a scope with some more bound term variables
public export
data ScopeTerm : TermLike where
||| variable is used
TUsed : (body : Term q d (S n)) -> ScopeTerm q d n
||| variable is unused
TUnused : (body : Term q d n) -> ScopeTerm q d n
data ScopeTermN : Nat -> TermLike where
||| at least some variables are used
TUsed : (body : Term q d (s + n)) -> ScopeTermN s q d n
||| all variables are unused
TUnused : (body : Term q d n) -> ScopeTermN s q d n
||| a scope with one more bound dimension variable
public export
data DScopeTerm : TermLike where
||| variable is used
DUsed : (body : Term q (S d) n) -> DScopeTerm q d n
||| variable is unused
DUnused : (body : Term q d n) -> DScopeTerm q d n
0 ScopeTerm : TermLike
ScopeTerm = ScopeTermN 1
||| a scope with some more bound dimension variable
public export
data DScopeTermN : Nat -> TermLike where
||| at least some variables are used
DUsed : (body : Term q (s + d) n) -> DScopeTermN s q d n
||| all variables are unused
DUnused : (body : Term q d n) -> DScopeTermN s q d n
public export
0 DScopeTerm : TermLike
DScopeTerm = DScopeTermN 1
%name Term s, t, r
%name Elim e, f
%name ScopeTerm body
%name DScopeTerm body
%name ScopeTermN body
%name DScopeTermN body
||| non dependent function type
public export %inline

2
lib/Quox/Syntax/Term/Pretty.idr
View file

@ -82,7 +82,7 @@ mutual
[|withPrec SApp (prettyM e) </> prettyDSubst th|]
export covering
PrettyHL q => PrettyHL (ScopeTerm q d n) where
{s : Nat} -> PrettyHL q => PrettyHL (ScopeTermN s q d n) where
prettyM body = prettyM body.term
export covering

78
lib/Quox/Syntax/Term/Subst.idr
View file

@ -42,16 +42,18 @@ mutual
DCloE e ph /// th = DCloE e $ ph . th
e /// th = DCloE e th
namespace ScopeTerm
namespace ScopeTermN
export
(///) : ScopeTerm q dfrom n -> DSubst dfrom dto -> ScopeTerm q dto n
(///) : ScopeTermN s q dfrom n -> DSubst dfrom dto -> ScopeTermN s q dto n
TUsed body /// th = TUsed $ body /// th
TUnused body /// th = TUnused $ body /// th
namespace DScopeTerm
namespace DScopeTermN
export
(///) : DScopeTerm q dfrom n -> DSubst dfrom dto -> DScopeTerm q dto n
DUsed body /// th = DUsed $ body /// push th
(///) : {s : Nat} ->
DScopeTermN s q dfrom n -> DSubst dfrom dto ->
DScopeTermN s q dto n
DUsed body /// th = DUsed $ body /// pushN s th
DUnused body /// th = DUnused $ body /// th
@ -89,19 +91,25 @@ CanSubst (Elim q d) (Term q d) where
th => CloT s th
export %inline
CanSubst (Elim q d) (ScopeTerm q d) where
TUsed body // th = TUsed $ body // push th
{s : Nat} -> CanSubst (Elim q d) (ScopeTermN s q d) where
TUsed body // th = TUsed $ body // pushN s th
TUnused body // th = TUnused $ body // th
export %inline
CanSubst (Elim q d) (DScopeTerm q d) where
DUsed body // th = DUsed $ body // map (/// shift 1) th
{s : Nat} -> CanSubst (Elim q d) (DScopeTermN s q d) where
DUsed body // th = DUsed $ body // map (/// shift s) th
DUnused body // th = DUnused $ body // th
export %inline CanSubst Var (Term q d) where s // th = s // map (B {q, d}) th
export %inline CanSubst Var (Elim q d) where e // th = e // map (B {q, d}) th
export %inline CanSubst Var (ScopeTerm q d) where s // th = s // map (B {q, d}) th
export %inline CanSubst Var (DScopeTerm q d) where s // th = s // map (B {q, d}) th
export %inline CanSubst Var (Term q d) where s // th = s // map (B {q, d}) th
export %inline CanSubst Var (Elim q d) where e // th = e // map (B {q, d}) th
export %inline
{s : Nat} -> CanSubst Var (ScopeTermN s q d) where
b // th = b // map (B {q, d}) th
export %inline
{s : Nat} -> CanSubst Var (DScopeTermN s q d) where
b // th = b // map (B {q, d}) th
infixl 8 //., ///
@ -130,33 +138,43 @@ mutual
Elim q dto to
subs e th ph = e /// th // ph
namespace ScopeTerm
namespace ScopeTermN
||| applies a term substitution with a less ambiguous type
export %inline
(//.) : ScopeTerm q d from -> TSubst q d from to -> ScopeTerm q d to
(//.) : {s : Nat} ->
ScopeTermN s q d from -> TSubst q d from to ->
ScopeTermN s q d to
body //. th = body // th
||| applies a term and dimension substitution
public export %inline
subs : ScopeTerm q dfrom from -> DSubst dfrom dto -> TSubst q dto from to ->
ScopeTerm q dto to
subs : {s : Nat} ->
ScopeTermN s q dfrom from ->
DSubst dfrom dto -> TSubst q dto from to ->
ScopeTermN s q dto to
subs body th ph = body /// th // ph
namespace DScopeTerm
namespace DScopeTermN
||| applies a term substitution with a less ambiguous type
export %inline
(//.) : DScopeTerm q d from -> TSubst q d from to -> DScopeTerm q d to
(//.) : {s : Nat} -> DScopeTermN s q d from -> TSubst q d from to ->
DScopeTermN s q d to
body //. th = body // th
||| applies a term and dimension substitution
public export %inline
subs : DScopeTerm q dfrom from -> DSubst dfrom dto -> TSubst q dto from to ->
DScopeTerm q dto to
subs : {s : Nat} ->
DScopeTermN s q dfrom from ->
DSubst dfrom dto -> TSubst q dto from to ->
DScopeTermN s q dto to
subs body th ph = body /// th // ph
export %inline CanShift (Term q d) where s // by = s //. Shift by
export %inline CanShift (Elim q d) where e // by = e //. Shift by
export %inline CanShift (ScopeTerm q d) where s // by = s //. Shift by
export %inline CanShift (Term q d) where s // by = s //. Shift by
export %inline CanShift (Elim q d) where e // by = e //. Shift by
export %inline
{s : Nat} -> CanShift (ScopeTermN s q d) where
b // by = b //. Shift by
export %inline
@ -165,17 +183,17 @@ comp : DSubst dfrom dto -> TSubst q dfrom from mid -> TSubst q dto mid to ->
comp th ps ph = map (/// th) ps . ph
namespace ScopeTerm
namespace ScopeTermN
export %inline
(.term) : ScopeTerm q d n -> Term q d (S n)
(.term) : {s : Nat} -> ScopeTermN s q d n -> Term q d (s + n)
(TUsed body).term = body
(TUnused body).term = body //. shift 1
(TUnused body).term = body //. shift s
namespace DScopeTerm
namespace DScopeTermN
export %inline
(.term) : DScopeTerm q d n -> Term q (S d) n
(.term) : {s : Nat} -> DScopeTermN s q d n -> Term q (s + d) n
(DUsed body).term = body
(DUnused body).term = body /// shift 1
(DUnused body).term = body /// shift s
export %inline
sub1 : ScopeTerm q d n -> Elim q d n -> Term q d n