From c72324933754226f728a2932407bd51df973fb13 Mon Sep 17 00:00:00 2001 From: Denis Merigoux Date: Fri, 6 Jan 2023 17:07:43 +0100 Subject: [PATCH] Managed to find a MWE of the bug --- runtimes/jsoo/runtime.ml | 20 ++++++ runtimes/ocaml/runtime.ml | 45 +++++++++--- tests/test_scope/good/dune | 10 +++ tests/test_scope/good/scope_call3.catala_en | 78 +++++++++++++++++++++ tests/test_scope/good/test.ml | 8 +++ 5 files changed, 152 insertions(+), 9 deletions(-) create mode 100644 tests/test_scope/good/dune create mode 100644 tests/test_scope/good/scope_call3.catala_en create mode 100644 tests/test_scope/good/test.ml diff --git a/runtimes/jsoo/runtime.ml b/runtimes/jsoo/runtime.ml index 3cf41826..e84730dc 100644 --- a/runtimes/jsoo/runtime.ml +++ b/runtimes/jsoo/runtime.ml @@ -83,6 +83,18 @@ class type event_manager = (unit, raw_event Js.t Js.js_array Js.t) Js.meth_callback Js.meth end +let raw_event_to_string = function + | R_ocaml.BeginCall name -> + Printf.sprintf "BeginCall([ " ^ String.concat ", " name ^ " ])" + | EndCall name -> + Printf.sprintf "EndCall([ " ^ String.concat ", " name ^ " ])" + | VariableDefinition (name, value) -> + Printf.sprintf "VariableDefinition([ %s ], %s)" (String.concat ", " name) + (R_ocaml.yojson_of_runtime_value value |> Yojson.Safe.to_string) + | DecisionTaken pos -> + Printf.sprintf "DecisionTaken(%s:%d.%d-%d.%d)" pos.filename pos.start_line + pos.start_column pos.end_line pos.end_column + let event_manager : event_manager Js.t = object%js method resetLog = Js.wrap_meth_callback R_ocaml.reset_log @@ -92,6 +104,14 @@ let event_manager : event_manager Js.t = Js.array (Array.of_list (R_ocaml.retrieve_log () + |> List.map (fun event -> + Firebug.console##log + (Js.string + ("Parsing " + ^ + try raw_event_to_string event + with Failure _ -> "nothing")); + event) |> R_ocaml.EventParser.parse_raw_events |> List.map (fun event -> object%js diff --git a/runtimes/ocaml/runtime.ml b/runtimes/ocaml/runtime.ml index dbd664e8..80406db6 100644 --- a/runtimes/ocaml/runtime.ml +++ b/runtimes/ocaml/runtime.ml @@ -372,7 +372,9 @@ module EventParser = struct | VariableDefinition (name, value) -> Printf.sprintf "VariableDefinition([ %s ], %s)" (String.concat ", " name) (yojson_of_runtime_value value |> Yojson.Safe.to_string) - | DecisionTaken _ -> Printf.sprintf "DecisionTaken(_)" + | DecisionTaken pos -> + Printf.sprintf "DecisionTaken(%s:%d.%d-%d.%d)" pos.filename pos.start_line + pos.start_column pos.end_line pos.end_column let parse_raw_events raw_events = let nb_raw_events = List.length raw_events @@ -386,16 +388,26 @@ module EventParser = struct and is_subscope_input_var_def name = 2 = List.length name && String.contains (List.nth name 1) '.' in + List.iter + (fun event -> + Format.printf "To parse: %s\n" + (try raw_event_to_string event with Failure _ -> "nothing")) + raw_events; let rec parse_events (ctx : context) : context = match ctx.rest with | [] -> { ctx with events = ctx.events |> List.rev } - | VariableDefinition (name, _) :: rest when is_var_def name -> + | (VariableDefinition (name, _) as e1) :: rest when is_var_def name -> (* VariableDefinition without position corresponds to a function definition which are ignored for now in structured events. *) + Format.printf "Parsing1: %s\n" (raw_event_to_string e1); parse_events { ctx with rest } - | DecisionTaken pos :: VariableDefinition (name, value) :: rest + | (DecisionTaken pos as e1) + :: (VariableDefinition (name, value) as e2) + :: rest when is_subscope_input_var_def name -> ( + Format.printf "Parsing2: %s\n" (raw_event_to_string e1); + Format.printf "Parsing2: %s\n" (raw_event_to_string e2); match name with | [_; var_dot_subscope_var_name] -> let var_name = @@ -412,8 +424,12 @@ module EventParser = struct } | _ -> failwith "unreachable due to the [is_subscope_input_var_def] test") - | DecisionTaken pos :: VariableDefinition (name, value) :: rest + | (DecisionTaken pos as e1) + :: (VariableDefinition (name, value) as e2) + :: rest when is_var_def name || is_output_var_def name -> + Format.printf "Parsing3: %s\n" (raw_event_to_string e1); + Format.printf "Parsing3: %s\n" (raw_event_to_string e2); parse_events { ctx with @@ -422,8 +438,14 @@ module EventParser = struct :: ctx.events; rest; } - | DecisionTaken pos :: VariableDefinition _ :: BeginCall infos :: _ + | (DecisionTaken pos as e1) + :: (VariableDefinition _ as e2) + :: (BeginCall infos as e3) + :: _ when is_function_call infos -> + Format.printf "Parsing4: %s\n" (raw_event_to_string e1); + Format.printf "Parsing4: %s\n" (raw_event_to_string e2); + Format.printf "Parsing4: %s\n" (raw_event_to_string e3); (* Variable definition with function calls. *) let rec parse_fun_calls fun_calls raw_events = match raw_events with @@ -458,12 +480,15 @@ module EventParser = struct in parse_events { ctx with events = var_comp :: ctx.events; rest } - | VariableDefinition _ :: BeginCall infos :: _ when is_function_call infos - -> + | (VariableDefinition _ as e1) :: (BeginCall infos as e2) :: _ + when is_function_call infos -> + Format.printf "Parsing5: %s\n" (raw_event_to_string e1); + Format.printf "Parsing5: %s\n" (raw_event_to_string e2); let rest, fun_call = parse_fun_call ctx.rest in parse_events { ctx with events = FunCall fun_call :: ctx.events; rest } - | BeginCall infos :: rest when is_subscope_call infos -> ( + | (BeginCall infos as e1) :: rest when is_subscope_call infos -> ( + Format.printf "Parsing6: %s\n" (raw_event_to_string e1); match infos with | [_; var_name; _] -> let body_ctx = parse_events { empty_ctx with rest } in @@ -477,7 +502,9 @@ module EventParser = struct rest = body_ctx.rest; } | _ -> failwith "unreachable due to the [is_subscope_call] test") - | EndCall _ :: rest -> { ctx with events = ctx.events |> List.rev; rest } + | (EndCall _ as e1) :: rest -> + Format.printf "Parsing7: %s\n" (raw_event_to_string e1); + { ctx with events = ctx.events |> List.rev; rest } | event :: _ -> failwith ("Unexpected event: " ^ raw_event_to_string event) and parse_fun_call events = match events with diff --git a/tests/test_scope/good/dune b/tests/test_scope/good/dune new file mode 100644 index 00000000..51d401d9 --- /dev/null +++ b/tests/test_scope/good/dune @@ -0,0 +1,10 @@ +(executable + (name test) + (libraries catala.runtime_ocaml) + (modules test scope_call3)) + +(rule + (target scope_call3.ml) + (deps scope_call3.catala_en) + (action + (run catala OCaml -t scope_call3.catala_en))) diff --git a/tests/test_scope/good/scope_call3.catala_en b/tests/test_scope/good/scope_call3.catala_en new file mode 100644 index 00000000..f3274c42 --- /dev/null +++ b/tests/test_scope/good/scope_call3.catala_en @@ -0,0 +1,78 @@ +```catala +declaration scope WholeComputation: + internal f content integer depends on integer + housing_computation scope HousingComputation + output result content integer + + +scope WholeComputation: + definition f of x equals housing_computation.f of x + definition result equals f of 1 + +declaration scope HousingComputation: + output f content integer depends on integer + + +scope HousingComputation: + definition f of x equals (output of RentComputation).f of x + +declaration scope RentComputation: + output f content integer depends on integer + +scope RentComputation: + definition f of x equals x + 1 +``` + +```catala-test-inline +$ catala Interpret -t -s WholeComputation +[LOG] → WholeComputation.housing_computation.HousingComputation +[LOG] ≔ HousingComputation.f: +[LOG] ← WholeComputation.housing_computation.HousingComputation +[LOG] ≔ WholeComputation.f: +[LOG] ☛ Definition applied: + ┌─⯈ tests/test_scope/good/scope_call3.catala_en:10.13-19: + └──┐ + 10 │ definition result equals f of 1 + │ ‾‾‾‾‾‾ + +[LOG] → WholeComputation.f +[LOG] ≔ WholeComputation.f.input: 1 +[LOG] ☛ Definition applied: + ┌─⯈ tests/test_scope/good/scope_call3.catala_en:9.13-14: + └─┐ + 9 │ definition f of x equals housing_computation.f of x + │ ‾ + +[LOG] → HousingComputation.f +[LOG] ≔ HousingComputation.f.input: 1 +[LOG] ☛ Definition applied: + ┌─⯈ tests/test_scope/good/scope_call3.catala_en:17.13-14: + └──┐ + 17 │ definition f of x equals (output of RentComputation).f of x + │ ‾ + +[LOG] → RentComputation.direct +[LOG] ≔ RentComputation.direct.input: RentComputation_in { } +[LOG] ≔ RentComputation.f: +[LOG] ☛ Definition applied: + ┌─⯈ tests/test_scope/good/scope_call3.catala_en:17.28-53: + └──┐ + 17 │ definition f of x equals (output of RentComputation).f of x + │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ + +[LOG] ≔ RentComputation.direct.output: RentComputation { "f"= λ (param: integer) → error_empty ⟨true ⊢ param +! 1⟩ } +[LOG] ← RentComputation.direct +[LOG] ☛ Definition applied: + ┌─⯈ tests/test_scope/good/scope_call3.catala_en:23.13-14: + └──┐ + 23 │ definition f of x equals x + 1 + │ ‾ + +[LOG] ≔ HousingComputation.f.output: 2 +[LOG] ← HousingComputation.f +[LOG] ≔ WholeComputation.f.output: 2 +[LOG] ← WholeComputation.f +[LOG] ≔ WholeComputation.result: 2 +[RESULT] Computation successful! Results: +[RESULT] result = 2 +``` diff --git a/tests/test_scope/good/test.ml b/tests/test_scope/good/test.ml new file mode 100644 index 00000000..0e925e1e --- /dev/null +++ b/tests/test_scope/good/test.ml @@ -0,0 +1,8 @@ +let _ = + Runtime_ocaml.Runtime.reset_log (); + let _result = Scope_call3.whole_computation () in + let log = Runtime_ocaml.Runtime.retrieve_log () in + Format.printf "\nLog length: %d\n" (List.length log); + let struct_log = Runtime_ocaml.Runtime.EventParser.parse_raw_events log in + Runtime_ocaml.Runtime.pp_events Format.std_formatter struct_log; + Format.printf "Finished!\n"