diff options
Diffstat (limited to '')
-rw-r--r-- | src/Print.ml | 161 |
1 files changed, 82 insertions, 79 deletions
diff --git a/src/Print.ml b/src/Print.ml index e64e7d73..64351e3e 100644 --- a/src/Print.ml +++ b/src/Print.ml @@ -48,7 +48,7 @@ module Types = struct type 'r type_formatter = { r_to_string : 'r -> string; type_var_id_to_string : T.TypeVarId.id -> string; - type_def_id_to_string : T.TypeDefId.id -> string; + type_decl_id_to_string : T.TypeDeclId.id -> string; } type stype_formatter = T.RegionVarId.id T.region type_formatter @@ -73,7 +73,7 @@ module Types = struct let type_id_to_string (fmt : 'r type_formatter) (id : T.type_id) : string = match id with - | T.AdtId id -> fmt.type_def_id_to_string id + | T.AdtId id -> fmt.type_decl_id_to_string id | T.Tuple -> "" | T.Assumed aty -> ( match aty with @@ -130,8 +130,8 @@ module Types = struct ^ String.concat ", " (List.map (field_to_string fmt) v.fields) ^ ")" - let type_def_to_string (type_def_id_to_string : T.TypeDefId.id -> string) - (def : T.type_def) : string = + let type_decl_to_string (type_decl_id_to_string : T.TypeDeclId.id -> string) + (def : T.type_decl) : string = let regions = def.region_params in let types = def.type_params in let rid_to_string rid = @@ -145,7 +145,7 @@ module Types = struct | Some tv -> type_var_to_string tv | None -> failwith "Unreachable" in - let fmt = { r_to_string; type_var_id_to_string; type_def_id_to_string } in + let fmt = { r_to_string; type_var_id_to_string; type_decl_id_to_string } in let name = name_to_string def.name in let params = if List.length regions + List.length types > 0 then @@ -180,32 +180,32 @@ module Values = struct rvar_to_string : T.RegionVarId.id -> string; r_to_string : T.RegionId.id -> string; type_var_id_to_string : T.TypeVarId.id -> string; - type_def_id_to_string : T.TypeDefId.id -> string; - adt_variant_to_string : T.TypeDefId.id -> T.VariantId.id -> string; + type_decl_id_to_string : T.TypeDeclId.id -> string; + adt_variant_to_string : T.TypeDeclId.id -> T.VariantId.id -> string; var_id_to_string : V.VarId.id -> string; adt_field_names : - T.TypeDefId.id -> T.VariantId.id option -> string list option; + T.TypeDeclId.id -> T.VariantId.id option -> string list option; } let value_to_etype_formatter (fmt : value_formatter) : PT.etype_formatter = { PT.r_to_string = PT.erased_region_to_string; PT.type_var_id_to_string = fmt.type_var_id_to_string; - PT.type_def_id_to_string = fmt.type_def_id_to_string; + PT.type_decl_id_to_string = fmt.type_decl_id_to_string; } let value_to_rtype_formatter (fmt : value_formatter) : PT.rtype_formatter = { PT.r_to_string = PT.region_to_string fmt.r_to_string; PT.type_var_id_to_string = fmt.type_var_id_to_string; - PT.type_def_id_to_string = fmt.type_def_id_to_string; + PT.type_decl_id_to_string = fmt.type_decl_id_to_string; } let value_to_stype_formatter (fmt : value_formatter) : PT.stype_formatter = { PT.r_to_string = PT.region_to_string fmt.rvar_to_string; PT.type_var_id_to_string = fmt.type_var_id_to_string; - PT.type_def_id_to_string = fmt.type_def_id_to_string; + PT.type_decl_id_to_string = fmt.type_decl_id_to_string; } let var_id_to_string (id : V.VarId.id) : string = @@ -260,7 +260,7 @@ module Values = struct let adt_ident = match av.variant_id with | Some vid -> fmt.adt_variant_to_string def_id vid - | None -> fmt.type_def_id_to_string def_id + | None -> fmt.type_decl_id_to_string def_id in if List.length field_values > 0 then match fmt.adt_field_names def_id av.V.variant_id with @@ -372,7 +372,7 @@ module Values = struct let adt_ident = match av.variant_id with | Some vid -> fmt.adt_variant_to_string def_id vid - | None -> fmt.type_def_id_to_string def_id + | None -> fmt.type_decl_id_to_string def_id in if List.length field_values > 0 then match fmt.adt_field_names def_id av.V.variant_id with @@ -565,21 +565,22 @@ module Contexts = struct let ctx_to_rtype_formatter (fmt : ctx_formatter) : PT.rtype_formatter = PV.value_to_rtype_formatter fmt - let type_ctx_to_adt_variant_to_string_fun (ctx : T.type_def T.TypeDefId.Map.t) - : T.TypeDefId.id -> T.VariantId.id -> string = + let type_ctx_to_adt_variant_to_string_fun + (ctx : T.type_decl T.TypeDeclId.Map.t) : + T.TypeDeclId.id -> T.VariantId.id -> string = fun def_id variant_id -> - let def = T.TypeDefId.Map.find def_id ctx in + let def = T.TypeDeclId.Map.find def_id ctx in match def.kind with | Struct _ -> failwith "Unreachable" | Enum variants -> let variant = T.VariantId.nth variants variant_id in name_to_string def.name ^ "::" ^ variant.variant_name - let type_ctx_to_adt_field_names_fun (ctx : T.type_def T.TypeDefId.Map.t) : - T.TypeDefId.id -> T.VariantId.id option -> string list option = + let type_ctx_to_adt_field_names_fun (ctx : T.type_decl T.TypeDeclId.Map.t) : + T.TypeDeclId.id -> T.VariantId.id option -> string list option = fun def_id opt_variant_id -> - let def = T.TypeDefId.Map.find def_id ctx in - let fields = TU.type_def_get_fields def opt_variant_id in + let def = T.TypeDeclId.Map.find def_id ctx in + let fields = TU.type_decl_get_fields def opt_variant_id in (* There are two cases: either all the fields have names, or none of them * has names *) let has_names = @@ -599,25 +600,25 @@ module Contexts = struct let v = C.lookup_type_var ctx vid in v.name in - let type_def_id_to_string def_id = - let def = C.ctx_lookup_type_def ctx def_id in + let type_decl_id_to_string def_id = + let def = C.ctx_lookup_type_decl ctx def_id in name_to_string def.name in let adt_variant_to_string = - type_ctx_to_adt_variant_to_string_fun ctx.type_context.type_defs + type_ctx_to_adt_variant_to_string_fun ctx.type_context.type_decls in let var_id_to_string vid = let bv = C.ctx_lookup_binder ctx vid in binder_to_string bv in let adt_field_names = - type_ctx_to_adt_field_names_fun ctx.type_context.type_defs + type_ctx_to_adt_field_names_fun ctx.type_context.type_decls in { rvar_to_string; r_to_string; type_var_id_to_string; - type_def_id_to_string; + type_decl_id_to_string; adt_variant_to_string; var_id_to_string; adt_field_names; @@ -683,14 +684,14 @@ module CfimAst = struct rvar_to_string : T.RegionVarId.id -> string; r_to_string : T.RegionId.id -> string; type_var_id_to_string : T.TypeVarId.id -> string; - type_def_id_to_string : T.TypeDefId.id -> string; - adt_variant_to_string : T.TypeDefId.id -> T.VariantId.id -> string; + type_decl_id_to_string : T.TypeDeclId.id -> string; + adt_variant_to_string : T.TypeDeclId.id -> T.VariantId.id -> string; adt_field_to_string : - T.TypeDefId.id -> T.VariantId.id option -> T.FieldId.id -> string option; + T.TypeDeclId.id -> T.VariantId.id option -> T.FieldId.id -> string option; var_id_to_string : V.VarId.id -> string; adt_field_names : - T.TypeDefId.id -> T.VariantId.id option -> string list option; - fun_def_id_to_string : A.FunDefId.id -> string; + T.TypeDeclId.id -> T.VariantId.id option -> string list option; + fun_decl_id_to_string : A.FunDeclId.id -> string; } let ast_to_ctx_formatter (fmt : ast_formatter) : PC.ctx_formatter = @@ -698,7 +699,7 @@ module CfimAst = struct PV.rvar_to_string = fmt.rvar_to_string; PV.r_to_string = fmt.r_to_string; PV.type_var_id_to_string = fmt.type_var_id_to_string; - PV.type_def_id_to_string = fmt.type_def_id_to_string; + PV.type_decl_id_to_string = fmt.type_decl_id_to_string; PV.adt_variant_to_string = fmt.adt_variant_to_string; PV.var_id_to_string = fmt.var_id_to_string; PV.adt_field_names = fmt.adt_field_names; @@ -711,55 +712,57 @@ module CfimAst = struct { PT.r_to_string = PT.erased_region_to_string; PT.type_var_id_to_string = fmt.type_var_id_to_string; - PT.type_def_id_to_string = fmt.type_def_id_to_string; + PT.type_decl_id_to_string = fmt.type_decl_id_to_string; } let ast_to_rtype_formatter (fmt : ast_formatter) : PT.rtype_formatter = { PT.r_to_string = PT.region_to_string fmt.r_to_string; PT.type_var_id_to_string = fmt.type_var_id_to_string; - PT.type_def_id_to_string = fmt.type_def_id_to_string; + PT.type_decl_id_to_string = fmt.type_decl_id_to_string; } let ast_to_stype_formatter (fmt : ast_formatter) : PT.stype_formatter = { PT.r_to_string = PT.region_to_string fmt.rvar_to_string; PT.type_var_id_to_string = fmt.type_var_id_to_string; - PT.type_def_id_to_string = fmt.type_def_id_to_string; + PT.type_decl_id_to_string = fmt.type_decl_id_to_string; } - let type_ctx_to_adt_field_to_string_fun (ctx : T.type_def T.TypeDefId.Map.t) : - T.TypeDefId.id -> T.VariantId.id option -> T.FieldId.id -> string option = + let type_ctx_to_adt_field_to_string_fun (ctx : T.type_decl T.TypeDeclId.Map.t) + : + T.TypeDeclId.id -> T.VariantId.id option -> T.FieldId.id -> string option + = fun def_id opt_variant_id field_id -> - let def = T.TypeDefId.Map.find def_id ctx in - let fields = TU.type_def_get_fields def opt_variant_id in + let def = T.TypeDeclId.Map.find def_id ctx in + let fields = TU.type_decl_get_fields def opt_variant_id in let field = T.FieldId.nth fields field_id in field.T.field_name let eval_ctx_to_ast_formatter (ctx : C.eval_ctx) : ast_formatter = let ctx_fmt = PC.eval_ctx_to_ctx_formatter ctx in let adt_field_to_string = - type_ctx_to_adt_field_to_string_fun ctx.type_context.type_defs + type_ctx_to_adt_field_to_string_fun ctx.type_context.type_decls in - let fun_def_id_to_string def_id = - let def = C.ctx_lookup_fun_def ctx def_id in + let fun_decl_id_to_string def_id = + let def = C.ctx_lookup_fun_decl ctx def_id in fun_name_to_string def.name in { rvar_to_string = ctx_fmt.PV.rvar_to_string; r_to_string = ctx_fmt.PV.r_to_string; type_var_id_to_string = ctx_fmt.PV.type_var_id_to_string; - type_def_id_to_string = ctx_fmt.PV.type_def_id_to_string; + type_decl_id_to_string = ctx_fmt.PV.type_decl_id_to_string; adt_variant_to_string = ctx_fmt.PV.adt_variant_to_string; var_id_to_string = ctx_fmt.PV.var_id_to_string; adt_field_names = ctx_fmt.PV.adt_field_names; adt_field_to_string; - fun_def_id_to_string; + fun_decl_id_to_string; } - let fun_def_to_ast_formatter (type_defs : T.type_def T.TypeDefId.Map.t) - (fun_defs : A.fun_def A.FunDefId.Map.t) (fdef : A.fun_def) : ast_formatter - = + let fun_decl_to_ast_formatter (type_decls : T.type_decl T.TypeDeclId.Map.t) + (fun_decls : A.fun_decl A.FunDeclId.Map.t) (fdef : A.fun_decl) : + ast_formatter = let rvar_to_string r = let rvar = T.RegionVarId.nth fdef.signature.region_params r in PT.region_var_to_string rvar @@ -770,33 +773,33 @@ module CfimAst = struct let var = T.TypeVarId.nth fdef.signature.type_params vid in PT.type_var_to_string var in - let type_def_id_to_string def_id = - let def = T.TypeDefId.Map.find def_id type_defs in + let type_decl_id_to_string def_id = + let def = T.TypeDeclId.Map.find def_id type_decls in name_to_string def.name in let adt_variant_to_string = - PC.type_ctx_to_adt_variant_to_string_fun type_defs + PC.type_ctx_to_adt_variant_to_string_fun type_decls in let var_id_to_string vid = let var = V.VarId.nth fdef.locals vid in var_to_string var in - let adt_field_names = PC.type_ctx_to_adt_field_names_fun type_defs in - let adt_field_to_string = type_ctx_to_adt_field_to_string_fun type_defs in - let fun_def_id_to_string def_id = - let def = A.FunDefId.Map.find def_id fun_defs in + let adt_field_names = PC.type_ctx_to_adt_field_names_fun type_decls in + let adt_field_to_string = type_ctx_to_adt_field_to_string_fun type_decls in + let fun_decl_id_to_string def_id = + let def = A.FunDeclId.Map.find def_id fun_decls in fun_name_to_string def.name in { rvar_to_string; r_to_string; type_var_id_to_string; - type_def_id_to_string; + type_decl_id_to_string; adt_variant_to_string; var_id_to_string; adt_field_names; adt_field_to_string; - fun_def_id_to_string; + fun_decl_id_to_string; } let rec projection_to_string (fmt : ast_formatter) (inside : string) @@ -907,7 +910,7 @@ module CfimAst = struct match akind with | E.AggregatedTuple -> "(" ^ String.concat ", " ops ^ ")" | E.AggregatedAdt (def_id, opt_variant_id, _regions, _types) -> - let adt_name = fmt.type_def_id_to_string def_id in + let adt_name = fmt.type_decl_id_to_string def_id in let variant_name = match opt_variant_id with | None -> adt_name @@ -959,7 +962,7 @@ module CfimAst = struct let args = "(" ^ String.concat ", " args ^ ")" in let name_params = match call.A.func with - | A.Local fid -> fmt.fun_def_id_to_string fid ^ params + | A.Local fid -> fmt.fun_decl_id_to_string fid ^ params | A.Assumed fid -> ( match fid with | A.Replace -> "core::mem::replace" ^ params @@ -1034,8 +1037,8 @@ module CfimAst = struct let var_to_string (v : A.var) : string = match v.name with None -> PV.var_id_to_string v.index | Some name -> name - let fun_def_to_string (fmt : ast_formatter) (indent : string) - (indent_incr : string) (def : A.fun_def) : string = + let fun_decl_to_string (fmt : ast_formatter) (indent : string) + (indent_incr : string) (def : A.fun_decl) : string = let sty_fmt = ast_to_stype_formatter fmt in let sty_to_string = PT.sty_to_string sty_fmt in let ety_fmt = ast_to_etype_formatter fmt in @@ -1099,18 +1102,18 @@ module PA = CfimAst (* local module *) module Module = struct (** This function pretty-prints a type definition by using a definition context *) - let type_def_to_string (type_context : T.type_def T.TypeDefId.Map.t) - (def : T.type_def) : string = - let type_def_id_to_string (id : T.TypeDefId.id) : string = - let def = T.TypeDefId.Map.find id type_context in + let type_decl_to_string (type_context : T.type_decl T.TypeDeclId.Map.t) + (def : T.type_decl) : string = + let type_decl_id_to_string (id : T.TypeDeclId.id) : string = + let def = T.TypeDeclId.Map.find id type_context in name_to_string def.name in - PT.type_def_to_string type_def_id_to_string def + PT.type_decl_to_string type_decl_id_to_string def (** Generate an [ast_formatter] by using a definition context in combination with the variables local to a function's definition *) - let def_ctx_to_ast_formatter (type_context : T.type_def T.TypeDefId.Map.t) - (fun_context : A.fun_def A.FunDefId.Map.t) (def : A.fun_def) : + let def_ctx_to_ast_formatter (type_context : T.type_decl T.TypeDeclId.Map.t) + (fun_context : A.fun_decl A.FunDeclId.Map.t) (def : A.fun_decl) : PA.ast_formatter = let rvar_to_string vid = let var = T.RegionVarId.nth def.signature.region_params vid in @@ -1124,12 +1127,12 @@ module Module = struct let var = T.TypeVarId.nth def.signature.type_params vid in PT.type_var_to_string var in - let type_def_id_to_string def_id = - let def = T.TypeDefId.Map.find def_id type_context in + let type_decl_id_to_string def_id = + let def = T.TypeDeclId.Map.find def_id type_context in name_to_string def.name in - let fun_def_id_to_string def_id = - let def = A.FunDefId.Map.find def_id fun_context in + let fun_decl_id_to_string def_id = + let def = A.FunDeclId.Map.find def_id fun_context in fun_name_to_string def.name in let var_id_to_string vid = @@ -1147,34 +1150,34 @@ module Module = struct rvar_to_string; r_to_string; type_var_id_to_string; - type_def_id_to_string; + type_decl_id_to_string; adt_variant_to_string; adt_field_to_string; var_id_to_string; adt_field_names; - fun_def_id_to_string; + fun_decl_id_to_string; } (** This function pretty-prints a function definition by using a definition context *) - let fun_def_to_string (type_context : T.type_def T.TypeDefId.Map.t) - (fun_context : A.fun_def A.FunDefId.Map.t) (def : A.fun_def) : string = + let fun_decl_to_string (type_context : T.type_decl T.TypeDeclId.Map.t) + (fun_context : A.fun_decl A.FunDeclId.Map.t) (def : A.fun_decl) : string = let fmt = def_ctx_to_ast_formatter type_context fun_context def in - PA.fun_def_to_string fmt "" " " def + PA.fun_decl_to_string fmt "" " " def let module_to_string (m : M.cfim_module) : string = let types_defs_map, funs_defs_map = M.compute_defs_maps m in (* The types *) - let type_defs = List.map (type_def_to_string types_defs_map) m.M.types in + let type_decls = List.map (type_decl_to_string types_defs_map) m.M.types in (* The functions *) - let fun_defs = - List.map (fun_def_to_string types_defs_map funs_defs_map) m.M.functions + let fun_decls = + List.map (fun_decl_to_string types_defs_map funs_defs_map) m.M.functions in (* Put everything together *) - let all_defs = List.append type_defs fun_defs in + let all_defs = List.append type_decls fun_decls in String.concat "\n\n" all_defs end |