diff options
Diffstat (limited to '')
| -rw-r--r-- | src/Identifiers.ml | 4 | ||||
| -rw-r--r-- | src/Pure.ml | 9 | ||||
| -rw-r--r-- | src/PureMicroPasses.ml | 27 |
3 files changed, 21 insertions, 19 deletions
diff --git a/src/Identifiers.ml b/src/Identifiers.ml index eb2db3bd..64a8ec03 100644 --- a/src/Identifiers.ml +++ b/src/Identifiers.ml @@ -101,9 +101,7 @@ 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 generator_from_incr_id id = incr id let mk_stateful_generator g = let g = ref g in diff --git a/src/Pure.ml b/src/Pure.ml index 79801440..9efab912 100644 --- a/src/Pure.ml +++ b/src/Pure.ml @@ -406,8 +406,6 @@ class ['self] iter_expression_base = method visit_scalar_value : 'env -> scalar_value -> unit = fun _ _ -> () - method visit_id : 'env -> VariantId.id -> unit = fun _ _ -> () - method visit_fun_id : 'env -> fun_id -> unit = fun _ _ -> () end @@ -424,8 +422,6 @@ class ['self] map_expression_base = method visit_scalar_value : 'env -> scalar_value -> scalar_value = fun _ x -> x - method visit_id : 'env -> VariantId.id -> VariantId.id = fun _ x -> x - method visit_fun_id : 'env -> fun_id -> fun_id = fun _ x -> x end @@ -442,8 +438,6 @@ class virtual ['self] reduce_expression_base = method visit_scalar_value : 'env -> scalar_value -> 'a = fun _ _ -> self#zero - method visit_id : 'env -> VariantId.id -> 'a = fun _ _ -> self#zero - method visit_fun_id : 'env -> fun_id -> 'a = fun _ _ -> self#zero end @@ -460,9 +454,6 @@ class virtual ['self] mapreduce_expression_base = method visit_scalar_value : 'env -> scalar_value -> scalar_value * 'a = fun _ x -> (x, self#zero) - method visit_id : 'env -> VariantId.id -> VariantId.id * 'a = - fun _ x -> (x, self#zero) - method visit_fun_id : 'env -> fun_id -> fun_id * 'a = fun _ x -> (x, self#zero) end diff --git a/src/PureMicroPasses.ml b/src/PureMicroPasses.ml index cc661883..7b34ad76 100644 --- a/src/PureMicroPasses.ml +++ b/src/PureMicroPasses.ml @@ -81,20 +81,30 @@ type config = { TODO: things would be simpler if we used a better representation of the variables indices... *) -let get_expression_min_var_counter (e : expression) : VarId.generator = +let get_body_min_var_counter (body : fun_body) : VarId.generator = + (* Find the max id in the input variables - some of them may have been + * filtered from the body *) + let min_input_id = + List.fold_left (fun id var -> VarId.max id var.id) VarId.zero body.inputs + in let obj = object inherit [_] reduce_expression - method zero _ = VarId.zero + method zero _ = min_input_id method plus id0 id1 _ = VarId.max (id0 ()) (id1 ()) (* Get the maximum *) method! visit_var _ v _ = v.id + (** For the lvalues *) + + method! visit_place _ p _ = p.var + (** For the rvalues *) end in - let id = obj#visit_expression () e () in + (* Find the max counter in the body *) + let id = obj#visit_expression () body.body.e () in VarId.generator_from_incr_id id type pn_ctx = string VarId.Map.t @@ -802,7 +812,7 @@ let to_monadic (config : config) (def : fun_decl) : fun_decl = match def.body with | None -> None | Some body -> - let var_cnt = get_expression_min_var_counter body.body.e in + let var_cnt = get_body_min_var_counter body in let id, _ = VarId.fresh var_cnt in let var = { id; basename = None; ty = unit_ty } in let inputs = [ var ] in @@ -940,7 +950,7 @@ let decompose_monadic_let_bindings (_ctx : trans_ctx) (def : fun_decl) : | None -> def | Some body -> (* Set up the var id generator *) - let cnt = get_expression_min_var_counter body.body.e in + let cnt = get_body_min_var_counter body in let _, fresh_id = VarId.mk_stateful_generator cnt in (* It is a very simple map *) let obj = @@ -985,8 +995,11 @@ let unfold_monadic_let_bindings (config : config) (_ctx : trans_ctx) | None -> def | Some body -> (* We may need to introduce fresh variables for the state *) - let var_cnt = get_expression_min_var_counter body.body.e in - let _, fresh_var_id = VarId.mk_stateful_generator var_cnt in + let fresh_var_id = + let var_cnt = get_body_min_var_counter body in + let _, fresh_var_id = VarId.mk_stateful_generator var_cnt in + fresh_var_id + in let fresh_state_var () = let id = fresh_var_id () in { id; basename = Some "st"; ty = mk_state_ty } |