diff options
Diffstat (limited to 'src/constant_fold.ml')
| -rw-r--r-- | src/constant_fold.ml | 20 |
1 files changed, 14 insertions, 6 deletions
diff --git a/src/constant_fold.ml b/src/constant_fold.ml index 6ad1f663..2c46f38b 100644 --- a/src/constant_fold.ml +++ b/src/constant_fold.ml @@ -78,7 +78,8 @@ and exp_of_value = | V_tuple vs -> mk_exp (E_tuple (List.map exp_of_value vs)) | V_unit -> mk_lit_exp L_unit - | V_attempted_read str -> mk_exp (E_id (mk_id str)) + | V_attempted_read str -> + mk_exp (E_id (mk_id str)) | _ -> failwith "No expression for value" (* We want to avoid evaluating things like print statements at compile @@ -126,6 +127,13 @@ let rec run frame = run (Interpreter.eval_frame frame) | Interpreter.Break frame -> run (Interpreter.eval_frame frame) + | Interpreter.Effect_request (st, Interpreter.Read_reg (reg, cont)) -> + (* return a dummy value to read_reg requests which we handle above + if an expression finally evals to it, but the interpreter + will fail if it tries to actually use. See value.ml *) + run (cont (Value.V_attempted_read reg) st) + | Interpreter.Effect_request _ -> + assert false (* effectful, raise exception to abort constant folding *) (** This rewriting pass looks for function applications (E_app) expressions where every argument is a literal. It passes these @@ -144,13 +152,13 @@ let rec run frame = - Throws an exception that isn't caught. *) -let rec rewrite_constant_function_calls' ast = +let rec rewrite_constant_function_calls' env ast = let rewrite_count = ref 0 in let ok () = incr rewrite_count in let not_ok () = decr rewrite_count in let lstate, gstate = - Interpreter.initial_state ast safe_primops + Interpreter.initial_state ast env safe_primops in let gstate = { gstate with Interpreter.allow_registers = false } in @@ -207,11 +215,11 @@ let rec rewrite_constant_function_calls' ast = let ast = rewrite_defs_base rw_defs ast in (* We keep iterating until we have no more re-writes to do *) if !rewrite_count > 0 - then rewrite_constant_function_calls' ast + then rewrite_constant_function_calls' env ast else ast -let rewrite_constant_function_calls ast = +let rewrite_constant_function_calls env ast = if !optimize_constant_fold then - rewrite_constant_function_calls' ast + rewrite_constant_function_calls' env ast else ast |