diff options
Diffstat (limited to 'src/SymbolicToPure.ml')
-rw-r--r-- | src/SymbolicToPure.ml | 91 |
1 files changed, 91 insertions, 0 deletions
diff --git a/src/SymbolicToPure.ml b/src/SymbolicToPure.ml new file mode 100644 index 00000000..7792db4b --- /dev/null +++ b/src/SymbolicToPure.ml @@ -0,0 +1,91 @@ +open Errors +module Id = Identifiers +module T = Types +module V = Values +module E = Expressions +module A = CfimAst +module S = SymbolicAst + +type name = + | FunName of A.FunDefId.id * V.BackwardFunctionId.id option + | TypeName of T.TypeDefId.id +[@@deriving show, ord] + +let name_to_string (n : name) : string = show_name n + +module NameOrderedType = struct + type t = name + + let compare = compare_name + + let to_string = name_to_string + + let pp_t = pp_name + + let show_t = show_name +end + +module NameMap = Collections.MakeMapInj (NameOrderedType) (Id.NameOrderedType) +(** Notice that we use the *injective* map to map identifiers to names. + + Of course, even if those names (which are string lists) don't collide, + when converting them to strings we can still introduce collisions: we + check that later. + + Note that we use injective maps for sanity: though we write the name + generation with collision in mind, it is always good to have such checks. + *) + +let fun_to_name (fdef : A.fun_def) (bid : V.BackwardFunctionId.id option) : + Id.name = + let sg = fdef.signature in + (* General function to generate a suffix for a region group + * (i.e., an abstraction)*) + let rg_to_string (rg : T.region_var_group) : string = + (* We are just a little bit smart: + - if there is exactly one region id in the region group and this region + has a name, we use this name + - otherwise, we use the region number (note that region names shouldn't + start with numbers) + *) + match rg.T.regions with + | [ rid ] -> ( + let rvar = T.RegionVarId.nth sg.region_params rid in + match rvar.name with + | None -> T.RegionGroupId.to_string rg.T.id + | Some name -> name) + | _ -> T.RegionGroupId.to_string rg.T.id + in + (* There are several cases: + - this is a forward function: we add "_fwd" + - this is a backward function: + - this function has one backward function: we add "_back" + - this function has several backward function: we add "_back" and an + additional suffix to identify the precise backward function + *) + let suffix = + match bid with + | None -> "_fwd" + | Some bid -> ( + match sg.regions_hierarchy with + | [] -> + failwith "Unreachable" + (* we can't get there if we ask for a back function *) + | [ _ ] -> + (* Exactly one backward function *) + "_back" + | _ -> + (* Several backward functions - note that **we use the backward function id + * as if it were a region group id** (there is a direct mapping between the + * two - TODO: merge them) *) + let rg = V.BackwardFunctionId.nth sg.regions_hierarchy bid in + "_back" ^ rg_to_string rg) + in + (* Final name *) + let rec add_to_last (n : Id.name) : Id.name = + match n with + | [] -> failwith "Unreachable" + | [ x ] -> [ x ^ suffix ] + | x :: n -> x :: add_to_last n + in + add_to_last fdef.name |