diff --git a/compiler/lcalc/monomorphize.ml b/compiler/lcalc/monomorphize.ml index 9c6eda89..80fb040f 100644 --- a/compiler/lcalc/monomorphize.ml +++ b/compiler/lcalc/monomorphize.ml @@ -78,7 +78,7 @@ let collect_monomorphized_instances (prg : typed program) : args; name = StructName.fresh [] - ( "tuple_" ^ string_of_int !option_instances_counter, + ( "tuple_" ^ string_of_int !tuple_instances_counter, Pos.no_pos ); }) acc.tuples; @@ -90,7 +90,7 @@ let collect_monomorphized_instances (prg : typed program) : { acc with arrays = - Type.Map.update t + Type.Map.update typ (fun monomorphized_name -> match monomorphized_name with | Some e -> Some e @@ -118,7 +118,7 @@ let collect_monomorphized_instances (prg : typed program) : { acc with options = - Type.Map.update t + Type.Map.update typ (fun monomorphized_name -> match monomorphized_name with | Some e -> Some e @@ -173,8 +173,9 @@ let rec monomorphize_typ (typ : typ) : typ = match Mark.remove typ with | TStruct _ | TEnum _ | TAny | TClosureEnv | TLit _ -> typ - | TArray t1 -> - TStruct (Type.Map.find t1 monomorphized_instances.arrays).name, Mark.get typ + | TArray _ -> + ( TStruct (Type.Map.find typ monomorphized_instances.arrays).name, + Mark.get typ ) | TDefault t1 -> TDefault (monomorphize_typ monomorphized_instances t1), Mark.get typ | TArrow (t1s, t2) -> @@ -185,8 +186,8 @@ let rec monomorphize_typ | TTuple _ -> ( TStruct (Type.Map.find typ monomorphized_instances.tuples).name, Mark.get typ ) - | TOption t1 -> - TEnum (Type.Map.find t1 monomorphized_instances.options).name, Mark.get typ + | TOption _ -> + TEnum (Type.Map.find typ monomorphized_instances.options).name, Mark.get typ let is_some c = EnumConstructor.equal Expr.some_constr c @@ -233,7 +234,12 @@ let rec monomorphize_expr field = fst (List.nth tuple_instance.fields index); } | EMatch { name; e; cases } when EnumName.equal name Expr.option_enum -> - let option_instance = Type.Map.find ty0 monomorphized_instances.options in + let opt_ty = + match e0 with EMatch { e; _ }, _ -> Expr.ty e | _ -> assert false + in + let option_instance = + Type.Map.find opt_ty monomorphized_instances.options + in EMatch { name = option_instance.name; @@ -247,11 +253,7 @@ let rec monomorphize_expr cases EnumConstructor.Map.empty; } | EInj { name; e; cons } when EnumName.equal name Expr.option_enum -> - let option_instance = - Type.Map.find - (match Mark.remove ty0 with TOption t -> t | _ -> assert false) - monomorphized_instances.options - in + let option_instance = Type.Map.find ty0 monomorphized_instances.options in EInj { name = option_instance.name; @@ -264,7 +266,7 @@ let rec monomorphize_expr let elt_ty = match Mark.remove ty0 with TArray t -> t | _ -> assert false in - let array_instance = Type.Map.find elt_ty monomorphized_instances.arrays in + let array_instance = Type.Map.find ty0 monomorphized_instances.arrays in EStruct { name = array_instance.name; diff --git a/compiler/scalc/to_c.ml b/compiler/scalc/to_c.ml index 72e18ad5..b7b4a890 100644 --- a/compiler/scalc/to_c.ml +++ b/compiler/scalc/to_c.ml @@ -313,8 +313,8 @@ let format_op (fmt : Format.formatter) (op : operator Mark.pos) : unit = | Reduce -> Format.pp_print_string fmt "catala_list_reduce" | Filter -> Format.pp_print_string fmt "catala_list_filter" | Fold -> Format.pp_print_string fmt "catala_list_fold_left" - | HandleExceptions | FromClosureEnv | ToClosureEnv | Map2 -> - failwith "unimplemented" + | HandleExceptions -> Format.pp_print_string fmt "catala_handle_exceptions" + | FromClosureEnv | ToClosureEnv | Map2 -> failwith "unimplemented" let _format_string_list (fmt : Format.formatter) (uids : string list) : unit = let sanitize_quotes = Re.compile (Re.char '"') in diff --git a/compiler/shared_ast/print.ml b/compiler/shared_ast/print.ml index f92b78a6..3a78aa08 100644 --- a/compiler/shared_ast/print.ml +++ b/compiler/shared_ast/print.ml @@ -142,7 +142,7 @@ let rec typ_gen mty)) def punctuation "]") | TOption t -> - Format.fprintf fmt "@[%a@ %a@]" base_type "eoption" (typ ~colors) t + Format.fprintf fmt "@[%a@ %a@]" base_type "option" (typ ~colors) t | TArrow ([t1], t2) -> Format.fprintf fmt "@[%a@ %a@ %a@]" (typ_with_parens ~colors) t1 op_style "→" (typ ~colors) t2 diff --git a/compiler/shared_ast/typing.ml b/compiler/shared_ast/typing.ml index 6ac79c5b..ab6bf8d6 100644 --- a/compiler/shared_ast/typing.ml +++ b/compiler/shared_ast/typing.ml @@ -345,10 +345,7 @@ let polymorphic_op_return_type | Log (PosRecordIfTrueBool, _), _ -> uf (TLit TBool) | Log _, [tau] -> tau | Length, _ -> uf (TLit TInt) - | HandleExceptions, [tau] -> - let t_inner = any () in - unify ctx e tau (uf (TArray t_inner)); - t_inner + | HandleExceptions, [_] -> any () | ToClosureEnv, _ -> uf TClosureEnv | FromClosureEnv, _ -> any () | _ -> Message.error ~pos "Mismatched operator arguments" diff --git a/tests/backends/output/simple.c b/tests/backends/output/simple.c index d68a1113..a90cc655 100644 --- a/tests/backends/output/simple.c +++ b/tests/backends/output/simple.c @@ -86,114 +86,116 @@ typedef struct array_1_struct { int length_field; } array_1_struct; -typedef struct tuple_0_struct { +typedef struct tuple_1_struct { option_1_enum (*elt_0_field)(void * /* closure_env */ arg_0_typ, void* /* unit */ arg_1_typ); void * /* closure_env */ elt_1_field; -} tuple_0_struct; +} tuple_1_struct; typedef struct baz_in_struct { - tuple_0_struct a_in_field; + tuple_1_struct a_in_field; } baz_in_struct; baz_struct baz_func(baz_in_struct baz_in) { - tuple_0_struct a; + tuple_1_struct a; a = baz_in.a_in_field; bar_enum temp_a; option_1_enum temp_a_1; - tuple_0_struct code_and_env; + tuple_1_struct code_and_env; code_and_env = a; option_1_enum (*code)(void * /* closure_env */ arg_0_typ, void* /* unit */ arg_1_typ); void * /* closure_env */ env; code = code_and_env.elt_0_field; env = code_and_env.elt_1_field; - option_1_enum exception_acc = {option_1_enum_none_1_cons, - {none_1_cons: NULL}}; - option_1_enum exception_current; - char exception_conflict = 0; - exception_current = code(env, NULL); - if (exception_current.code == option_1_enum_some_1_cons) { - if (exception_acc.code == option_1_enum_some_1_cons) { - exception_conflict = 1; - } else { - exception_acc = exception_current; - } - } - if (exception_conflict) { - catala_raise_fatal_error(catala_conflict, - "tests/backends/simple.catala_en", 11, 11, 11, 12); - } - if (exception_acc.code == option_1_enum_some_1_cons) { - temp_a_1 = exception_acc; - } else { - if (1 /* TRUE */) { - bar_enum temp_a_2; - option_1_enum temp_a_3; - option_1_enum temp_a_4; + array_1_struct temp_a_2; + temp_a_2.content_field = catala_malloc(sizeof(array_1_struct)); + temp_a_2.content_field[0] = code(env, NULL); + option_1_enum match_arg = catala_handle_exceptions(temp_a_2); + switch (match_arg.code) { + case option_1_enum_none_1_cons: if (1 /* TRUE */) { - bar_enum temp_a_5 = {bar_enum_no_cons, {no_cons: NULL}}; - option_1_enum temp_a_6 = {option_1_enum_some_1_cons, - {some_1_cons: temp_a_5}}; - temp_a_4 = temp_a_6; - } else { - temp_a_4.code = option_1_enum_none_1_cons; - temp_a_4.payload.none_1_cons = NULL; - } - option_1_enum exception_acc_1 = {option_1_enum_none_1_cons, - {none_1_cons: NULL}}; - option_1_enum exception_current_1; - char exception_conflict_1 = 0; - exception_current_1 = temp_a_4; - if (exception_current_1.code == option_1_enum_some_1_cons) { - if (exception_acc_1.code == option_1_enum_some_1_cons) { - exception_conflict_1 = 1; - } else { - exception_acc_1 = exception_current_1; + bar_enum temp_a_3; + option_1_enum temp_a_4; + option_1_enum temp_a_5; + array_1_struct temp_a_6; + temp_a_6.content_field = catala_malloc(sizeof(array_1_struct)); + + option_1_enum match_arg_1 = catala_handle_exceptions(temp_a_6); + switch (match_arg_1.code) { + case option_1_enum_none_1_cons: + if (1 /* TRUE */) { + bar_enum temp_a_7 = {bar_enum_no_cons, {no_cons: NULL}}; + option_1_enum temp_a_5 = {option_1_enum_some_1_cons, + {some_1_cons: temp_a_7}}; + + } else { + option_1_enum temp_a_5 = {option_1_enum_none_1_cons, + {none_1_cons: NULL}}; + + } + break; + case option_1_enum_some_1_cons: + bar_enum x = match_arg_1.payload.some_1_cons; + option_1_enum temp_a_5 = {option_1_enum_some_1_cons, + {some_1_cons: x}}; + break; } - } - if (exception_conflict_1) { - catala_raise_fatal_error(catala_conflict, - "tests/backends/simple.catala_en", 11, 11, 11, 12); - } - if (exception_acc_1.code == option_1_enum_some_1_cons) { - temp_a_3 = exception_acc_1; - } else { - if (0 /* FALSE */) { - option_1_enum temp_a_7 = {option_1_enum_none_1_cons, - {none_1_cons: NULL}}; - temp_a_3 = temp_a_7; - } else { - temp_a_3.code = option_1_enum_none_1_cons; - temp_a_3.payload.none_1_cons = NULL; + array_1_struct temp_a_8; + temp_a_8.content_field = catala_malloc(sizeof(array_1_struct)); + temp_a_8.content_field[0] = temp_a_5; + option_1_enum match_arg_2 = catala_handle_exceptions(temp_a_8); + switch (match_arg_2.code) { + case option_1_enum_none_1_cons: + if (0 /* FALSE */) { + option_1_enum temp_a_4 = {option_1_enum_none_1_cons, + {none_1_cons: NULL}}; + + } else { + option_1_enum temp_a_4 = {option_1_enum_none_1_cons, + {none_1_cons: NULL}}; + + } + break; + case option_1_enum_some_1_cons: + bar_enum x_1 = match_arg_2.payload.some_1_cons; + option_1_enum temp_a_4 = {option_1_enum_some_1_cons, + {some_1_cons: x_1}}; + break; } + option_1_enum match_arg_3 = temp_a_4; + switch (match_arg_3.code) { + case option_1_enum_none_1_cons: + catala_raise_fatal_error (catala_no_value, + "tests/backends/simple.catala_en", 11, 11, 11, 12); + break; + case option_1_enum_some_1_cons: + bar_enum arg = match_arg_3.payload.some_1_cons; + temp_a_3 = arg; + break; + } + option_1_enum temp_a_1 = {option_1_enum_some_1_cons, + {some_1_cons: temp_a_3}}; + + } else { + option_1_enum temp_a_1 = {option_1_enum_none_1_cons, + {none_1_cons: NULL}}; + } - option_1_enum match_arg = temp_a_3; - switch (match_arg.code) { - case option_1_enum_none_1_cons: - catala_raise_fatal_error (catala_no_value, - "tests/backends/simple.catala_en", 11, 11, 11, 12); - break; - case option_1_enum_some_1_cons: - bar_enum arg = match_arg.payload.some_1_cons; - temp_a_2 = arg; - break; - } - option_1_enum temp_a_8 = {option_1_enum_some_1_cons, - {some_1_cons: temp_a_2}}; - temp_a_1 = temp_a_8; - } else { - temp_a_1.code = option_1_enum_none_1_cons; - temp_a_1.payload.none_1_cons = NULL; - } + break; + case option_1_enum_some_1_cons: + bar_enum x_2 = match_arg.payload.some_1_cons; + option_1_enum temp_a_1 = {option_1_enum_some_1_cons, + {some_1_cons: x_2}}; + break; } - option_1_enum match_arg_1 = temp_a_1; - switch (match_arg_1.code) { + option_1_enum match_arg_4 = temp_a_1; + switch (match_arg_4.code) { case option_1_enum_none_1_cons: catala_raise_fatal_error (catala_no_value, "tests/backends/simple.catala_en", 11, 11, 11, 12); break; case option_1_enum_some_1_cons: - bar_enum arg_1 = match_arg_1.payload.some_1_cons; + bar_enum arg_1 = match_arg_4.payload.some_1_cons; temp_a = arg_1; break; } @@ -203,133 +205,143 @@ baz_struct baz_func(baz_in_struct baz_in) { option_2_enum temp_b_1; option_2_enum temp_b_2; option_2_enum temp_b_3; - char /* bool */ temp_b_4; - bar_enum match_arg_2 = a_1; - switch (match_arg_2.code) { - case bar_enum_no_cons: temp_b_4 = 1 /* TRUE */; break; - case bar_enum_yes_cons: - foo_struct dummy_var = match_arg_2.payload.yes_cons; - temp_b_4 = 0 /* FALSE */; + array_2_struct temp_b_4; + temp_b_4.content_field = catala_malloc(sizeof(array_2_struct)); + + option_2_enum match_arg_5 = catala_handle_exceptions(temp_b_4); + switch (match_arg_5.code) { + case option_2_enum_none_2_cons: + char /* bool */ temp_b_5; + bar_enum match_arg_6 = a_1; + switch (match_arg_6.code) { + case bar_enum_no_cons: temp_b_5 = 1 /* TRUE */; break; + case bar_enum_yes_cons: + foo_struct dummy_var = match_arg_6.payload.yes_cons; + temp_b_5 = 0 /* FALSE */; + break; + } + if (temp_b_5) { + option_2_enum temp_b_3 = {option_2_enum_some_2_cons, + {some_2_cons: 42.}}; + + } else { + option_2_enum temp_b_3 = {option_2_enum_none_2_cons, + {none_2_cons: NULL}}; + + } + break; + case option_2_enum_some_2_cons: + double x_3 = match_arg_5.payload.some_2_cons; + option_2_enum temp_b_3 = {option_2_enum_some_2_cons, + {some_2_cons: x_3}}; break; } - if (temp_b_4) { - option_2_enum temp_b_5 = {option_2_enum_some_2_cons, {some_2_cons: 42.}}; - temp_b_3 = temp_b_5; - } else { - temp_b_3.code = option_2_enum_none_2_cons; - temp_b_3.payload.none_2_cons = NULL; + array_2_struct temp_b_6; + temp_b_6.content_field = catala_malloc(sizeof(array_2_struct)); + temp_b_6.content_field[0] = temp_b_3; + option_2_enum match_arg_7 = catala_handle_exceptions(temp_b_6); + switch (match_arg_7.code) { + case option_2_enum_none_2_cons: + if (0 /* FALSE */) { + option_2_enum temp_b_2 = {option_2_enum_none_2_cons, + {none_2_cons: NULL}}; + + } else { + option_2_enum temp_b_2 = {option_2_enum_none_2_cons, + {none_2_cons: NULL}}; + + } + break; + case option_2_enum_some_2_cons: + double x_4 = match_arg_7.payload.some_2_cons; + option_2_enum temp_b_2 = {option_2_enum_some_2_cons, + {some_2_cons: x_4}}; + break; } - option_2_enum exception_acc_2 = {option_2_enum_none_2_cons, - {none_2_cons: NULL}}; - option_2_enum exception_current_2; - char exception_conflict_2 = 0; - exception_current_2 = temp_b_3; - if (exception_current_2.code == option_2_enum_some_2_cons) { - if (exception_acc_2.code == option_2_enum_some_2_cons) { - exception_conflict_2 = 1; - } else { - exception_acc_2 = exception_current_2; - } - } - if (exception_conflict_2) { - catala_raise_fatal_error(catala_conflict, - "tests/backends/simple.catala_en", 12, 10, 12, 11); - } - if (exception_acc_2.code == option_2_enum_some_2_cons) { - temp_b_2 = exception_acc_2; - } else { - if (0 /* FALSE */) { - option_2_enum temp_b_6 = {option_2_enum_none_2_cons, - {none_2_cons: NULL}}; - temp_b_2 = temp_b_6; - } else { - temp_b_2.code = option_2_enum_none_2_cons; - temp_b_2.payload.none_2_cons = NULL; - } - } - option_2_enum exception_acc_3 = {option_2_enum_none_2_cons, - {none_2_cons: NULL}}; - option_2_enum exception_current_3; - char exception_conflict_3 = 0; - exception_current_3 = temp_b_2; - if (exception_current_3.code == option_2_enum_some_2_cons) { - if (exception_acc_3.code == option_2_enum_some_2_cons) { - exception_conflict_3 = 1; - } else { - exception_acc_3 = exception_current_3; - } - } - if (exception_conflict_3) { - catala_raise_fatal_error(catala_conflict, - "tests/backends/simple.catala_en", 12, 10, 12, 11); - } - if (exception_acc_3.code == option_2_enum_some_2_cons) { - temp_b_1 = exception_acc_3; - } else { - if (1 /* TRUE */) { - option_2_enum temp_b_7; - option_2_enum temp_b_8; + array_2_struct temp_b_7; + temp_b_7.content_field = catala_malloc(sizeof(array_2_struct)); + temp_b_7.content_field[0] = temp_b_2; + option_2_enum match_arg_8 = catala_handle_exceptions(temp_b_7); + switch (match_arg_8.code) { + case option_2_enum_none_2_cons: if (1 /* TRUE */) { - double temp_b_9; - bar_enum match_arg_3 = a_1; - switch (match_arg_3.code) { - case bar_enum_no_cons: temp_b_9 = 0.; break; - case bar_enum_yes_cons: - foo_struct foo = match_arg_3.payload.yes_cons; - double temp_b_10; - if (foo.x_field) {temp_b_10 = 1.; } else {temp_b_10 = 0.; } - temp_b_9 = (foo.y_field + temp_b_10); + option_2_enum temp_b_8; + array_2_struct temp_b_9; + temp_b_9.content_field = catala_malloc(sizeof(array_2_struct)); + + option_2_enum match_arg_9 = catala_handle_exceptions(temp_b_9); + switch (match_arg_9.code) { + case option_2_enum_none_2_cons: + if (1 /* TRUE */) { + double temp_b_10; + bar_enum match_arg_10 = a_1; + switch (match_arg_10.code) { + case bar_enum_no_cons: temp_b_10 = 0.; break; + case bar_enum_yes_cons: + foo_struct foo = match_arg_10.payload.yes_cons; + double temp_b_11; + if (foo.x_field) {temp_b_11 = 1.; } else {temp_b_11 = 0.; } + temp_b_10 = (foo.y_field + temp_b_11); + break; + } + option_2_enum temp_b_8 = {option_2_enum_some_2_cons, + {some_2_cons: temp_b_10}}; + + } else { + option_2_enum temp_b_8 = {option_2_enum_none_2_cons, + {none_2_cons: NULL}}; + + } + break; + case option_2_enum_some_2_cons: + double x_5 = match_arg_9.payload.some_2_cons; + option_2_enum temp_b_8 = {option_2_enum_some_2_cons, + {some_2_cons: x_5}}; break; } - option_2_enum temp_b_11 = {option_2_enum_some_2_cons, - {some_2_cons: temp_b_9}}; - temp_b_8 = temp_b_11; - } else { - temp_b_8.code = option_2_enum_none_2_cons; - temp_b_8.payload.none_2_cons = NULL; - } - option_2_enum exception_acc_4 = {option_2_enum_none_2_cons, - {none_2_cons: NULL}}; - option_2_enum exception_current_4; - char exception_conflict_4 = 0; - exception_current_4 = temp_b_8; - if (exception_current_4.code == option_2_enum_some_2_cons) { - if (exception_acc_4.code == option_2_enum_some_2_cons) { - exception_conflict_4 = 1; - } else { - exception_acc_4 = exception_current_4; + array_2_struct temp_b_12; + temp_b_12.content_field = catala_malloc(sizeof(array_2_struct)); + temp_b_12.content_field[0] = temp_b_8; + option_2_enum match_arg_11 = catala_handle_exceptions(temp_b_12); + switch (match_arg_11.code) { + case option_2_enum_none_2_cons: + if (0 /* FALSE */) { + option_2_enum temp_b_1 = {option_2_enum_none_2_cons, + {none_2_cons: NULL}}; + + } else { + option_2_enum temp_b_1 = {option_2_enum_none_2_cons, + {none_2_cons: NULL}}; + + } + break; + case option_2_enum_some_2_cons: + double x_6 = match_arg_11.payload.some_2_cons; + option_2_enum temp_b_1 = {option_2_enum_some_2_cons, + {some_2_cons: x_6}}; + break; } - } - if (exception_conflict_4) { - catala_raise_fatal_error(catala_conflict, - "tests/backends/simple.catala_en", 12, 10, 12, 11); - } - if (exception_acc_4.code == option_2_enum_some_2_cons) { - temp_b_7 = exception_acc_4; + } else { - if (0 /* FALSE */) { - option_2_enum temp_b_12 = {option_2_enum_none_2_cons, - {none_2_cons: NULL}}; - temp_b_7 = temp_b_12; - } else { - temp_b_7.code = option_2_enum_none_2_cons; - temp_b_7.payload.none_2_cons = NULL; - } + option_2_enum temp_b_1 = {option_2_enum_none_2_cons, + {none_2_cons: NULL}}; + } - temp_b_1 = temp_b_7; - } else { - temp_b_1.code = option_2_enum_none_2_cons; - temp_b_1.payload.none_2_cons = NULL; - } + break; + case option_2_enum_some_2_cons: + double x_7 = match_arg_8.payload.some_2_cons; + option_2_enum temp_b_1 = {option_2_enum_some_2_cons, + {some_2_cons: x_7}}; + break; } - option_2_enum match_arg_4 = temp_b_1; - switch (match_arg_4.code) { + option_2_enum match_arg_12 = temp_b_1; + switch (match_arg_12.code) { case option_2_enum_none_2_cons: catala_raise_fatal_error (catala_no_value, "tests/backends/simple.catala_en", 12, 10, 12, 11); break; case option_2_enum_some_2_cons: - double arg_2 = match_arg_4.payload.some_2_cons; + double arg_2 = match_arg_12.payload.some_2_cons; temp_b = arg_2; break; } @@ -338,54 +350,62 @@ baz_struct baz_func(baz_in_struct baz_in) { array_3_struct temp_c; option_3_enum temp_c_1; option_3_enum temp_c_2; - if (1 /* TRUE */) { - array_3_struct temp_c_3; - temp_c_3.content_field = catala_malloc(sizeof(array_3_struct)); - temp_c_3.content_field[0] = b; - temp_c_3.content_field[1] = b; - option_3_enum temp_c_4 = {option_3_enum_some_3_cons, - {some_3_cons: temp_c_3}}; - temp_c_2 = temp_c_4; - } else { - temp_c_2.code = option_3_enum_none_3_cons; - temp_c_2.payload.none_3_cons = NULL; + array_4_struct temp_c_3; + temp_c_3.content_field = catala_malloc(sizeof(array_4_struct)); + + option_3_enum match_arg_13 = catala_handle_exceptions(temp_c_3); + switch (match_arg_13.code) { + case option_3_enum_none_3_cons: + if (1 /* TRUE */) { + array_3_struct temp_c_4; + temp_c_4.content_field = catala_malloc(sizeof(array_3_struct)); + temp_c_4.content_field[0] = b; + temp_c_4.content_field[1] = b; + option_3_enum temp_c_2 = {option_3_enum_some_3_cons, + {some_3_cons: temp_c_4}}; + + } else { + option_3_enum temp_c_2 = {option_3_enum_none_3_cons, + {none_3_cons: NULL}}; + + } + break; + case option_3_enum_some_3_cons: + array_3_struct x_8 = match_arg_13.payload.some_3_cons; + option_3_enum temp_c_2 = {option_3_enum_some_3_cons, + {some_3_cons: x_8}}; + break; } - option_3_enum exception_acc_5 = {option_3_enum_none_3_cons, - {none_3_cons: NULL}}; - option_3_enum exception_current_5; - char exception_conflict_5 = 0; - exception_current_5 = temp_c_2; - if (exception_current_5.code == option_3_enum_some_3_cons) { - if (exception_acc_5.code == option_3_enum_some_3_cons) { - exception_conflict_5 = 1; - } else { - exception_acc_5 = exception_current_5; - } + array_4_struct temp_c_5; + temp_c_5.content_field = catala_malloc(sizeof(array_4_struct)); + temp_c_5.content_field[0] = temp_c_2; + option_3_enum match_arg_14 = catala_handle_exceptions(temp_c_5); + switch (match_arg_14.code) { + case option_3_enum_none_3_cons: + if (0 /* FALSE */) { + option_3_enum temp_c_1 = {option_3_enum_none_3_cons, + {none_3_cons: NULL}}; + + } else { + option_3_enum temp_c_1 = {option_3_enum_none_3_cons, + {none_3_cons: NULL}}; + + } + break; + case option_3_enum_some_3_cons: + array_3_struct x_9 = match_arg_14.payload.some_3_cons; + option_3_enum temp_c_1 = {option_3_enum_some_3_cons, + {some_3_cons: x_9}}; + break; } - if (exception_conflict_5) { - catala_raise_fatal_error(catala_conflict, - "tests/backends/simple.catala_en", 13, 10, 13, 11); - } - if (exception_acc_5.code == option_3_enum_some_3_cons) { - temp_c_1 = exception_acc_5; - } else { - if (0 /* FALSE */) { - option_3_enum temp_c_5 = {option_3_enum_none_3_cons, - {none_3_cons: NULL}}; - temp_c_1 = temp_c_5; - } else { - temp_c_1.code = option_3_enum_none_3_cons; - temp_c_1.payload.none_3_cons = NULL; - } - } - option_3_enum match_arg_5 = temp_c_1; - switch (match_arg_5.code) { + option_3_enum match_arg_15 = temp_c_1; + switch (match_arg_15.code) { case option_3_enum_none_3_cons: catala_raise_fatal_error (catala_no_value, "tests/backends/simple.catala_en", 13, 10, 13, 11); break; case option_3_enum_some_3_cons: - array_3_struct arg_3 = match_arg_5.payload.some_3_cons; + array_3_struct arg_3 = match_arg_15.payload.some_3_cons; temp_c = arg_3; break; } diff --git a/tests/func/good/scope_call_func_struct_closure.catala_en b/tests/func/good/scope_call_func_struct_closure.catala_en index e77a00b7..67619876 100644 --- a/tests/func/good/scope_call_func_struct_closure.catala_en +++ b/tests/func/good/scope_call_func_struct_closure.catala_en @@ -70,7 +70,7 @@ type SubFoo2 = { x1: integer; y: ((closure_env, integer) → integer, closure_env); } -type Foo_in = { b_in: ((closure_env, unit) → eoption bool, closure_env); } +type Foo_in = { b_in: ((closure_env, unit) → option bool, closure_env); } type Foo = { z: integer; } let topval closure_y1 : (closure_env, integer) → integer = @@ -118,11 +118,10 @@ let topval closure_r1 : (closure_env, integer) → integer = in code_and_env.0 code_and_env.1 param0 let scope Foo - (Foo_in: - Foo_in {b_in: ((closure_env, unit) → eoption bool, closure_env)}) + (Foo_in: Foo_in {b_in: ((closure_env, unit) → option bool, closure_env)}) : Foo {z: integer} = - let get b : ((closure_env, unit) → eoption bool, closure_env) = + let get b : ((closure_env, unit) → option bool, closure_env) = Foo_in.b_in in let set b : bool = diff --git a/tests/monomorphisation/context_var.catala_en b/tests/monomorphisation/context_var.catala_en new file mode 100644 index 00000000..02ea2fe9 --- /dev/null +++ b/tests/monomorphisation/context_var.catala_en @@ -0,0 +1,111 @@ +## Testing monomorphisation on context variables + +```catala +declaration scope TestXor: + context output t content boolean + +scope TestXor: + definition t equals true +``` + +```catala-test-inline +$ catala lcalc --monomorphize-types +type option_1 = | None_1 of unit | Some_1 of bool + +type TestXor_in = { t_in: unit → option_1[None_1: unit | Some_1: bool]; } +type TestXor = { t: bool; } +type array_1 = { + content: list of option_1[None_1: unit | Some_1: bool]; + length: integer; +} + +let scope TestXor + (TestXor_in: + TestXor_in {t_in: unit → option_1[None_1: unit | Some_1: bool]}) + : TestXor {t: bool} + = + let get t : unit → option_1[None_1: unit | Some_1: bool] = + TestXor_in.t_in + in + let set t : bool = + match + (match + (handle_exceptions { array_1 content = [t ()]; length = 1; }) + with + | None_1 → + if true then + Some_1 + (match + (match + (handle_exceptions + { array_1 + content = + [ + match + (handle_exceptions + { array_1 content = []; length = 0; }) + with + | None_1 → + if true then Some_1 true else None_1 () + | Some_1 x → Some_1 x + ]; + length = 1; + }) + with + | None_1 → if false then None_1 () else None_1 () + | Some_1 x → Some_1 x) + with + | None_1 → error NoValue + | Some_1 arg → arg) + else None_1 () + | Some_1 x → Some_1 x) + with + | None_1 → error NoValue + | Some_1 arg → arg + in + return { TestXor t = t; } + +``` + +```catala +declaration scope TestXor2: + t scope TestXor + output o content boolean + +scope TestXor2: + definition o equals t.t +``` + +```catala-test-inline +$ catala lcalc --monomorphize-types -s TestXor2 +let scope TestXor2 (TestXor2_in: TestXor2_in): TestXor2 {o: bool} = + let set t : TestXor {t: bool} = + let result : TestXor = TestXor { TestXor_in t_in = λ () → None_1 (); } in + let result1 : TestXor = { TestXor t = result.t; } in + if true then result1 else result1 + in + let set o : bool = + match + (match + (handle_exceptions + { array_1 + content = + [ + match + (handle_exceptions { array_1 content = []; length = 0; }) + with + | None_1 → if true then Some_1 t.t else None_1 () + | Some_1 x → Some_1 x + ]; + length = 1; + }) + with + | None_1 → if false then None_1 () else None_1 () + | Some_1 x → Some_1 x) + with + | None_1 → error NoValue + | Some_1 arg → arg + in + return { TestXor2 o = o; } +``` + diff --git a/tests/name_resolution/good/toplevel_defs.catala_en b/tests/name_resolution/good/toplevel_defs.catala_en index 07bf432b..0ba58d25 100644 --- a/tests/name_resolution/good/toplevel_defs.catala_en +++ b/tests/name_resolution/good/toplevel_defs.catala_en @@ -126,8 +126,8 @@ let glob2_9 = A {"y": glob1_2 >= 30., "z": 123. * 17.} let S2_5 (S2_in_10: S2_in) = decl temp_a_12 : decimal; - decl temp_a_13 : eoption decimal; - decl temp_a_14 : eoption decimal; + decl temp_a_13 : option decimal; + decl temp_a_14 : option decimal; switch handle_exceptions []: | ENone __15 → if true: @@ -155,8 +155,8 @@ let S2_5 (S2_in_10: S2_in) = let S3_6 (S3_in_21: S3_in) = decl temp_a_23 : decimal; - decl temp_a_24 : eoption decimal; - decl temp_a_25 : eoption decimal; + decl temp_a_24 : option decimal; + decl temp_a_25 : option decimal; switch handle_exceptions []: | ENone __26 → if true: @@ -184,8 +184,8 @@ let S3_6 (S3_in_21: S3_in) = let S4_7 (S4_in_32: S4_in) = decl temp_a_34 : decimal; - decl temp_a_35 : eoption decimal; - decl temp_a_36 : eoption decimal; + decl temp_a_35 : option decimal; + decl temp_a_36 : option decimal; switch handle_exceptions []: | ENone __37 → if true: @@ -213,8 +213,8 @@ let S4_7 (S4_in_32: S4_in) = let S_8 (S_in_43: S_in) = decl temp_a_55 : decimal; - decl temp_a_56 : eoption decimal; - decl temp_a_57 : eoption decimal; + decl temp_a_56 : option decimal; + decl temp_a_57 : option decimal; switch handle_exceptions []: | ENone __58 → if true: @@ -239,8 +239,8 @@ let S_8 (S_in_43: S_in) = decl a_44 : decimal; a_44 = temp_a_55; decl temp_b_46 : A {y: bool; z: decimal}; - decl temp_b_47 : eoption A {y: bool; z: decimal}; - decl temp_b_48 : eoption A {y: bool; z: decimal}; + decl temp_b_47 : option A {y: bool; z: decimal}; + decl temp_b_48 : option A {y: bool; z: decimal}; switch handle_exceptions []: | ENone __49 → if true: