From b9f33bdd871a1bd7a1bd29f148dd05bd7990548b Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 12 Nov 2023 19:28:56 +0100 Subject: Remove the 'r type variable from the ty type definition --- compiler/Substitute.ml | 426 ++++++++++++++++++------------------------------- 1 file changed, 152 insertions(+), 274 deletions(-) (limited to 'compiler/Substitute.ml') diff --git a/compiler/Substitute.ml b/compiler/Substitute.ml index 23f618e2..b4eee9f8 100644 --- a/compiler/Substitute.ml +++ b/compiler/Substitute.ml @@ -9,20 +9,20 @@ module E = Expressions module A = LlbcAst module C = Contexts -type ('r1, 'r2) subst = { - r_subst : 'r1 -> 'r2; - ty_subst : T.TypeVarId.id -> 'r2 T.ty; +type subst = { + r_subst : T.region -> T.region; + ty_subst : T.TypeVarId.id -> T.ty; cg_subst : T.ConstGenericVarId.id -> T.const_generic; (** Substitution from *local* trait clause to trait instance *) - tr_subst : T.TraitClauseId.id -> 'r2 T.trait_instance_id; + tr_subst : T.TraitClauseId.id -> T.trait_instance_id; (** Substitution for the [Self] trait instance *) - tr_self : 'r2 T.trait_instance_id; + tr_self : T.trait_instance_id; } -let ty_substitute_visitor (subst : ('r1, 'r2) subst) = +let st_substitute_visitor (subst : subst) = object - inherit [_] T.map_ty - method visit_'r _ r = subst.r_subst r + inherit [_] A.map_statement + method! visit_region _ r = subst.r_subst r method! visit_TypeVar _ id = subst.ty_subst id method! visit_type_var_id _ _ = @@ -43,25 +43,30 @@ let ty_substitute_visitor (subst : ('r1, 'r2) subst) = **IMPORTANT**: this doesn't normalize the types. *) -let ty_substitute (subst : ('r1, 'r2) subst) (ty : 'r1 T.ty) : 'r2 T.ty = - let visitor = ty_substitute_visitor subst in +let ty_substitute (subst : subst) (ty : T.ty) : T.ty = + let visitor = st_substitute_visitor subst in visitor#visit_ty () ty (** **IMPORTANT**: this doesn't normalize the types. *) -let trait_ref_substitute (subst : ('r1, 'r2) subst) (tr : 'r1 T.trait_ref) : - 'r2 T.trait_ref = - let visitor = ty_substitute_visitor subst in +let trait_ref_substitute (subst : subst) (tr : T.trait_ref) : T.trait_ref = + let visitor = st_substitute_visitor subst in visitor#visit_trait_ref () tr (** **IMPORTANT**: this doesn't normalize the types. *) -let generic_args_substitute (subst : ('r1, 'r2) subst) (g : 'r1 T.generic_args) - : 'r2 T.generic_args = - let visitor = ty_substitute_visitor subst in +let trait_instance_id_substitute (subst : subst) (tr : T.trait_instance_id) : + T.trait_instance_id = + let visitor = st_substitute_visitor subst in + visitor#visit_trait_instance_id () tr + +(** **IMPORTANT**: this doesn't normalize the types. *) +let generic_args_substitute (subst : subst) (g : T.generic_args) : + T.generic_args = + let visitor = st_substitute_visitor subst in visitor#visit_generic_args () g -let erase_regions_subst : ('r, T.erased_region) subst = +let erase_regions_subst : subst = { - r_subst = (fun _ -> T.Erased); + r_subst = (fun _ -> T.RErased); ty_subst = (fun vid -> T.TypeVar vid); cg_subst = (fun id -> T.ConstGenericVar id); tr_subst = (fun id -> T.Clause id); @@ -69,11 +74,18 @@ let erase_regions_subst : ('r, T.erased_region) subst = } (** Convert an {!T.rty} to an {!T.ety} by erasing the region variables *) -let erase_regions (ty : 'r T.ty) : T.ety = ty_substitute erase_regions_subst ty +let erase_regions (ty : T.ty) : T.ty = ty_substitute erase_regions_subst ty -let trait_ref_erase_regions (tr : 'r T.trait_ref) : T.etrait_ref = +let trait_ref_erase_regions (tr : T.trait_ref) : T.trait_ref = trait_ref_substitute erase_regions_subst tr +let trait_instance_id_erase_regions (tr : T.trait_instance_id) : + T.trait_instance_id = + trait_instance_id_substitute erase_regions_subst tr + +let generic_args_erase_regions (tr : T.generic_args) : T.generic_args = + generic_args_substitute erase_regions_subst tr + (** Generate fresh regions for region variables. Return the list of new regions and appropriate substitutions from the @@ -83,60 +95,62 @@ let trait_ref_erase_regions (tr : 'r T.trait_ref) : T.etrait_ref = *) let fresh_regions_with_substs (region_vars : T.region_var list) : T.RegionId.id list - * (T.RegionVarId.id -> T.RegionId.id) - * (T.RegionVarId.id T.region -> T.RegionId.id T.region) = + * (T.RegionId.id -> T.RegionId.id) + * (T.region -> T.region) = (* Generate fresh regions *) let fresh_region_ids = List.map (fun _ -> C.fresh_region_id ()) region_vars in (* Generate the map from region var ids to regions *) let ls = List.combine region_vars fresh_region_ids in let rid_map = List.fold_left - (fun mp ((k : T.region_var), v) -> T.RegionVarId.Map.add k.T.index v mp) - T.RegionVarId.Map.empty ls + (fun mp ((k : T.region_var), v) -> T.RegionId.Map.add k.T.index v mp) + T.RegionId.Map.empty ls in (* Generate the substitution from region var id to region *) - let rid_subst id = T.RegionVarId.Map.find id rid_map in + let rid_subst id = T.RegionId.Map.find id rid_map in (* Generate the substitution from region to region *) - let r_subst r = - match r with T.Static -> T.Static | T.Var id -> T.Var (rid_subst id) + let r_subst (r : T.region) = + match r with + | T.RStatic | T.RErased -> r + | T.RVar id -> T.RVar (rid_subst id) in (* Return *) (fresh_region_ids, rid_subst, r_subst) (** Erase the regions in a type and perform a substitution *) -let erase_regions_substitute_types (ty_subst : T.TypeVarId.id -> T.ety) +let erase_regions_substitute_types (ty_subst : T.TypeVarId.id -> T.ty) (cg_subst : T.ConstGenericVarId.id -> T.const_generic) - (tr_subst : T.TraitClauseId.id -> T.etrait_instance_id) - (tr_self : T.etrait_instance_id) (ty : 'r T.ty) : T.ety = - let r_subst (_ : 'r) : T.erased_region = T.Erased in + (tr_subst : T.TraitClauseId.id -> T.trait_instance_id) + (tr_self : T.trait_instance_id) (ty : T.ty) : T.ty = + let r_subst (_ : T.region) : T.region = T.RErased in let subst = { r_subst; ty_subst; cg_subst; tr_subst; tr_self } in ty_substitute subst ty (** Create a region substitution from a list of region variable ids and a list of regions (with which to substitute the region variable ids *) -let make_region_subst (var_ids : T.RegionVarId.id list) - (regions : 'r T.region list) : T.RegionVarId.id T.region -> 'r T.region = +let make_region_subst (var_ids : T.RegionId.id list) (regions : T.region list) : + T.region -> T.region = let ls = List.combine var_ids regions in let mp = List.fold_left - (fun mp (k, v) -> T.RegionVarId.Map.add k v mp) - T.RegionVarId.Map.empty ls + (fun mp (k, v) -> T.RegionId.Map.add k v mp) + T.RegionId.Map.empty ls in fun r -> match r with - | T.Static -> T.Static - | T.Var id -> T.RegionVarId.Map.find id mp + | T.RStatic | T.RErased -> r + | T.RVar id -> T.RegionId.Map.find id mp let make_region_subst_from_vars (vars : T.region_var list) - (regions : 'r T.region list) : T.RegionVarId.id T.region -> 'r T.region = + (regions : T.region list) : T.region -> T.region = make_region_subst (List.map (fun (x : T.region_var) -> x.T.index) vars) regions (** Create a type substitution from a list of type variable ids and a list of types (with which to substitute the type variable ids) *) -let make_type_subst (var_ids : T.TypeVarId.id list) (tys : 'r T.ty list) : - T.TypeVarId.id -> 'r T.ty = +let make_type_subst (var_ids : T.TypeVarId.id list) (tys : T.ty list) : + T.TypeVarId.id -> T.ty = let ls = List.combine var_ids tys in let mp = List.fold_left @@ -145,8 +159,8 @@ let make_type_subst (var_ids : T.TypeVarId.id list) (tys : 'r T.ty list) : in fun id -> T.TypeVarId.Map.find id mp -let make_type_subst_from_vars (vars : T.type_var list) (tys : 'r T.ty list) : - T.TypeVarId.id -> 'r T.ty = +let make_type_subst_from_vars (vars : T.type_var list) (tys : T.ty list) : + T.TypeVarId.id -> T.ty = make_type_subst (List.map (fun (x : T.type_var) -> x.T.index) vars) tys (** Create a const generic substitution from a list of const generic variable ids and a list of @@ -170,7 +184,7 @@ let make_const_generic_subst_from_vars (vars : T.const_generic_var list) (** Create a trait substitution from a list of trait clause ids and a list of trait refs *) let make_trait_subst (clause_ids : T.TraitClauseId.id list) - (trs : 'r T.trait_ref list) : T.TraitClauseId.id -> 'r T.trait_instance_id = + (trs : T.trait_ref list) : T.TraitClauseId.id -> T.trait_instance_id = let ls = List.combine clause_ids trs in let mp = List.fold_left @@ -180,15 +194,13 @@ let make_trait_subst (clause_ids : T.TraitClauseId.id list) fun id -> T.TraitClauseId.Map.find id mp let make_trait_subst_from_clauses (clauses : T.trait_clause list) - (trs : 'r T.trait_ref list) : T.TraitClauseId.id -> 'r T.trait_instance_id = + (trs : T.trait_ref list) : T.TraitClauseId.id -> T.trait_instance_id = make_trait_subst (List.map (fun (x : T.trait_clause) -> x.T.clause_id) clauses) trs -let make_subst_from_generics (params : T.generic_params) - (args : 'r T.region T.generic_args) - (tr_self : 'r T.region T.trait_instance_id) : - (T.region_var_id T.region, 'r T.region) subst = +let make_subst_from_generics (params : T.generic_params) (args : T.generic_args) + (tr_self : T.trait_instance_id) : subst = let r_subst = make_region_subst_from_vars params.T.regions args.T.regions in let ty_subst = make_type_subst_from_vars params.T.types args.T.types in let cg_subst = @@ -200,36 +212,12 @@ let make_subst_from_generics (params : T.generic_params) in { r_subst; ty_subst; cg_subst; tr_subst; tr_self } -let make_subst_from_generics_no_regions : - 'r. - T.generic_params -> - 'r T.generic_args -> - 'r T.trait_instance_id -> - (T.region_var_id T.region, 'r) subst = - fun params args tr_self -> - let r_subst _ = raise (Failure "Unexpected region") in - let ty_subst = make_type_subst_from_vars params.T.types args.T.types in - let cg_subst = - make_const_generic_subst_from_vars params.T.const_generics - args.T.const_generics - in - let tr_subst = - make_trait_subst_from_clauses params.T.trait_clauses args.T.trait_refs - in - { r_subst; ty_subst; cg_subst; tr_subst; tr_self } - -let make_esubst_from_generics (params : T.generic_params) - (generics : T.egeneric_args) (tr_self : T.etrait_instance_id) = - let r_subst _ = T.Erased in - let ty_subst = make_type_subst_from_vars params.types generics.T.types in - let cg_subst = - make_const_generic_subst_from_vars params.const_generics - generics.T.const_generics - in - let tr_subst = - make_trait_subst_from_clauses params.trait_clauses generics.T.trait_refs - in - { r_subst; ty_subst; cg_subst; tr_subst; tr_self } +let make_subst_from_generics_erase_regions (params : T.generic_params) + (generics : T.generic_args) (tr_self : T.trait_instance_id) = + let generics = generic_args_erase_regions generics in + let tr_self = trait_instance_id_erase_regions tr_self in + let subst = make_subst_from_generics params generics tr_self in + { subst with r_subst = (fun _ -> T.RErased) } (** Instantiate the type variables in an ADT definition, and return, for every variant, the list of the types of its fields. @@ -237,8 +225,8 @@ let make_esubst_from_generics (params : T.generic_params) **IMPORTANT**: this function doesn't normalize the types, you may want to use the [AssociatedTypes] equivalent instead. *) -let type_decl_get_instantiated_variants_fields_rtypes (def : T.type_decl) - (generics : T.rgeneric_args) : (T.VariantId.id option * T.rty list) list = +let type_decl_get_instantiated_variants_fields_types (def : T.type_decl) + (generics : T.generic_args) : (T.VariantId.id option * T.ty list) list = (* There shouldn't be any reference to Self *) let tr_self = T.UnknownTrait __FUNCTION__ in let subst = make_subst_from_generics def.T.generics generics tr_self in @@ -266,9 +254,9 @@ let type_decl_get_instantiated_variants_fields_rtypes (def : T.type_decl) **IMPORTANT**: this function doesn't normalize the types, you may want to use the [AssociatedTypes] equivalent instead. *) -let type_decl_get_instantiated_field_rtypes (def : T.type_decl) - (opt_variant_id : T.VariantId.id option) (generics : T.rgeneric_args) : - T.rty list = +let type_decl_get_instantiated_field_types (def : T.type_decl) + (opt_variant_id : T.VariantId.id option) (generics : T.generic_args) : + T.ty list = (* For now, check that there are no clauses - otherwise we might need to normalize the types *) assert (def.generics.trait_clauses = []); @@ -284,11 +272,11 @@ let type_decl_get_instantiated_field_rtypes (def : T.type_decl) **IMPORTANT**: this function doesn't normalize the types, you may want to use the [AssociatedTypes] equivalent instead. *) -let ctx_adt_get_instantiated_field_rtypes (ctx : C.eval_ctx) +let ctx_adt_get_instantiated_field_types (ctx : C.eval_ctx) (def_id : T.TypeDeclId.id) (opt_variant_id : T.VariantId.id option) - (generics : T.rgeneric_args) : T.rty list = + (generics : T.generic_args) : T.ty list = let def = C.ctx_lookup_type_decl ctx def_id in - type_decl_get_instantiated_field_rtypes def opt_variant_id generics + type_decl_get_instantiated_field_types def opt_variant_id generics (** Return the types of the properly instantiated ADT value (note that here, ADT is understood in its broad meaning: ADT, assumed value or tuple). @@ -296,122 +284,55 @@ let ctx_adt_get_instantiated_field_rtypes (ctx : C.eval_ctx) **IMPORTANT**: this function doesn't normalize the types, you may want to use the [AssociatedTypes] equivalent instead. *) -let ctx_adt_value_get_instantiated_field_rtypes (ctx : C.eval_ctx) - (adt : V.adt_value) (id : T.type_id) (generics : T.rgeneric_args) : - T.rty list = +let ctx_adt_value_get_instantiated_field_types (ctx : C.eval_ctx) + (adt : V.adt_value) (id : T.type_id) (generics : T.generic_args) : T.ty list + = match id with | T.AdtId id -> (* Retrieve the types of the fields *) - ctx_adt_get_instantiated_field_rtypes ctx id adt.V.variant_id generics + ctx_adt_get_instantiated_field_types ctx id adt.V.variant_id generics | T.Tuple -> assert (generics.regions = []); generics.types - | T.Assumed aty -> ( + | T.TAssumed aty -> ( match aty with - | T.Box -> + | T.TBox -> assert (generics.regions = []); assert (List.length generics.types = 1); assert (generics.const_generics = []); generics.types - | T.Array | T.Slice | T.Str -> + | T.TArray | T.TSlice | T.TStr -> (* Those types don't have fields *) raise (Failure "Unreachable")) -(** Instantiate the type variables in an ADT definition, and return the list - of types of the fields for the chosen variant. - - **IMPORTANT**: this function doesn't normalize the types, you may want to - use the [AssociatedTypes] equivalent instead. -*) -let type_decl_get_instantiated_field_etypes (def : T.type_decl) - (opt_variant_id : T.VariantId.id option) (generics : T.egeneric_args) : - T.ety list = - (* For now, check that there are no clauses - otherwise we might need - to normalize the types *) - assert (def.generics.trait_clauses = []); - (* There shouldn't be any reference to Self *) - let tr_self : T.erased_region T.trait_instance_id = - T.UnknownTrait __FUNCTION__ - in - let { r_subst = _; ty_subst; cg_subst; tr_subst; tr_self } = - make_esubst_from_generics def.T.generics generics tr_self - in - let fields = TU.type_decl_get_fields def opt_variant_id in - List.map - (fun (f : T.field) -> - erase_regions_substitute_types ty_subst cg_subst tr_subst tr_self - f.T.field_ty) - fields - -(** Return the types of the properly instantiated ADT's variant, provided a - context. - - **IMPORTANT**: this function doesn't normalize the types, you may want to - use the [AssociatedTypes] equivalent instead. - *) -let ctx_adt_get_instantiated_field_etypes (ctx : C.eval_ctx) - (def_id : T.TypeDeclId.id) (opt_variant_id : T.VariantId.id option) - (generics : T.egeneric_args) : T.ety list = - let def = C.ctx_lookup_type_decl ctx def_id in - type_decl_get_instantiated_field_etypes def opt_variant_id generics - -let statement_substitute_visitor - (subst : (T.erased_region, T.erased_region) subst) = - (* Keep in synch with [ty_substitute_visitor] *) - object - inherit [_] A.map_statement - method! visit_'r _ r = subst.r_subst r - method! visit_TypeVar _ id = subst.ty_subst id - - method! visit_type_var_id _ _ = - (* We should never get here because we reimplemented [visit_TypeVar] *) - raise (Failure "Unexpected") - - method! visit_ConstGenericVar _ id = subst.cg_subst id - - method! visit_const_generic_var_id _ _ = - (* We should never get here because we reimplemented [visit_Var] *) - raise (Failure "Unexpected") - - method! visit_Clause _ id = subst.tr_subst id - method! visit_Self _ = subst.tr_self - end - (** Apply a type substitution to a place *) -let place_substitute (subst : (T.erased_region, T.erased_region) subst) - (p : E.place) : E.place = +let place_substitute (subst : subst) (p : E.place) : E.place = (* There is in fact nothing to do *) - (statement_substitute_visitor subst)#visit_place () p + (st_substitute_visitor subst)#visit_place () p (** Apply a type substitution to an operand *) -let operand_substitute (subst : (T.erased_region, T.erased_region) subst) - (op : E.operand) : E.operand = - (statement_substitute_visitor subst)#visit_operand () op +let operand_substitute (subst : subst) (op : E.operand) : E.operand = + (st_substitute_visitor subst)#visit_operand () op (** Apply a type substitution to an rvalue *) -let rvalue_substitute (subst : (T.erased_region, T.erased_region) subst) - (rv : E.rvalue) : E.rvalue = - (statement_substitute_visitor subst)#visit_rvalue () rv +let rvalue_substitute (subst : subst) (rv : E.rvalue) : E.rvalue = + (st_substitute_visitor subst)#visit_rvalue () rv (** Apply a type substitution to an assertion *) -let assertion_substitute (subst : (T.erased_region, T.erased_region) subst) - (a : A.assertion) : A.assertion = - (statement_substitute_visitor subst)#visit_assertion () a +let assertion_substitute (subst : subst) (a : A.assertion) : A.assertion = + (st_substitute_visitor subst)#visit_assertion () a (** Apply a type substitution to a call *) -let call_substitute (subst : (T.erased_region, T.erased_region) subst) - (call : A.call) : A.call = - (statement_substitute_visitor subst)#visit_call () call +let call_substitute (subst : subst) (call : A.call) : A.call = + (st_substitute_visitor subst)#visit_call () call (** Apply a type substitution to a statement *) -let statement_substitute (subst : (T.erased_region, T.erased_region) subst) - (st : A.statement) : A.statement = - (statement_substitute_visitor subst)#visit_statement () st +let statement_substitute (subst : subst) (st : A.statement) : A.statement = + (st_substitute_visitor subst)#visit_statement () st (** Apply a type substitution to a function body. Return the local variables and the body. *) -let fun_body_substitute_in_body - (subst : (T.erased_region, T.erased_region) subst) (body : A.fun_body) : +let fun_body_substitute_in_body (subst : subst) (body : A.fun_body) : A.var list * A.statement = let locals = List.map @@ -421,10 +342,10 @@ let fun_body_substitute_in_body let body = statement_substitute subst body.body in (locals, body) -let trait_type_constraint_substitute (subst : ('r1, 'r2) subst) - (ttc : 'r1 T.trait_type_constraint) : 'r2 T.trait_type_constraint = +let trait_type_constraint_substitute (subst : subst) + (ttc : T.trait_type_constraint) : T.trait_type_constraint = let { T.trait_ref; generics; type_name; ty } = ttc in - let visitor = ty_substitute_visitor subst in + let visitor = st_substitute_visitor subst in let trait_ref = visitor#visit_trait_ref () trait_ref in let generics = visitor#visit_generic_args () generics in let ty = visitor#visit_ty () ty in @@ -435,22 +356,24 @@ let trait_type_constraint_substitute (subst : ('r1, 'r2) subst) **IMPORTANT:** this function doesn't normalize the types. *) let substitute_signature (asubst : T.RegionGroupId.id -> V.AbstractionId.id) - (r_subst : T.RegionVarId.id -> T.RegionId.id) - (ty_subst : T.TypeVarId.id -> T.rty) + (r_subst : T.RegionId.id -> T.RegionId.id) + (ty_subst : T.TypeVarId.id -> T.ty) (cg_subst : T.ConstGenericVarId.id -> T.const_generic) - (tr_subst : T.TraitClauseId.id -> T.rtrait_instance_id) - (tr_self : T.rtrait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig = - let r_subst' (r : T.RegionVarId.id T.region) : T.RegionId.id T.region = - match r with T.Static -> T.Static | T.Var rid -> T.Var (r_subst rid) + (tr_subst : T.TraitClauseId.id -> T.trait_instance_id) + (tr_self : T.trait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig = + let r_subst' (r : T.region) : T.region = + match r with + | T.RStatic | T.RErased -> r + | T.RVar rid -> T.RVar (r_subst rid) in let subst = { r_subst = r_subst'; ty_subst; cg_subst; tr_subst; tr_self } in let inputs = List.map (ty_substitute subst) sg.A.inputs in let output = ty_substitute subst sg.A.output in - let subst_region_group (rg : T.region_var_group) : A.abs_region_group = + let subst_region_group (rg : T.region_group) : A.abs_region_group = let id = asubst rg.id in let regions = List.map r_subst rg.regions in let parents = List.map asubst rg.parents in - { id; regions; parents } + ({ id; regions; parents } : A.abs_region_group) in let regions_hierarchy = List.map subst_region_group sg.A.regions_hierarchy in let trait_type_constraints = @@ -461,9 +384,9 @@ let substitute_signature (asubst : T.RegionGroupId.id -> V.AbstractionId.id) { A.inputs; output; regions_hierarchy; trait_type_constraints } (** Substitute variable identifiers in a type *) -let ty_substitute_ids (ty_subst : T.TypeVarId.id -> T.TypeVarId.id) - (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ty : 'r T.ty) - : 'r T.ty = +let statement_substitute_ids (ty_subst : T.TypeVarId.id -> T.TypeVarId.id) + (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ty : T.ty) : + T.ty = let open T in let visitor = object @@ -476,80 +399,39 @@ let ty_substitute_ids (ty_subst : T.TypeVarId.id -> T.TypeVarId.id) visitor#visit_ty () ty -(* This visitor is a mess... - - We want to write a class which visits abstractions, values, etc. *and their - types* to substitute identifiers. - - The issue is that we derive two specialized types (ety and rty) from a - polymorphic type (ty). Because of this, there are typing issues with - [visit_'r] if we define a class which visits objects of types [ety] and [rty] - while inheriting a class which visit [ty]... -*) let subst_ids_visitor (r_subst : T.RegionId.id -> T.RegionId.id) - (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) (ty_subst : T.TypeVarId.id -> T.TypeVarId.id) (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id) (bsubst : V.BorrowId.id -> V.BorrowId.id) (asubst : V.AbstractionId.id -> V.AbstractionId.id) = - let subst_rty = - object - inherit [_] T.map_ty - - method visit_'r _ r = - match r with T.Static -> T.Static | T.Var rid -> T.Var (r_subst rid) - - method! visit_type_var_id _ id = ty_subst id - method! visit_const_generic_var_id _ id = cg_subst id - end - in - - let visitor = - object (self : 'self) - inherit [_] C.map_env - method! visit_borrow_id _ bid = bsubst bid - method! visit_loan_id _ bid = bsubst bid - method! visit_ety _ ty = ty_substitute_ids ty_subst cg_subst ty - method! visit_rty env ty = subst_rty#visit_ty env ty - method! visit_symbolic_value_id _ id = ssubst id - - (** We *do* visit meta-values *) - method! visit_msymbolic_value env sv = self#visit_symbolic_value env sv - - (** We *do* visit meta-values *) - method! visit_mvalue env v = self#visit_typed_value env v - - method! visit_region_id _ id = r_subst id - method! visit_region_var_id _ id = rvsubst id - method! visit_abstraction_id _ id = asubst id - end - in - - object - method visit_ety (x : T.ety) : T.ety = visitor#visit_ety () x - method visit_rty (x : T.rty) : T.rty = visitor#visit_rty () x - - method visit_typed_value (x : V.typed_value) : V.typed_value = - visitor#visit_typed_value () x - - method visit_typed_avalue (x : V.typed_avalue) : V.typed_avalue = - visitor#visit_typed_avalue () x - - method visit_abs (x : V.abs) : V.abs = visitor#visit_abs () x - method visit_env (env : C.env) : C.env = visitor#visit_env () env + object (self : 'self) + inherit [_] C.map_env + method! visit_type_var_id _ id = ty_subst id + method! visit_const_generic_var_id _ id = cg_subst id + method! visit_region_id _ rid = r_subst rid + method! visit_borrow_id _ bid = bsubst bid + method! visit_loan_id _ bid = bsubst bid + method! visit_symbolic_value_id _ id = ssubst id + + (** We *do* visit meta-values *) + method! visit_msymbolic_value env sv = self#visit_symbolic_value env sv + + (** We *do* visit meta-values *) + method! visit_mvalue env v = self#visit_typed_value env v + + method! visit_abstraction_id _ id = asubst id end let typed_value_subst_ids (r_subst : T.RegionId.id -> T.RegionId.id) - (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) (ty_subst : T.TypeVarId.id -> T.TypeVarId.id) (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id) (bsubst : V.BorrowId.id -> V.BorrowId.id) (v : V.typed_value) : V.typed_value = let asubst _ = raise (Failure "Unreachable") in - (subst_ids_visitor r_subst rvsubst ty_subst cg_subst ssubst bsubst asubst) - #visit_typed_value v + let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in + vis#visit_typed_value () v let typed_value_subst_rids (r_subst : T.RegionId.id -> T.RegionId.id) (v : V.typed_value) : V.typed_value = @@ -558,61 +440,57 @@ let typed_value_subst_rids (r_subst : T.RegionId.id -> T.RegionId.id) (fun x -> x) (fun x -> x) (fun x -> x) - (fun x -> x) v let typed_avalue_subst_ids (r_subst : T.RegionId.id -> T.RegionId.id) - (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) (ty_subst : T.TypeVarId.id -> T.TypeVarId.id) (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id) (bsubst : V.BorrowId.id -> V.BorrowId.id) (v : V.typed_avalue) : V.typed_avalue = let asubst _ = raise (Failure "Unreachable") in - (subst_ids_visitor r_subst rvsubst ty_subst cg_subst ssubst bsubst asubst) - #visit_typed_avalue v + let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in + vis#visit_typed_avalue () v let abs_subst_ids (r_subst : T.RegionId.id -> T.RegionId.id) - (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) (ty_subst : T.TypeVarId.id -> T.TypeVarId.id) (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id) (bsubst : V.BorrowId.id -> V.BorrowId.id) (asubst : V.AbstractionId.id -> V.AbstractionId.id) (x : V.abs) : V.abs = - (subst_ids_visitor r_subst rvsubst ty_subst cg_subst ssubst bsubst asubst) - #visit_abs x + let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in + vis#visit_abs () x let env_subst_ids (r_subst : T.RegionId.id -> T.RegionId.id) - (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) (ty_subst : T.TypeVarId.id -> T.TypeVarId.id) (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id) (bsubst : V.BorrowId.id -> V.BorrowId.id) (asubst : V.AbstractionId.id -> V.AbstractionId.id) (x : C.env) : C.env = - (subst_ids_visitor r_subst rvsubst ty_subst cg_subst ssubst bsubst asubst) - #visit_env x + let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in + vis#visit_env () x let typed_avalue_subst_rids (r_subst : T.RegionId.id -> T.RegionId.id) (x : V.typed_avalue) : V.typed_avalue = let asubst _ = raise (Failure "Unreachable") in - (subst_ids_visitor r_subst - (fun x -> x) - (fun x -> x) - (fun x -> x) - (fun x -> x) - (fun x -> x) - asubst) - #visit_typed_avalue - x + let vis = + subst_ids_visitor r_subst + (fun x -> x) + (fun x -> x) + (fun x -> x) + (fun x -> x) + asubst + in + vis#visit_typed_avalue () x let env_subst_rids (r_subst : T.RegionId.id -> T.RegionId.id) (x : C.env) : C.env = - (subst_ids_visitor r_subst - (fun x -> x) - (fun x -> x) - (fun x -> x) - (fun x -> x) - (fun x -> x) - (fun x -> x)) - #visit_env - x + let vis = + subst_ids_visitor r_subst + (fun x -> x) + (fun x -> x) + (fun x -> x) + (fun x -> x) + (fun x -> x) + in + vis#visit_env () x -- cgit v1.2.3