summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSon Ho2022-01-28 14:08:18 +0100
committerSon Ho2022-01-28 14:08:18 +0100
commita28b8a06c0afbbf2a17518fa3e8f66b88c08bc5f (patch)
treef53b9e424d6460c5c5c9a7e1d35d5327d87c18fa /src
parent58802bdaeef6c4c73cb82427eb0f2c6ca9d9a43a (diff)
Implement get_expression_min_var_counter
Diffstat (limited to 'src')
-rw-r--r--src/Identifiers.ml16
-rw-r--r--src/Pure.ml14
-rw-r--r--src/PureMicroPasses.ml19
3 files changed, 40 insertions, 9 deletions
diff --git a/src/Identifiers.ml b/src/Identifiers.ml
index 757c9df5..dfcbb631 100644
--- a/src/Identifiers.ml
+++ b/src/Identifiers.ml
@@ -16,8 +16,12 @@ module type Id = sig
val generator_zero : generator
+ val generator_from_incr_id : id -> generator
+
val fresh_stateful_generator : unit -> generator ref * (unit -> id)
+ val incr : id -> id
+
(* TODO: this should be stateful! - but we may want to be able to duplicate
contexts...
Maybe we could have a `fresh` and a `global_fresh`
@@ -35,6 +39,10 @@ module type Id = sig
val compare_id : id -> id -> int
+ val max : id -> id -> id
+
+ val min : id -> id -> id
+
val pp_generator : Format.formatter -> generator -> unit
val show_generator : generator -> string
@@ -91,6 +99,10 @@ module IdGen () : Id = struct
* they happen *)
if x == max_int then raise (Errors.IntegerOverflow ()) else x + 1
+ let generator_from_incr_id id =
+ let id = incr id in
+ id
+
let fresh_stateful_generator () =
let g = ref 0 in
let fresh () =
@@ -116,6 +128,10 @@ module IdGen () : Id = struct
let compare_id = compare
+ let max id0 id1 = if id0 > id1 then id0 else id1
+
+ let min id0 id1 = if id0 < id1 then id0 else id1
+
let nth v id = List.nth v id
let nth_opt v id = List.nth_opt v id
diff --git a/src/Pure.ml b/src/Pure.ml
index 201ffd74..30d4a0a8 100644
--- a/src/Pure.ml
+++ b/src/Pure.ml
@@ -351,18 +351,20 @@ class ['self] map_expression_base =
(** Ancestor for [reduce_expression] visitor *)
class virtual ['self] reduce_expression_base =
- object (_self : 'self)
+ object (self : 'self)
inherit [_] reduce_typed_rvalue
- method visit_meta : 'env -> meta -> 'a = fun _ _ -> ()
+ method visit_meta : 'env -> meta -> 'a = fun _ _ -> self#zero
- method visit_integer_type : 'env -> T.integer_type -> 'a = fun _ _ -> ()
+ method visit_integer_type : 'env -> T.integer_type -> 'a =
+ fun _ _ -> self#zero
- method visit_scalar_value : 'env -> scalar_value -> 'a = fun _ _ -> ()
+ method visit_scalar_value : 'env -> scalar_value -> 'a =
+ fun _ _ -> self#zero
- method visit_id : 'env -> VariantId.id -> 'a = fun _ _ -> ()
+ method visit_id : 'env -> VariantId.id -> 'a = fun _ _ -> self#zero
- method visit_fun_id : 'env -> fun_id -> 'a = fun _ _ -> ()
+ method visit_fun_id : 'env -> fun_id -> 'a = fun _ _ -> self#zero
end
(** **Rk.:** here, [expression] is not at all equivalent to the expressions
diff --git a/src/PureMicroPasses.ml b/src/PureMicroPasses.ml
index cb7f5b23..579fcf14 100644
--- a/src/PureMicroPasses.ml
+++ b/src/PureMicroPasses.ml
@@ -16,7 +16,20 @@ let log = L.pure_micro_passes_log
variables indices...
*)
let get_expression_min_var_counter (e : expression) : VarId.generator =
- raise Unimplemented
+ let obj =
+ object
+ inherit [_] reduce_expression
+
+ method zero _ _ = VarId.zero
+
+ method plus id0 id1 _ _ = VarId.max (id0 () ()) (id1 () ())
+ (* Get the maximum *)
+
+ method! visit_var _ v mp () = v.id
+ end
+ in
+ let id = obj#visit_expression () e () () in
+ VarId.generator_from_incr_id id
type pn_ctx = string VarId.Map.t
(** "pretty-name context": see [compute_pretty_names] *)
@@ -336,8 +349,8 @@ let apply_passes_to_def (ctx : trans_ctx) (def : fun_def) : fun_def =
(* Add unit arguments for functions with no arguments, and change their return type.
* **Rk.**: from now onwards, the types in the AST are correct (until now,
* functions had return type `t` where they should have return type `result t`) *)
- (* let def = to_monadic def in
- log#ldebug (lazy ("to_monadic:\n" ^ fun_def_to_string ctx def));*)
+ let def = to_monadic def in
+ log#ldebug (lazy ("to_monadic:\n" ^ fun_def_to_string ctx def));
(* Inline the useless variable reassignments *)
let def = inline_useless_var_reassignments def in