diff options
Diffstat (limited to '')
| -rw-r--r-- | src/Identifiers.ml | 16 | ||||
| -rw-r--r-- | src/Pure.ml | 14 | ||||
| -rw-r--r-- | src/PureMicroPasses.ml | 19 |
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 |