diff options
Diffstat (limited to '')
| -rw-r--r-- | compiler/Substitute.ml | 737 | 
1 files changed, 357 insertions, 380 deletions
diff --git a/compiler/Substitute.ml b/compiler/Substitute.ml index 38850243..a05b2c5a 100644 --- a/compiler/Substitute.ml +++ b/compiler/Substitute.ml @@ -2,502 +2,479 @@      function bodies, etc.   *) -module T = Types -module TU = TypesUtils -module V = Values -module E = Expressions -module A = LlbcAst -module C = Contexts - -(** Substitute types variables and regions in a type. *) -let ty_substitute (rsubst : 'r1 -> 'r2) (tsubst : T.TypeVarId.id -> 'r2 T.ty) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (ty : 'r1 T.ty) : -    'r2 T.ty = -  let open T in -  let visitor = -    object -      inherit [_] map_ty -      method visit_'r _ r = rsubst r -      method! visit_TypeVar _ id = tsubst id +open Types +open TypesUtils +open Values +open Expressions +open LlbcAst +open Contexts + +type subst = { +  r_subst : region -> region; +  ty_subst : TypeVarId.id -> ty; +  cg_subst : ConstGenericVarId.id -> const_generic; +      (** Substitution from *local* trait clause to trait instance *) +  tr_subst : TraitClauseId.id -> trait_instance_id; +      (** Substitution for the [Self] trait instance *) +  tr_self : trait_instance_id; +} + +let st_substitute_visitor (subst : subst) = +  object +    inherit [_] map_statement +    method! visit_region _ r = subst.r_subst r +    method! visit_TVar _ 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_type_var_id _ _ = +      (* We should never get here because we reimplemented [visit_TypeVar] *) +      raise (Failure "Unexpected") -      method! visit_ConstGenericVar _ id = cgsubst id +    method! visit_CgVar _ id = subst.cg_subst id -      method! visit_const_generic_var_id _ _ = -        (* We should never get here because we reimplemented [visit_Var] *) -        raise (Failure "Unexpected") -    end -  in +    method! visit_const_generic_var_id _ _ = +      (* We should never get here because we reimplemented [visit_Var] *) +      raise (Failure "Unexpected") -  visitor#visit_ty () ty +    method! visit_Clause _ id = subst.tr_subst id +    method! visit_Self _ = subst.tr_self +  end -let rty_substitute (rsubst : T.RegionId.id -> T.RegionId.id) -    (tsubst : T.TypeVarId.id -> T.rty) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (ty : T.rty) : T.rty = -  let rsubst r = -    match r with T.Static -> T.Static | T.Var rid -> T.Var (rsubst rid) -  in -  ty_substitute rsubst tsubst cgsubst ty +(** Substitute types variables and regions in a type. -let ety_substitute (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (ty : T.ety) : T.ety = -  let rsubst r = r in -  ty_substitute rsubst tsubst cgsubst ty +    **IMPORTANT**: this doesn't normalize the types. + *) +let ty_substitute (subst : subst) (ty : ty) : ty = +  let visitor = st_substitute_visitor subst in +  visitor#visit_ty () ty -(** Convert an {!T.rty} to an {!T.ety} by erasing the region variables *) -let erase_regions (ty : T.rty) : T.ety = -  ty_substitute -    (fun _ -> T.Erased) -    (fun vid -> T.TypeVar vid) -    (fun id -> T.ConstGenericVar id) -    ty +(** **IMPORTANT**: this doesn't normalize the types. *) +let trait_ref_substitute (subst : subst) (tr : trait_ref) : trait_ref = +  let visitor = st_substitute_visitor subst in +  visitor#visit_trait_ref () tr + +(** **IMPORTANT**: this doesn't normalize the types. *) +let trait_instance_id_substitute (subst : subst) (tr : trait_instance_id) : +    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 : generic_args) : generic_args = +  let visitor = st_substitute_visitor subst in +  visitor#visit_generic_args () g + +let predicates_substitute (subst : subst) (p : predicates) : predicates = +  let visitor = st_substitute_visitor subst in +  visitor#visit_predicates () p + +let erase_regions_subst : subst = +  { +    r_subst = (fun _ -> RErased); +    ty_subst = (fun vid -> TVar vid); +    cg_subst = (fun id -> CgVar id); +    tr_subst = (fun id -> Clause id); +    tr_self = Self; +  } + +(** Erase the region variables in a type *) +let erase_regions (ty : ty) : ty = ty_substitute erase_regions_subst ty + +let trait_ref_erase_regions (tr : trait_ref) : trait_ref = +  trait_ref_substitute erase_regions_subst tr + +let trait_instance_id_erase_regions (tr : trait_instance_id) : trait_instance_id +    = +  trait_instance_id_substitute erase_regions_subst tr + +let generic_args_erase_regions (tr : generic_args) : 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      original region variables to the fresh regions. -    TODO: simplify? we only need the subst [T.RegionVarId.id -> T.RegionId.id] +    TODO: simplify? we only need the subst [RegionVarId.id -> RegionId.id]    *) -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) = +let fresh_regions_with_substs (region_vars : region_var list) : +    RegionId.id list * (RegionId.id -> RegionId.id) * (region -> region) =    (* Generate fresh regions *) -  let fresh_region_ids = List.map (fun _ -> C.fresh_region_id ()) region_vars in +  let fresh_region_ids = List.map (fun _ -> 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 : region_var), v) -> RegionId.Map.add k.index v mp) +      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 = RegionId.Map.find id rid_map in    (* Generate the substitution from region to region *) -  let rsubst r = -    match r with T.Static -> T.Static | T.Var id -> T.Var (rid_subst id) +  let r_subst (r : region) = +    match r with RStatic | RErased -> r | RVar id -> RVar (rid_subst id)    in    (* Return *) -  (fresh_region_ids, rid_subst, rsubst) +  (fresh_region_ids, rid_subst, r_subst) -(** Erase the regions in a type and substitute the type variables *) -let erase_regions_substitute_types (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) -    (ty : 'r T.region T.ty) : T.ety = -  let rsubst (_ : 'r T.region) : T.erased_region = T.Erased in -  ty_substitute rsubst tsubst cgsubst ty +(** Erase the regions in a type and perform a substitution *) +let erase_regions_substitute_types (ty_subst : TypeVarId.id -> ty) +    (cg_subst : ConstGenericVarId.id -> const_generic) +    (tr_subst : TraitClauseId.id -> trait_instance_id) +    (tr_self : trait_instance_id) (ty : ty) : ty = +  let r_subst (_ : region) : region = 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 : RegionId.id list) (regions : region list) : +    region -> 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) -> RegionId.Map.add k v mp) +      RegionId.Map.empty ls    in    fun r -> -    match r with -    | T.Static -> T.Static -    | T.Var id -> T.RegionVarId.Map.find id mp +    match r with RStatic | RErased -> r | RVar id -> 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 = -  make_region_subst -    (List.map (fun (x : T.region_var) -> x.T.index) vars) -    regions +let make_region_subst_from_vars (vars : region_var list) (regions : region list) +    : region -> region = +  make_region_subst (List.map (fun (x : region_var) -> x.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 : TypeVarId.id list) (tys : ty list) : +    TypeVarId.id -> ty =    let ls = List.combine var_ids tys in    let mp =      List.fold_left -      (fun mp (k, v) -> T.TypeVarId.Map.add k v mp) -      T.TypeVarId.Map.empty ls +      (fun mp (k, v) -> TypeVarId.Map.add k v mp) +      TypeVarId.Map.empty ls    in -  fun id -> T.TypeVarId.Map.find id mp +  fun id -> 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 = -  make_type_subst (List.map (fun (x : T.type_var) -> x.T.index) vars) tys +let make_type_subst_from_vars (vars : type_var list) (tys : ty list) : +    TypeVarId.id -> ty = +  make_type_subst (List.map (fun (x : type_var) -> x.index) vars) tys  (** Create a const generic substitution from a list of const generic variable ids and a list of      const generics (with which to substitute the const generic variable ids) *) -let make_const_generic_subst (var_ids : T.ConstGenericVarId.id list) -    (cgs : T.const_generic list) : T.ConstGenericVarId.id -> T.const_generic = +let make_const_generic_subst (var_ids : ConstGenericVarId.id list) +    (cgs : const_generic list) : ConstGenericVarId.id -> const_generic =    let ls = List.combine var_ids cgs in    let mp =      List.fold_left -      (fun mp (k, v) -> T.ConstGenericVarId.Map.add k v mp) -      T.ConstGenericVarId.Map.empty ls +      (fun mp (k, v) -> ConstGenericVarId.Map.add k v mp) +      ConstGenericVarId.Map.empty ls    in -  fun id -> T.ConstGenericVarId.Map.find id mp +  fun id -> ConstGenericVarId.Map.find id mp -let make_const_generic_subst_from_vars (vars : T.const_generic_var list) -    (cgs : T.const_generic list) : T.ConstGenericVarId.id -> T.const_generic = +let make_const_generic_subst_from_vars (vars : const_generic_var list) +    (cgs : const_generic list) : ConstGenericVarId.id -> const_generic =    make_const_generic_subst -    (List.map (fun (x : T.const_generic_var) -> x.T.index) vars) +    (List.map (fun (x : const_generic_var) -> x.index) vars)      cgs -(** Instantiate the type variables in an ADT definition, and return, for -    every variant, the list of the types of its fields *) -let type_decl_get_instantiated_variants_fields_rtypes (def : T.type_decl) -    (regions : T.RegionId.id T.region list) (types : T.rty list) -    (cgs : T.const_generic list) : (T.VariantId.id option * T.rty list) list = -  let r_subst = make_region_subst_from_vars def.T.region_params regions in -  let ty_subst = make_type_subst_from_vars def.T.type_params types in +(** Create a trait substitution from a list of trait clause ids and a list of +    trait refs *) +let make_trait_subst (clause_ids : TraitClauseId.id list) (trs : trait_ref list) +    : TraitClauseId.id -> trait_instance_id = +  let ls = List.combine clause_ids trs in +  let mp = +    List.fold_left +      (fun mp (k, v) -> TraitClauseId.Map.add k (TraitRef v) mp) +      TraitClauseId.Map.empty ls +  in +  fun id -> TraitClauseId.Map.find id mp + +let make_trait_subst_from_clauses (clauses : trait_clause list) +    (trs : trait_ref list) : TraitClauseId.id -> trait_instance_id = +  make_trait_subst +    (List.map (fun (x : trait_clause) -> x.clause_id) clauses) +    trs + +let make_subst_from_generics (params : generic_params) (args : generic_args) +    (tr_self : trait_instance_id) : subst = +  let r_subst = make_region_subst_from_vars params.regions args.regions in +  let ty_subst = make_type_subst_from_vars params.types args.types in    let cg_subst = -    make_const_generic_subst_from_vars def.T.const_generic_params cgs +    make_const_generic_subst_from_vars params.const_generics args.const_generics +  in +  let tr_subst = +    make_trait_subst_from_clauses params.trait_clauses args.trait_refs    in -  let (variants_fields : (T.VariantId.id option * T.field list) list) = -    match def.T.kind with -    | T.Enum variants -> -        List.mapi -          (fun i v -> (Some (T.VariantId.of_int i), v.T.fields)) -          variants -    | T.Struct fields -> [ (None, fields) ] -    | T.Opaque -> +  { r_subst; ty_subst; cg_subst; tr_subst; tr_self } + +let make_subst_from_generics_erase_regions (params : generic_params) +    (generics : generic_args) (tr_self : 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 _ -> RErased) } + +(** Instantiate the type variables in an ADT definition, and return, for +    every variant, the list of the types of its fields. + +    **IMPORTANT**: this function doesn't normalize the types, you may want to +    use the [AssociatedTypes] equivalent instead. +*) +let type_decl_get_instantiated_variants_fields_types (def : type_decl) +    (generics : generic_args) : (VariantId.id option * ty list) list = +  (* There shouldn't be any reference to Self *) +  let tr_self = UnknownTrait __FUNCTION__ in +  let subst = make_subst_from_generics def.generics generics tr_self in +  let (variants_fields : (VariantId.id option * field list) list) = +    match def.kind with +    | Enum variants -> +        List.mapi (fun i v -> (Some (VariantId.of_int i), v.fields)) variants +    | Struct fields -> [ (None, fields) ] +    | Opaque ->          raise            (Failure               ("Can't retrieve the variants of an opaque type: " -             ^ Names.name_to_string def.name)) +            ^ show_name def.name))    in    List.map      (fun (id, fields) -> -      ( id, -        List.map -          (fun f -> ty_substitute r_subst ty_subst cg_subst f.T.field_ty) -          fields )) +      (id, List.map (fun f -> ty_substitute subst f.field_ty) fields))      variants_fields  (** Instantiate the type variables in an ADT definition, and return the list -    of types of the fields for the chosen variant *) -let type_decl_get_instantiated_field_rtypes (def : T.type_decl) -    (opt_variant_id : T.VariantId.id option) -    (regions : T.RegionId.id T.region list) (types : T.rty list) -    (cgs : T.const_generic list) : T.rty list = -  let r_subst = make_region_subst_from_vars def.T.region_params regions in -  let ty_subst = make_type_subst_from_vars def.T.type_params types in -  let cg_subst = -    make_const_generic_subst_from_vars def.T.const_generic_params cgs -  in -  let fields = TU.type_decl_get_fields def opt_variant_id in -  List.map -    (fun f -> ty_substitute r_subst ty_subst cg_subst f.T.field_ty) -    fields +    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_types (def : type_decl) +    (opt_variant_id : VariantId.id option) (generics : generic_args) : ty 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 = UnknownTrait __FUNCTION__ in +  let subst = make_subst_from_generics def.generics generics tr_self in +  let fields = type_decl_get_fields def opt_variant_id in +  List.map (fun f -> ty_substitute subst f.field_ty) fields  (** Return the types of the properly instantiated ADT's variant, provided a -    context *) -let ctx_adt_get_instantiated_field_rtypes (ctx : C.eval_ctx) -    (def_id : T.TypeDeclId.id) (opt_variant_id : T.VariantId.id option) -    (regions : T.RegionId.id T.region list) (types : T.rty list) -    (cgs : T.const_generic list) : T.rty list = -  let def = C.ctx_lookup_type_decl ctx def_id in -  type_decl_get_instantiated_field_rtypes def opt_variant_id regions types cgs +    context. + +    **IMPORTANT**: this function doesn't normalize the types, you may want to +    use the [AssociatedTypes] equivalent instead. +*) +let ctx_adt_get_instantiated_field_types (ctx : eval_ctx) +    (def_id : TypeDeclId.id) (opt_variant_id : VariantId.id option) +    (generics : generic_args) : ty list = +  let def = ctx_lookup_type_decl ctx def_id in +  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) *) -let ctx_adt_value_get_instantiated_field_rtypes (ctx : C.eval_ctx) -    (adt : V.adt_value) (id : T.type_id) -    (region_params : T.RegionId.id T.region list) (type_params : T.rty list) -    (cg_params : T.const_generic list) : T.rty list = +    here, ADT is understood in its broad meaning: ADT, assumed value or tuple). + +    **IMPORTANT**: this function doesn't normalize the types, you may want to +    use the [AssociatedTypes] equivalent instead. + *) +let ctx_adt_value_get_instantiated_field_types (ctx : eval_ctx) +    (adt : adt_value) (id : type_id) (generics : generic_args) : ty list =    match id with -  | T.AdtId id -> +  | TAdtId id ->        (* Retrieve the types of the fields *) -      ctx_adt_get_instantiated_field_rtypes ctx id adt.V.variant_id -        region_params type_params cg_params -  | T.Tuple -> -      assert (List.length region_params = 0); -      type_params -  | T.Assumed aty -> ( +      ctx_adt_get_instantiated_field_types ctx id adt.variant_id generics +  | TTuple -> +      assert (generics.regions = []); +      generics.types +  | TAssumed aty -> (        match aty with -      | T.Box | T.Vec -> -          assert (List.length region_params = 0); -          assert (List.length type_params = 1); -          assert (List.length cg_params = 0); -          type_params -      | T.Option -> -          assert (List.length region_params = 0); -          assert (List.length type_params = 1); -          assert (List.length cg_params = 0); -          if adt.V.variant_id = Some T.option_some_id then type_params -          else if adt.V.variant_id = Some T.option_none_id then [] -          else raise (Failure "Unreachable") -      | T.Range -> -          assert (List.length region_params = 0); -          assert (List.length type_params = 1); -          assert (List.length cg_params = 0); -          type_params -      | T.Array | T.Slice | T.Str -> +      | TBox -> +          assert (generics.regions = []); +          assert (List.length generics.types = 1); +          assert (generics.const_generics = []); +          generics.types +      | TArray | TSlice | 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 *) -let type_decl_get_instantiated_field_etypes (def : T.type_decl) -    (opt_variant_id : T.VariantId.id option) (types : T.ety list) -    (cgs : T.const_generic list) : T.ety list = -  let ty_subst = make_type_subst_from_vars def.T.type_params types in -  let cg_subst = -    make_const_generic_subst_from_vars def.T.const_generic_params cgs -  in -  let fields = TU.type_decl_get_fields def opt_variant_id in -  List.map -    (fun f -> erase_regions_substitute_types ty_subst cg_subst f.T.field_ty) -    fields - -(** Return the types of the properly instantiated ADT's variant, provided a -    context *) -let ctx_adt_get_instantiated_field_etypes (ctx : C.eval_ctx) -    (def_id : T.TypeDeclId.id) (opt_variant_id : T.VariantId.id option) -    (types : T.ety list) (cgs : T.const_generic list) : T.ety list = -  let def = C.ctx_lookup_type_decl ctx def_id in -  type_decl_get_instantiated_field_etypes def opt_variant_id types cgs - -let statement_substitute_visitor (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) = -  object -    inherit [_] A.map_statement -    method! visit_ety _ ty = ety_substitute tsubst cgsubst ty -    method! visit_ConstGenericVar _ id = cgsubst id - -    method! visit_const_generic_var_id _ _ = -      (* We should never get here because we reimplemented [visit_Var] *) -      raise (Failure "Unexpected") -  end -  (** Apply a type substitution to a place *) -let place_substitute (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (p : E.place) : -    E.place = +let place_substitute (subst : subst) (p : place) : place =    (* There is in fact nothing to do *) -  (statement_substitute_visitor tsubst cgsubst)#visit_place () p +  (st_substitute_visitor subst)#visit_place () p  (** Apply a type substitution to an operand *) -let operand_substitute (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (op : E.operand) : -    E.operand = -  (statement_substitute_visitor tsubst cgsubst)#visit_operand () op +let operand_substitute (subst : subst) (op : operand) : operand = +  (st_substitute_visitor subst)#visit_operand () op  (** Apply a type substitution to an rvalue *) -let rvalue_substitute (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (rv : E.rvalue) : -    E.rvalue = -  (statement_substitute_visitor tsubst cgsubst)#visit_rvalue () rv +let rvalue_substitute (subst : subst) (rv : rvalue) : rvalue = +  (st_substitute_visitor subst)#visit_rvalue () rv  (** Apply a type substitution to an assertion *) -let assertion_substitute (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (a : A.assertion) : -    A.assertion = -  (statement_substitute_visitor tsubst cgsubst)#visit_assertion () a +let assertion_substitute (subst : subst) (a : assertion) : assertion = +  (st_substitute_visitor subst)#visit_assertion () a  (** Apply a type substitution to a call *) -let call_substitute (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (call : A.call) : -    A.call = -  (statement_substitute_visitor tsubst cgsubst)#visit_call () call +let call_substitute (subst : subst) (call : call) : call = +  (st_substitute_visitor subst)#visit_call () call  (** Apply a type substitution to a statement *) -let statement_substitute (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (st : A.statement) : -    A.statement = -  (statement_substitute_visitor tsubst cgsubst)#visit_statement () st +let statement_substitute (subst : subst) (st : statement) : 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 (tsubst : T.TypeVarId.id -> T.ety) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (body : A.fun_body) : -    A.var list * A.statement = -  let rsubst r = r in +let fun_body_substitute_in_body (subst : subst) (body : fun_body) : +    var list * statement =    let locals =      List.map -      (fun (v : A.var) -> -        { v with A.var_ty = ty_substitute rsubst tsubst cgsubst v.A.var_ty }) -      body.A.locals +      (fun (v : var) -> { v with var_ty = ty_substitute subst v.var_ty }) +      body.locals    in -  let body = statement_substitute tsubst cgsubst body.body in +  let body = statement_substitute subst body.body in    (locals, body) -(** Substitute a function signature *) -let substitute_signature (asubst : T.RegionGroupId.id -> V.AbstractionId.id) -    (rsubst : T.RegionVarId.id -> T.RegionId.id) -    (tsubst : T.TypeVarId.id -> T.rty) -    (cgsubst : T.ConstGenericVarId.id -> T.const_generic) (sg : A.fun_sig) : -    A.inst_fun_sig = -  let rsubst' (r : T.RegionVarId.id T.region) : T.RegionId.id T.region = -    match r with T.Static -> T.Static | T.Var rid -> T.Var (rsubst rid) +let trait_type_constraint_substitute (subst : subst) +    (ttc : trait_type_constraint) : trait_type_constraint = +  let { trait_ref; generics; type_name; ty } = ttc 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 +  { trait_ref; generics; type_name; ty } + +(** Substitute a function signature, together with the regions hierarchy +    associated to that signature. + +    **IMPORTANT:** this function doesn't normalize the types. + *) +let substitute_signature (asubst : RegionGroupId.id -> AbstractionId.id) +    (r_subst : RegionId.id -> RegionId.id) (ty_subst : TypeVarId.id -> ty) +    (cg_subst : ConstGenericVarId.id -> const_generic) +    (tr_subst : TraitClauseId.id -> trait_instance_id) +    (tr_self : trait_instance_id) (sg : fun_sig) +    (regions_hierarchy : region_groups) : inst_fun_sig = +  let r_subst' (r : region) : region = +    match r with RStatic | RErased -> r | RVar rid -> RVar (r_subst rid)    in -  let inputs = List.map (ty_substitute rsubst' tsubst cgsubst) sg.A.inputs in -  let output = ty_substitute rsubst' tsubst cgsubst sg.A.output in -  let subst_region_group (rg : T.region_var_group) : A.abs_region_group = +  let subst = { r_subst = r_subst'; ty_subst; cg_subst; tr_subst; tr_self } in +  let inputs = List.map (ty_substitute subst) sg.inputs in +  let output = ty_substitute subst sg.output in +  let subst_region_group (rg : region_group) : abs_region_group =      let id = asubst rg.id in -    let regions = List.map rsubst rg.regions in +    let regions = List.map r_subst rg.regions in      let parents = List.map asubst rg.parents in -    { id; regions; parents } +    ({ id; regions; parents } : abs_region_group)    in -  let regions_hierarchy = List.map subst_region_group sg.A.regions_hierarchy in -  { A.regions_hierarchy; inputs; output } - -(** Substitute type variable identifiers in a type *) -let ty_substitute_ids (tsubst : T.TypeVarId.id -> T.TypeVarId.id) -    (cgsubst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ty : 'r T.ty) -    : 'r T.ty = -  let open T in +  let regions_hierarchy = List.map subst_region_group regions_hierarchy in +  let trait_type_constraints = +    List.map +      (trait_type_constraint_substitute subst) +      sg.preds.trait_type_constraints +  in +  { inputs; output; regions_hierarchy; trait_type_constraints } + +(** Substitute variable identifiers in a type *) +let statement_substitute_ids (ty_subst : TypeVarId.id -> TypeVarId.id) +    (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) (ty : ty) : ty =    let visitor =      object        inherit [_] map_ty        method visit_'r _ r = r -      method! visit_type_var_id _ id = tsubst id -      method! visit_const_generic_var_id _ id = cgsubst id +      method! visit_type_var_id _ id = ty_subst id +      method! visit_const_generic_var_id _ id = cg_subst id      end    in    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 (rsubst : T.RegionId.id -> T.RegionId.id) -    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) -    (tsubst : T.TypeVarId.id -> T.TypeVarId.id) -    (cgsubst : 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 (rsubst rid) - -      method! visit_type_var_id _ id = tsubst id -      method! visit_const_generic_var_id _ id = cgsubst 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 tsubst cgsubst 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 = rsubst 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 +let subst_ids_visitor (r_subst : RegionId.id -> RegionId.id) +    (ty_subst : TypeVarId.id -> TypeVarId.id) +    (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) +    (ssubst : SymbolicValueId.id -> SymbolicValueId.id) +    (bsubst : BorrowId.id -> BorrowId.id) +    (asubst : AbstractionId.id -> AbstractionId.id) = +  object (self : 'self) +    inherit [_] 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 (rsubst : T.RegionId.id -> T.RegionId.id) -    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) -    (tsubst : T.TypeVarId.id -> T.TypeVarId.id) -    (cgsubst : 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 typed_value_subst_ids (r_subst : RegionId.id -> RegionId.id) +    (ty_subst : TypeVarId.id -> TypeVarId.id) +    (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) +    (ssubst : SymbolicValueId.id -> SymbolicValueId.id) +    (bsubst : BorrowId.id -> BorrowId.id) (v : typed_value) : typed_value =    let asubst _ = raise (Failure "Unreachable") in -  (subst_ids_visitor rsubst rvsubst tsubst cgsubst 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 (rsubst : T.RegionId.id -> T.RegionId.id) -    (v : V.typed_value) : V.typed_value = -  typed_value_subst_ids rsubst -    (fun x -> x) +let typed_value_subst_rids (r_subst : RegionId.id -> RegionId.id) +    (v : typed_value) : typed_value = +  typed_value_subst_ids r_subst      (fun x -> x)      (fun x -> x)      (fun x -> x)      (fun x -> x)      v -let typed_avalue_subst_ids (rsubst : T.RegionId.id -> T.RegionId.id) -    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) -    (tsubst : T.TypeVarId.id -> T.TypeVarId.id) -    (cgsubst : 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 typed_avalue_subst_ids (r_subst : RegionId.id -> RegionId.id) +    (ty_subst : TypeVarId.id -> TypeVarId.id) +    (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) +    (ssubst : SymbolicValueId.id -> SymbolicValueId.id) +    (bsubst : BorrowId.id -> BorrowId.id) (v : typed_avalue) : typed_avalue =    let asubst _ = raise (Failure "Unreachable") in -  (subst_ids_visitor rsubst rvsubst tsubst cgsubst ssubst bsubst asubst) -    #visit_typed_avalue v - -let abs_subst_ids (rsubst : T.RegionId.id -> T.RegionId.id) -    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) -    (tsubst : T.TypeVarId.id -> T.TypeVarId.id) -    (cgsubst : 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 rsubst rvsubst tsubst cgsubst ssubst bsubst asubst) -    #visit_abs x - -let env_subst_ids (rsubst : T.RegionId.id -> T.RegionId.id) -    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id) -    (tsubst : T.TypeVarId.id -> T.TypeVarId.id) -    (cgsubst : 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 rsubst rvsubst tsubst cgsubst ssubst bsubst asubst) -    #visit_env x - -let typed_avalue_subst_rids (rsubst : T.RegionId.id -> T.RegionId.id) -    (x : V.typed_avalue) : V.typed_avalue = +  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 : RegionId.id -> RegionId.id) +    (ty_subst : TypeVarId.id -> TypeVarId.id) +    (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) +    (ssubst : SymbolicValueId.id -> SymbolicValueId.id) +    (bsubst : BorrowId.id -> BorrowId.id) +    (asubst : AbstractionId.id -> AbstractionId.id) (x : abs) : abs = +  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 : RegionId.id -> RegionId.id) +    (ty_subst : TypeVarId.id -> TypeVarId.id) +    (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) +    (ssubst : SymbolicValueId.id -> SymbolicValueId.id) +    (bsubst : BorrowId.id -> BorrowId.id) +    (asubst : AbstractionId.id -> AbstractionId.id) (x : env) : env = +  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 : RegionId.id -> RegionId.id) +    (x : typed_avalue) : typed_avalue =    let asubst _ = raise (Failure "Unreachable") in -  (subst_ids_visitor rsubst -     (fun x -> x) -     (fun x -> x) -     (fun x -> x) -     (fun x -> x) -     (fun x -> x) -     asubst) -    #visit_typed_avalue -    x - -let env_subst_rids (rsubst : T.RegionId.id -> T.RegionId.id) (x : C.env) : C.env -    = -  (subst_ids_visitor rsubst -     (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) +      asubst +  in +  vis#visit_typed_avalue () x + +let env_subst_rids (r_subst : RegionId.id -> RegionId.id) (x : env) : env = +  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  | 
