summaryrefslogtreecommitdiff
path: root/src/SymbolicToPure.ml
diff options
context:
space:
mode:
Diffstat (limited to 'src/SymbolicToPure.ml')
-rw-r--r--src/SymbolicToPure.ml91
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