 Maj terminée. Pour consulter la release notes associée voici le lien :

### Parameterize [subst] over [copy].

parent 14882475
 ... @@ -14,9 +14,6 @@ System F demo: ... @@ -14,9 +14,6 @@ System F demo: System F-type-term: System F-type-term: deal with both kinds of variables deal with both kinds of variables Implement a subst that does not copy the grafted term? Or parameterize subst over the copy operation that needs to be performed when grafting? Implement fused copy/subst, fused avoid/subst? Implement fused copy/subst, fused avoid/subst? Implement a kit that composes two kits, so as to easily implement fused operations. Implement a kit that composes two kits, so as to easily implement fused operations. Composition of classes? Or composition of kit objects? ... Composition of classes? Or composition of kit objects? ... ... ...
 ... @@ -10,6 +10,9 @@ open T ... @@ -10,6 +10,9 @@ open T let ( ** ) = Atom.Set.union let ( ** ) = Atom.Set.union let subst1 = subst_TVar_term1 copy_term (* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *) (* [interval i j] constructs a list representation of the semi-open interval (* [interval i j] constructs a list representation of the semi-open interval ... @@ -219,34 +222,34 @@ let () = ... @@ -219,34 +222,34 @@ let () = () () | x -> | x -> let u = generate_nominal atoms size_of_u in let u = generate_nominal atoms size_of_u in let t' = subst_term_term1 u x t in let t' = subst1 u x t in assert (guq_term t'); assert (guq_term t'); assert (Atom.Set.equal assert (Atom.Set.equal (fa_term t') (fa_term t') (fa_term u ** Atom.Set.remove x (fa_term t)) (fa_term u ** Atom.Set.remove x (fa_term t)) ); ); assert (t' = subst_term_term1 u x t); assert (t' = subst1 u x t); assert (guq_term (TLambda (x, t))); assert (guq_term (TLambda (x, t))); (* subst_term_term1 u x (TLambda (x, t)) = TLambda (x, t) *) (* subst1 u x (TLambda (x, t)) = TLambda (x, t) *) (* cannot be checked as these are illegal arguments to substitution *) (* cannot be checked as these are illegal arguments to substitution *) begin match t with begin match t with | TVar _ -> assert false | TVar _ -> assert false | TLambda (y, t) -> | TLambda (y, t) -> assert (subst_term_term1 u x (TLambda (y, t)) = assert (subst1 u x (TLambda (y, t)) = TLambda (y, subst_term_term1 u x t)) TLambda (y, subst1 u x t)) | TApp (t1, t2) -> | TApp (t1, t2) -> assert (subst_term_term1 u x (TApp (t1, t2)) = assert (subst1 u x (TApp (t1, t2)) = TApp (subst_term_term1 u x t1, subst_term_term1 u x t2)) TApp (subst1 u x t1, subst1 u x t2)) end end ); ); let x = Atom.freshh "x" let x = Atom.freshh "x" and y = Atom.freshh "y" in and y = Atom.freshh "y" in let u = generate_nominal atoms size_of_u in let u = generate_nominal atoms size_of_u in assert (subst_term_term1 u x (TVar x) = u); assert (subst1 u x (TVar x) = u); assert (subst_term_term1 u x (TVar y) = TVar y); assert (subst1 u x (TVar y) = TVar y); on_guq_nominal_terms (fun t -> on_guq_nominal_terms (fun t -> assert (subst_term_term1 u x t = t); assert (subst1 u x t = t); assert (subst_term_term1 u x t == t) (* note physical equality *) assert (subst1 u x t == t) (* note physical equality *) ); ); (* Test that [equiv] distinguishes certain terms. *) (* Test that [equiv] distinguishes certain terms. *) assert (not (TVar x = TVar y)); assert (not (TVar x = TVar y)); ... @@ -399,7 +402,7 @@ let () = ... @@ -399,7 +402,7 @@ let () = evaluate print_fa evaluate print_fa let print_subst1 u x t = let print_subst1 u x t = let t' = subst_term_term1 u x t in let t' = subst1 u x t in printf "substituting %a for %a in %a = ...\n %a\n%s\n%!" printf "substituting %a for %a in %a = ...\n %a\n%s\n%!" nhprint u nhprint u Atom.print x Atom.print x ... ...
 ... @@ -110,6 +110,6 @@ __EQUIV ... @@ -110,6 +110,6 @@ __EQUIV EQUIV(typ) EQUIV(typ) EQUIV(term) EQUIV(term) __SUBST(typ, TyVar) __SUBST(TyVar) SUBST(typ, typ) SUBST(TyVar, typ) SUBST(typ, term) SUBST(TyVar, term)
 ... @@ -59,7 +59,7 @@ let unfold ty = ... @@ -59,7 +59,7 @@ let unfold ty = assert (Atom.Set.disjoint (fa_typ ty) (ba_typ body)); assert (Atom.Set.disjoint (fa_typ ty) (ba_typ body)); (* By the above, the bound names of [body] are disjoint with the (* By the above, the bound names of [body] are disjoint with the domain and codomain of the substitution [ty/a]. *) domain and codomain of the substitution [ty/a]. *) subst_typ_typ1 ty a body subst_TyVar_typ1 copy_typ ty a body | _ -> | _ -> assert false assert false ... @@ -135,7 +135,7 @@ let rec typeof env (t : nominal_term) : nominal_typ = ... @@ -135,7 +135,7 @@ let rec typeof env (t : nominal_term) : nominal_typ = assert (not (Atom.Set.mem a (ba_typ ty1))); assert (not (Atom.Set.mem a (ba_typ ty1))); (* We have ba(ty1) # fa(ty2) because fa(ty2) is a subset of dom(env), that is, (* We have ba(ty1) # fa(ty2) because fa(ty2) is a subset of dom(env), that is, env.tyvars, and typeof has the postcondition ba(\result) # env.tyvars. *) env.tyvars, and typeof has the postcondition ba(\result) # env.tyvars. *) subst_typ_typ1 ty2 a ty1 subst_TyVar_typ1 (fun ty -> ty) ty2 a ty1 | TePair (t1, t2) -> | TePair (t1, t2) -> TyProduct (typeof env t1, typeof env t2) TyProduct (typeof env t1, typeof env t2) | TeProj (i, t) -> | TeProj (i, t) -> ... ...
 ... @@ -284,29 +284,26 @@ ... @@ -284,29 +284,26 @@ in the domain of [sigma], which means that we can go down into [t] and apply in the domain of [sigma], which means that we can go down into [t] and apply [sigma] to every variable. *) [sigma] to every variable. *) (* The GUH is preserved by copying the things that are grafted into [t]. Thus, (* Global uniqueness can be preserved, if desired, by copying the things that it is not even necessary that [sigma] and [t] be disjoint, or that the are grafted into [t]. The user decides which [copy] operation should be used. things in the codomain of [sigma] be pairwise disjoint. One should note, It could be [copy_thing], or it could be the identity. *) however, that the result of the substitution is not disjoint with [t], so one should no longer use [t] after the substitution (or, one should apply #define SUBST_CLASS(Var) CONCAT(__subst_, Var) the substitution to a copy). *) #define SUBST_FUN(Var, term) CONCAT(subst_, CONCAT(Var, CONCAT(_, term))) #define SUBST_FUN1(Var, term) CONCAT(SUBST_FUN(Var, term), 1) #define SUBST_CLASS(thing) CONCAT(__subst_, thing) #define SUBST_FUN(thing, term) CONCAT(subst_, CONCAT(thing, CONCAT(_, term))) #define __SUBST(Var) \ #define SUBST_FUN1(thing, term) CONCAT(SUBST_FUN(thing, term), 1) class SUBST_CLASS(Var) copy = object \ #define __SUBST(thing, Var) \ class SUBST_CLASS(thing) = object \ inherit [_] endo (* we could also use [map] *) \ inherit [_] endo (* we could also use [map] *) \ inherit [_] KitSubst.map \ inherit [_] KitSubst.map \ method! private VISIT(Var) sigma this x = \ method! private VISIT(Var) sigma this x = \ KitSubst.apply COPY_FUN(thing) sigma this x \ KitSubst.apply copy sigma this x \ end \ end \ #define SUBST(thing, term) \ #define SUBST(Var, term) \ let SUBST_FUN(thing, term) sigma t = \ let SUBST_FUN(Var, term) copy sigma t = \ new SUBST_CLASS(thing) # VISIT(term) sigma t \ (new SUBST_CLASS(Var) copy) # VISIT(term) sigma t \ let SUBST_FUN1(thing, term) u x t = \ let SUBST_FUN1(Var, term) copy u x t = \ SUBST_FUN(thing, term) (Atom.Map.singleton x u) t \ SUBST_FUN(Var, term) copy (Atom.Map.singleton x u) t \ (* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
 ... @@ -68,8 +68,9 @@ module Make (Term : ToolboxInput.INPUT) = struct ... @@ -68,8 +68,9 @@ module Make (Term : ToolboxInput.INPUT) = struct __EQUIV __EQUIV EQUIV(term) EQUIV(term) __SUBST(term, TVar) (* Mnemonic: Substitute for variables in terms. *) SUBST(term, term) __SUBST(TVar) SUBST(TVar, term) (* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *) ... ...
 ... @@ -44,7 +44,11 @@ module Make (Term : ToolboxInput.INPUT) : sig ... @@ -44,7 +44,11 @@ module Make (Term : ToolboxInput.INPUT) : sig val equiv_term: nominal_term -> nominal_term -> bool val equiv_term: nominal_term -> nominal_term -> bool val subst_term_term : nominal_term Atom.Map.t -> nominal_term -> nominal_term val subst_TVar_term: val subst_term_term1: nominal_term -> Atom.t -> nominal_term -> nominal_term (nominal_term -> nominal_term) -> nominal_term Atom.Map.t -> nominal_term -> nominal_term val subst_TVar_term1: (nominal_term -> nominal_term) -> nominal_term -> Atom.t -> nominal_term -> nominal_term end end
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!