mirror of
https://github.com/CatalaLang/catala.git
synced 2024-11-09 22:16:10 +03:00
Managed to find a MWE of the bug
This commit is contained in:
Denis Merigoux
parent
9d619a26ba
commit
c723249337
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
10
tests/test_scope/good/dune
Normal file
10
tests/test_scope/good/dune
Normal file
@ -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)))
|
||||
78
tests/test_scope/good/scope_call3.catala_en
Normal file
78
tests/test_scope/good/scope_call3.catala_en
Normal file
@ -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: <function>
|
||||
[LOG] ← WholeComputation.housing_computation.HousingComputation
|
||||
[LOG] ≔ WholeComputation.f: <function>
|
||||
[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: <function>
|
||||
[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
|
||||
```
|
||||
8
tests/test_scope/good/test.ml
Normal file
8
tests/test_scope/good/test.ml
Normal file
@ -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"
|
||||
Loading…
Reference in New Issue
Block a user