diff options
author | Chloe Brown <chloe.brown.00@outlook.com> | 2023-03-25 16:15:51 +0000 |
---|---|---|
committer | Chloe Brown <chloe.brown.00@outlook.com> | 2023-03-25 16:15:51 +0000 |
commit | 0225730f5461e693386031a8f06085d2354d6537 (patch) | |
tree | 94929f78a1df48e30c809003f212e1f28514667f /src/Main.idr | |
parent | dc600f47e15ff59a46890ca32e5571e24ce00983 (diff) |
Extract thinnings to a new module.
Also make the interface more abstract, so more efficient representations
can be swapped in with less cost.
Diffstat (limited to 'src/Main.idr')
-rw-r--r-- | src/Main.idr | 54 |
1 files changed, 2 insertions, 52 deletions
diff --git a/src/Main.idr b/src/Main.idr index 6a5fe1b..05208eb 100644 --- a/src/Main.idr +++ b/src/Main.idr @@ -2,6 +2,7 @@ module Main import CC.Name import CC.Term +import CC.Thinning import Data.DPair import Data.List @@ -37,57 +38,6 @@ eval env (Let n t u) = eval (env :< (n, eval env t)) u -------------------------------------------------------------------------------- -data Thins : (src, tgt : Context) -> Type where - Empty : [<] `Thins` [<] - Drop : src `Thins` tgt -> src `Thins` tgt :< n - Keep : src `Thins` tgt -> src :< n `Thins` tgt :< n - -%name Thins thin - -id : {ctx : Context} -> ctx `Thins` ctx -id {ctx = [<]} = Empty -id {ctx = _ :< _} = Keep id - -distance : src `Thins` tgt -> {k : Nat} -> (0 prf : IsVar k n src) -> Nat -distance (Drop thin) prf = S (distance thin prf) -distance (Keep thin) {k = 0} (Here eq) = 0 -distance (Keep thin) {k = S k} (There prf) = distance thin prf - -0 wknIsVar : - (prf : IsVar k n src) -> - (thin : src `Thins` tgt) -> - IsVar (distance thin prf + k) n tgt -wknIsVar prf Empty impossible -wknIsVar prf (Drop thin) = There (wknIsVar prf thin) -wknIsVar (Here eq) (Keep thin) = Here eq -wknIsVar (There {k} prf) (Keep thin) = - rewrite sym $ plusSuccRightSucc (distance thin prf) k in - There (wknIsVar prf thin) - -wknTerm : Term src -> src `Thins` tgt -> Term tgt -wknTerm (Var k n prf) thin = Var (distance thin prf + k) n (wknIsVar prf thin) -wknTerm (Abs n t) thin = Abs n (wknTerm t (Keep thin)) -wknTerm (App t u) thin = App (wknTerm t thin) (wknTerm u thin) -wknTerm (Let n t u) thin = Let n (wknTerm t thin) (wknTerm u (Keep thin)) - -wknNtrl : Neutral src -> src `Thins` tgt -> Neutral tgt -wknVal : Value src -> src `Thins` tgt -> Value tgt -wknClose : Closure src -> src `Thins` tgt -> Closure tgt -wknEnv : Env local src -> src `Thins` tgt -> Env local tgt - -wknNtrl (VVar k n prf) thin = VVar (distance thin prf + k) n (wknIsVar prf thin) -wknNtrl (VApp n v) thin = VApp (wknNtrl n thin) (wknVal v thin) - -wknVal (Ntrl n) thin = Ntrl (wknNtrl n thin) -wknVal (VAbs close) thin = VAbs (wknClose close thin) - -wknClose (Close n env t) thin = Close n (wknEnv env thin) t - -wknEnv [<] thin = [<] -wknEnv (env :< (n, v)) thin = wknEnv env thin :< (n, wknVal v thin) - --------------------------------------------------------------------------------- - quote : {ctx : _} -> Value ctx -> Term ctx quoteNtrl : {ctx : _} -> Neutral ctx -> Term ctx @@ -96,7 +46,7 @@ quote (VAbs close@(Close n _ _)) = Abs n $ assert_total $ quote $ - app (wknClose close (Drop id)) (Ntrl $ VVar 0 n $ Here $ reflexive {rel = (~~)}) + app (wknClose close (drop id)) (Ntrl $ VVar 0 n $ Here $ reflexive {rel = (~~)}) quoteNtrl (VVar k n prf) = Var k n prf quoteNtrl (VApp n v) = App (quoteNtrl n) (quote v) |