aboutsummaryrefslogtreecommitdiff
path: root/kernel
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2019-11-25 15:26:20 +0100
committerPierre-Marie Pédrot2020-12-09 14:05:53 +0100
commitd6f1694326bec39c1fe41f38c7c9bd37c1a8c27b (patch)
treec630f1e282b77186f1abbeb8ccad225c8db691fb /kernel
parent9e0ca704fa8273a8337ff9e118d2d08620af8962 (diff)
Cleanup substitution API.
Diffstat (limited to 'kernel')
-rw-r--r--kernel/esubst.ml33
-rw-r--r--kernel/esubst.mli10
2 files changed, 1 insertions, 42 deletions
diff --git a/kernel/esubst.ml b/kernel/esubst.ml
index 3e8502b988..558ff96486 100644
--- a/kernel/esubst.ml
+++ b/kernel/esubst.ml
@@ -93,11 +93,6 @@ let subs_shft = function
| (n, s) -> SHIFT (n,s)
let subs_shft s = if Int.equal (fst s) 0 then snd s else subs_shft s
-let subs_shift_cons = function
- (0, s, t) -> CONS(t,s)
-| (k, SHIFT(n,s1), t) -> CONS(t,SHIFT(k+n, s1))
-| (k, s, t) -> CONS(t,SHIFT(k, s));;
-
(* Tests whether a substitution is equal to the identity *)
let rec is_subs_id = function
ESID _ -> true
@@ -156,31 +151,3 @@ let rec lift_subst mk_cl s1 s2 = match s1 with
if k<k'
then subs_liftn k (lift_subst mk_cl s (subs_liftn (k'-k) s'))
else subs_liftn k' (lift_subst mk_cl (el_liftn (k-k') s) s')
-
-let rec comp mk_cl s1 s2 =
- match (s1, s2) with
- | _, ESID _ -> s1
- | ESID _, _ -> s2
- | SHIFT(k,s), _ -> subs_shft(k, comp mk_cl s s2)
- | _, CONS(x,s') ->
- CONS(Array.Fun1.map (fun s t -> mk_cl(s,t)) s1 x, comp mk_cl s1 s')
- | CONS(x,s), SHIFT(k,s') ->
- let lg = Array.length x in
- if k == lg then comp mk_cl s s'
- else if k > lg then comp mk_cl s (SHIFT(k-lg, s'))
- else comp mk_cl (CONS(Array.sub x 0 (lg-k), s)) s'
- | CONS(x,s), LIFT(k,s') ->
- let lg = Array.length x in
- if k == lg then CONS(x, comp mk_cl s s')
- else if k > lg then CONS(x, comp mk_cl s (LIFT(k-lg, s')))
- else
- CONS(Array.sub x (lg-k) k,
- comp mk_cl (CONS(Array.sub x 0 (lg-k),s)) s')
- | LIFT(k,s), SHIFT(k',s') ->
- if k<k'
- then subs_shft(k, comp mk_cl s (subs_shft(k'-k, s')))
- else subs_shft(k', comp mk_cl (subs_liftn (k-k') s) s')
- | LIFT(k,s), LIFT(k',s') ->
- if k<k'
- then subs_liftn k (comp mk_cl s (subs_liftn (k'-k) s'))
- else subs_liftn k' (comp mk_cl (subs_liftn (k-k') s) s')
diff --git a/kernel/esubst.mli b/kernel/esubst.mli
index 4239e42adc..551c6f1732 100644
--- a/kernel/esubst.mli
+++ b/kernel/esubst.mli
@@ -18,11 +18,7 @@
- SHIFT(n,S) = (^n o S) terms in S are relocated with n vars
- LIFT(n,S) = (%n S) stands for ((^n o S).n...1)
(corresponds to S crossing n binders) *)
-type 'a subs = private
- | ESID of int
- | CONS of 'a array * 'a subs
- | SHIFT of int * 'a subs
- | LIFT of int * 'a subs
+type 'a subs
(** Derived constructors granting basic invariants *)
val subs_id : int -> 'a subs
@@ -31,9 +27,6 @@ val subs_shft: int * 'a subs -> 'a subs
val subs_lift: 'a subs -> 'a subs
val subs_liftn: int -> 'a subs -> 'a subs
-(** [subs_shift_cons(k,s,[|t1..tn|])] builds (^k s).t1..tn *)
-val subs_shift_cons: int * 'a subs * 'a array -> 'a subs
-
(** [expand_rel k subs] expands de Bruijn [k] in the explicit substitution
[subs]. The result is either (Inl(lams,v)) when the variable is
substituted by value [v] under lams binders (i.e. v *has* to be
@@ -51,7 +44,6 @@ val is_subs_id: 'a subs -> bool
mk_clos is used when a closure has to be created, i.e. when
s1 is applied on an element of s2.
*)
-val comp : ('a subs * 'a -> 'a) -> 'a subs -> 'a subs -> 'a subs
(** {6 Compact representation } *)
(** Compact representation of explicit relocations