diff --git a/compiler/catala_utils/cli.ml b/compiler/catala_utils/cli.ml index 6932127e..dc572894 100644 --- a/compiler/catala_utils/cli.ml +++ b/compiler/catala_utils/cli.ml @@ -20,7 +20,6 @@ type backend_lang = En | Fr | Pl type when_enum = Auto | Always | Never type message_format_enum = Human | GNU -type compilation_method = Expression | Statement type input_file = FileName of string | Contents of string (** Associates a {!type: Cli.backend_lang} with its string represtation. *) @@ -31,7 +30,6 @@ let language_code = fun l -> List.assoc l rl let message_format_opt = ["human", Human; "gnu", GNU] -let compilation_method_opt = ["expression", Expression; "statement", Statement] type options = { mutable input_file : input_file; @@ -319,15 +317,6 @@ module Flags = struct "Disables the search for counterexamples. Useful when you want a \ deterministic output from the Catala compiler, since provers can \ have some randomness in them." - - let scalc_try_with_compilation = - value - & opt (enum compilation_method_opt) Statement - & info - ["scalc_try_with_compilation"] - ~doc: - "How should try ... with ... constructs be compiled from Lcalc to \ - Scalc ? Choice is between $(i,expression) or $(i,statement)." end let version = "0.8.0" diff --git a/compiler/catala_utils/cli.mli b/compiler/catala_utils/cli.mli index 0811fd67..141bc8cf 100644 --- a/compiler/catala_utils/cli.mli +++ b/compiler/catala_utils/cli.mli @@ -24,11 +24,6 @@ type message_format_enum = | Human | GNU (** Format of error and warning messages output by the compiler. *) -type compilation_method = - | Expression - | Statement - (** Whether to compile something as an expression or a statement *) - type input_file = FileName of string | Contents of string val languages : (string * backend_lang) list @@ -104,7 +99,6 @@ module Flags : sig val closure_conversion : bool Term.t val link_modules : string list Term.t val disable_counterexamples : bool Term.t - val scalc_try_with_compilation : compilation_method Term.t end (** {2 Command-line application} *) diff --git a/compiler/driver.ml b/compiler/driver.ml index 762b6c02..73a3f961 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -190,8 +190,7 @@ module Passes = struct ~optimize ~check_invariants ~avoid_exceptions - ~closure_conversion - ~scalc_try_with_compilation : + ~closure_conversion : Scalc.Ast.program * Desugared.Name_resolution.context * Scopelang.Dependency.TVertex.t list = @@ -200,15 +199,7 @@ module Passes = struct ~closure_conversion in Message.emit_debug "Compiling program into statement calculus..."; - ( Scalc.From_lcalc.translate_program prg - { - try_catch_type = - (match scalc_try_with_compilation with - | Cli.Expression -> Scalc.From_lcalc.Expression - | Cli.Statement -> Scalc.From_lcalc.Statement); - }, - ctx, - type_ordering ) + Scalc.From_lcalc.translate_program prg, ctx, type_ordering end module Commands = struct @@ -716,11 +707,10 @@ module Commands = struct check_invariants avoid_exceptions closure_conversion - ex_scope_opt - scalc_try_with_compilation = + ex_scope_opt = let prg, ctx, _ = Passes.scalc options ~link_modules ~optimize ~check_invariants - ~avoid_exceptions ~closure_conversion ~scalc_try_with_compilation + ~avoid_exceptions ~closure_conversion in let _output_file, with_output = get_output_format options output in with_output @@ -754,8 +744,7 @@ module Commands = struct $ Cli.Flags.check_invariants $ Cli.Flags.avoid_exceptions $ Cli.Flags.closure_conversion - $ Cli.Flags.ex_scope_opt - $ Cli.Flags.scalc_try_with_compilation) + $ Cli.Flags.ex_scope_opt) let python options @@ -768,8 +757,8 @@ module Commands = struct let prg, _, type_ordering = Passes.scalc options ~link_modules ~optimize ~check_invariants ~avoid_exceptions ~closure_conversion - ~scalc_try_with_compilation:Statement in + let output_file, with_output = get_output_format options ~ext:".py" output in @@ -798,8 +787,8 @@ module Commands = struct let prg, _, type_ordering = Passes.scalc options ~link_modules ~optimize ~check_invariants ~avoid_exceptions:false ~closure_conversion - ~scalc_try_with_compilation:Expression in + let output_file, with_output = get_output_format options ~ext:".r" output in Message.emit_debug "Compiling program into R..."; Message.emit_debug "Writing to %s..." diff --git a/compiler/driver.mli b/compiler/driver.mli index a1239afb..b5e9c2b1 100644 --- a/compiler/driver.mli +++ b/compiler/driver.mli @@ -66,7 +66,6 @@ module Passes : sig check_invariants:bool -> avoid_exceptions:bool -> closure_conversion:bool -> - scalc_try_with_compilation:Cli.compilation_method -> Scalc.Ast.program * Desugared.Name_resolution.context * Scopelang.Dependency.TVertex.t list diff --git a/compiler/plugins/python.ml b/compiler/plugins/python.ml index b249458b..4c15aacb 100644 --- a/compiler/plugins/python.ml +++ b/compiler/plugins/python.ml @@ -34,8 +34,8 @@ let run let prg, _, type_ordering = Driver.Passes.scalc options ~link_modules ~optimize ~check_invariants ~avoid_exceptions ~closure_conversion - ~scalc_try_with_compilation:Statement in + let output_file, with_output = get_output_format options ~ext:".py" output in Message.emit_debug "Compiling program into Python..."; Message.emit_debug "Writing to %s..." diff --git a/compiler/scalc/from_lcalc.ml b/compiler/scalc/from_lcalc.ml index be2351b5..86f6506e 100644 --- a/compiler/scalc/from_lcalc.ml +++ b/compiler/scalc/from_lcalc.ml @@ -20,11 +20,7 @@ module A = Ast module L = Lcalc.Ast module D = Dcalc.Ast -type compilation_type = Expression | Statement -type compilation_options = { try_catch_type : compilation_type } - type 'm ctxt = { - compilation_options : compilation_options; func_dict : ('m L.expr, A.FuncName.t) Var.Map.t; decl_ctx : decl_ctx; var_dict : ('m L.expr, A.VarName.t) Var.Map.t; @@ -273,7 +269,6 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block = ]) let rec translate_scope_body_expr - (options : compilation_options) (scope_name : ScopeName.t) (decl_ctx : decl_ctx) (var_dict : ('m L.expr, A.VarName.t) Var.Map.t) @@ -284,7 +279,6 @@ let rec translate_scope_body_expr let block, new_e = translate_expr { - compilation_options = options; decl_ctx; func_dict; var_dict; @@ -304,7 +298,6 @@ let rec translate_scope_body_expr | Assertion -> translate_statements { - compilation_options = options; decl_ctx; func_dict; var_dict; @@ -316,7 +309,6 @@ let rec translate_scope_body_expr let let_expr_stmts, new_let_expr = translate_expr { - compilation_options = options; decl_ctx; func_dict; var_dict; @@ -333,11 +325,10 @@ let rec translate_scope_body_expr ( A.SLocalDef ((let_var_id, scope_let.scope_let_pos), new_let_expr), scope_let.scope_let_pos ); ]) - @ translate_scope_body_expr options scope_name decl_ctx new_var_dict - func_dict scope_let_next + @ translate_scope_body_expr scope_name decl_ctx new_var_dict func_dict + scope_let_next -let translate_program (p : 'm L.program) (options : compilation_options) : - A.program = +let translate_program (p : 'm L.program) : A.program = let _, _, rev_items = Scope.fold_left ~f:(fun (func_dict, var_dict, rev_items) code_item var -> @@ -354,8 +345,8 @@ let translate_program (p : 'm L.program) (options : compilation_options) : Var.Map.add scope_input_var scope_input_var_id var_dict in let new_scope_body = - translate_scope_body_expr options name p.decl_ctx var_dict_local - func_dict scope_body_expr + translate_scope_body_expr name p.decl_ctx var_dict_local func_dict + scope_body_expr in let func_id = A.FuncName.fresh (Bindlib.name_of var, Pos.no_pos) in ( Var.Map.add var func_id func_dict, @@ -390,7 +381,6 @@ let translate_program (p : 'm L.program) (options : compilation_options) : let block, expr = let ctxt = { - compilation_options = options; func_dict; decl_ctx = p.decl_ctx; var_dict = @@ -420,7 +410,6 @@ let translate_program (p : 'm L.program) (options : compilation_options) : let block, expr = let ctxt = { - compilation_options = options; func_dict; decl_ctx = p.decl_ctx; var_dict; diff --git a/compiler/scalc/from_lcalc.mli b/compiler/scalc/from_lcalc.mli index 89474030..f589cd25 100644 --- a/compiler/scalc/from_lcalc.mli +++ b/compiler/scalc/from_lcalc.mli @@ -16,8 +16,4 @@ open Shared_ast -type compilation_type = Expression | Statement -type compilation_options = { try_catch_type : compilation_type } - -val translate_program : - untyped Lcalc.Ast.program -> compilation_options -> Ast.program +val translate_program : untyped Lcalc.Ast.program -> Ast.program diff --git a/compiler/scalc/to_r.ml b/compiler/scalc/to_r.ml index c2d99efd..aa1dc6d7 100644 --- a/compiler/scalc/to_r.ml +++ b/compiler/scalc/to_r.ml @@ -26,9 +26,13 @@ let format_lit (fmt : Format.formatter) (l : lit Mark.pos) : unit = | LBool true -> Format.pp_print_string fmt "TRUE" | LBool false -> Format.pp_print_string fmt "FALSE" | LInt i -> - Format.fprintf fmt "catala_integer_from_string(\"%s\")" - (Runtime.integer_to_string i) - | LUnit -> Format.pp_print_string fmt "catala_unit()" + if Z.fits_nativeint i then + Format.fprintf fmt "catala_integer_from_numeric(%s)" + (Runtime.integer_to_string i) + else + Format.fprintf fmt "catala_integer_from_string(\"%s\")" + (Runtime.integer_to_string i) + | LUnit -> Format.pp_print_string fmt "catala_unit(v=0)" | LRat i -> Format.fprintf fmt "catala_decimal_from_string(\"%a\")" Print.lit (LRat i) | LMoney e -> @@ -93,15 +97,6 @@ let format_op (fmt : Format.formatter) (op : operator Mark.pos) : unit = | HandleDefaultOpt -> Format.pp_print_string fmt "handle_default_opt" | FromClosureEnv | ToClosureEnv -> failwith "unimplemented" -let format_uid_list (fmt : Format.formatter) (uids : Uid.MarkedString.info list) - : unit = - Format.fprintf fmt "[%a]" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") - (fun fmt info -> - Format.fprintf fmt "\"%a\"" Uid.MarkedString.format info)) - uids - let format_string_list (fmt : Format.formatter) (uids : string list) : unit = let sanitize_quotes = Re.compile (Re.char '"') in Format.fprintf fmt "c(%a)" @@ -167,18 +162,19 @@ let rec format_typ (fmt : Format.formatter) (typ : typ) : unit = ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@;") format_typ) ts - | TStruct s -> Format.fprintf fmt "\"catala_class_%a\"" format_struct_name s + | TStruct s -> Format.fprintf fmt "\"catala_struct_%a\"" format_struct_name s | TOption some_typ -> (* We loose track of optional value as they're crammed into NULL *) format_typ fmt some_typ | TEnum e -> Format.fprintf fmt "\"catala_enum_%a\"" format_enum_name e - | TArrow (_t1, _t2) -> - Message.raise_internal_error "This type should not be printed out in R: %a" - Print.typ_debug typ + | TArrow (t1, t2) -> + Format.fprintf fmt "\"function\" # %a -> %a@\n" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ") + format_typ) + t1 format_typ t2 | TArray t1 -> Format.fprintf fmt "\"list\" # array(%a)@\n" format_typ t1 - | TAny -> - Message.raise_internal_error "This type should not be printed out in R: %a" - Print.typ_debug typ + | TAny -> Format.fprintf fmt "\"ANY\"" | TClosureEnv -> failwith "unimplemented!" let format_name_cleaned (fmt : Format.formatter) (s : string) : unit = @@ -275,7 +271,7 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) : | EVar v -> format_var fmt v | EFunc f -> format_func_name fmt f | EStruct (es, s) -> - Format.fprintf fmt "%a(%a)" format_struct_name s + Format.fprintf fmt "catala_struct_%a(%a)" format_struct_name s (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") (fun fmt (e, (struct_field, _)) -> @@ -289,15 +285,15 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) : | EInj (_, cons, e_name) when EnumName.equal e_name Expr.option_enum && EnumConstructor.equal cons Expr.none_constr -> - (* We translate the option type with an overloading by Python's [None] *) + (* We translate the option type with an overloading by R's [NULL] *) Format.fprintf fmt "NULL" | EInj (e, cons, e_name) when EnumName.equal e_name Expr.option_enum && EnumConstructor.equal cons Expr.some_constr -> - (* We translate the option type with an overloading by Python's [None] *) + (* We translate the option type with an overloading by R's [NULL] *) format_expression ctx fmt e | EInj (e, cons, enum_name) -> - Format.fprintf fmt "%a(%a_Code.%a,@ %a)" format_enum_name enum_name + Format.fprintf fmt "catala_enum_%a(code = \"%a\",@ value = %a)" format_enum_name enum_name format_enum_cons_name cons (format_expression ctx) e | EArray es -> @@ -313,33 +309,6 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) : | EApp ((EOp op, _), [arg1; arg2]) -> Format.fprintf fmt "(%a %a@ %a)" (format_expression ctx) arg1 format_op (op, Pos.no_pos) (format_expression ctx) arg2 - | EApp ((EApp ((EOp (Log (BeginCall, info)), _), [f]), _), [arg]) - when Cli.globals.trace -> - Format.fprintf fmt "log_begin_call(%a,@ %a,@ %a)" format_uid_list info - (format_expression ctx) f (format_expression ctx) arg - | EApp ((EOp (Log (VarDef var_def_info, info)), _), [arg1]) - when Cli.globals.trace -> - Format.fprintf fmt - "log_variable_definition(%a,@ LogIO(io_input=%s,@ io_output=%b),@ %a)" - format_uid_list info - (match var_def_info.log_io_input with - | Runtime.NoInput -> "NoInput" - | Runtime.OnlyInput -> "OnlyInput" - | Runtime.Reentrant -> "Reentrant") - var_def_info.log_io_output (format_expression ctx) arg1 - | EApp ((EOp (Log (PosRecordIfTrueBool, _)), pos), [arg1]) - when Cli.globals.trace -> - Format.fprintf fmt - "log_decision_taken(catala_position(filename=\"%s\",@ start_line=%d,@ \ - start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)" - (Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos) - (Pos.get_end_line pos) (Pos.get_end_column pos) format_string_list - (Pos.get_law_info pos) (format_expression ctx) arg1 - | EApp ((EOp (Log (EndCall, info)), _), [arg1]) when Cli.globals.trace -> - Format.fprintf fmt "log_end_call(%a,@ %a)" format_uid_list info - (format_expression ctx) arg1 - | EApp ((EOp (Log _), _), [arg1]) -> - Format.fprintf fmt "%a" (format_expression ctx) arg1 | EApp ((EOp Not, _), [arg1]) -> Format.fprintf fmt "%a %a" format_op (Not, Pos.no_pos) (format_expression ctx) arg1 @@ -427,12 +396,13 @@ let rec format_statement (* We translate the option type with an overloading by Python's [None] *) let tmp_var = VarName.fresh ("perhaps_none_arg", Pos.no_pos) in Format.fprintf fmt - "%a = %a@\n\ - @[if %a is None:@\n\ + "%a <- %a@\n\ + @[if (is.null(%a)) {@\n\ %a@]@\n\ - @[else:@\n\ + @[} else {@\n\ %a = %a@\n\ - %a@]" + %a@]@\n\ + }" format_var tmp_var (format_expression ctx) e1 format_var tmp_var (format_block ctx) case_none format_var case_some_var format_var tmp_var (format_block ctx) case_some @@ -444,15 +414,14 @@ let rec format_statement (EnumConstructor.Map.bindings (EnumName.Map.find e_name ctx.ctx_enums)) in let tmp_var = VarName.fresh ("match_arg", Pos.no_pos) in - Format.fprintf fmt "%a = %a@\n@[if %a@]" format_var tmp_var + Format.fprintf fmt "%a <- %a@\n@[if %a@]@\n}" format_var tmp_var (format_expression ctx) e1 (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "@]@\n@[elif ") + ~pp_sep:(fun fmt () -> Format.fprintf fmt "@]@\n@[} else if ") (fun fmt (case_block, payload_var, cons_name) -> - Format.fprintf fmt "%a.code == %a_Code.%a:@\n%a = %a.value@\n%a" - format_var tmp_var format_enum_name e_name format_enum_cons_name - cons_name format_var payload_var format_var tmp_var - (format_block ctx) case_block)) + Format.fprintf fmt "(%a$code == \"%a\") {@\n%a <- %a$value@\n%a" + format_var tmp_var format_enum_cons_name cons_name format_var + payload_var format_var tmp_var (format_block ctx) case_block)) cases | SReturn e1 -> Format.fprintf fmt "@[return(%a)@]" (format_expression ctx) @@ -460,10 +429,11 @@ let rec format_statement | SAssert e1 -> let pos = Mark.get s in Format.fprintf fmt - "@[if not (%a):@\n\ - raise AssertionFailure(@[catala_position(@[if (not (%a)) {@\n\ + stop(catala_assertion_failure(@[catala_position(@[filename=\"%s\",@ start_line=%d,@ start_column=%d,@ end_line=%d,@ \ - end_column=%d,@ law_headings=@[%a@])@])@]@]" + end_column=%d,@ law_headings=@[%a@])@])@]@]@\n\ + }" (format_expression ctx) (e1, Mark.get s) (Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos) @@ -484,21 +454,10 @@ let format_ctx (ctx : decl_ctx) : unit = let format_struct_decl fmt (struct_name, struct_fields) = let fields = StructField.Map.bindings struct_fields in - let non_func_fields = - List.filter - (fun (_, t) -> match Mark.remove t with TArrow _ -> false | _ -> true) - fields - in - let func_fields = - List.filter - (fun (_, t) -> match Mark.remove t with TArrow _ -> true | _ -> false) - fields - in Format.fprintf fmt "@[catala_struct_%a <- setRefClass(@,\ \"catala_struct_%a\",@;\ - fields = list@[(%a)@],@,\ - methods = list@[(%a)@]@,\ + fields = list@[(%a)@]@\n\ )@]" format_struct_name struct_name format_struct_name struct_name (Format.pp_print_list @@ -506,14 +465,7 @@ let format_ctx (fun fmt (struct_field, typ) -> Format.fprintf fmt "%a = %a" format_struct_field_name struct_field format_typ typ)) - non_func_fields - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@;") - (fun fmt (struct_field, typ) -> - Format.fprintf fmt - "%a = # %a@\nfunction () @[{@;stop(\"uninitialized\")@;}@]" - format_struct_field_name struct_field Print.typ_debug typ)) - func_fields + fields in let format_enum_decl fmt (enum_name, enum_cons) = if EnumConstructor.Map.is_empty enum_cons then diff --git a/runner.r b/runner.r index f173eed4..108aceba 100644 --- a/runner.r +++ b/runner.r @@ -1,3 +1,4 @@ source("test.r") - -foo(catala_struct_FooIn(x_in = catala_integer_from_numeric(1))) +v <- Map(function(x) { + foo(catala_struct_FooIn(x_in = catala_integer_from_numeric(x))) +}, c(1:10000)) diff --git a/runtimes/r/runtime.R b/runtimes/r/runtime.R index 2115ba30..90449212 100644 --- a/runtimes/r/runtime.R +++ b/runtimes/r/runtime.R @@ -7,10 +7,16 @@ catala_integer <- setClass( "catala_integer", representation(v = "bigz"), ) -setMethod("Ops", "catala_integer", function(e1, e2) { +setMethod("Arith", "catala_integer", function(e1, e2) { v <- callGeneric(e1@v, e2@v) new("catala_integer", v = v) }) +setMethod("-", c("catala_integer", "missing"), function(e1) { + catala_integer(v = -e1@v) +}) +setMethod("Compare", "catala_integer", function(e1, e2) { + callGeneric(e1@v, e2@v) +}) ################ Decimals ################# @@ -18,10 +24,16 @@ catala_decimal <- setClass( "catala_decimal", representation(v = "bigq"), ) -setMethod("Ops", "catala_decimal", function(e1, e2) { +setMethod("Arith", "catala_decimal", function(e1, e2) { v <- callGeneric(e1@v, e2@v) new("catala_decimal", v = v) }) +setMethod("-", c("catala_decimal", "missing"), function(e1) { + catala_decimal(v = -e1@v) +}) +setMethod("Compare", "catala_decimal", function(e1, e2) { + callGeneric(e1@v, e2@v) +}) ################ Money ################# catala_money <- setClass( @@ -34,6 +46,9 @@ setMethod("+", c("catala_money", "catala_money"), function(e1, e2) { setMethod("-", c("catala_money", "catala_money"), function(e1, e2) { catala_money(v = e1@v - e2@v) }) +setMethod("-", c("catala_money", "missing"), function(e1) { + catala_money(v = -e1@v) +}) setMethod("*", c("catala_money", "catala_decimal"), function(e1, e2) { catala_money(v = as.bigz(as.bigq(e1@v) * e2@v)) }) @@ -41,8 +56,7 @@ setMethod("/", c("catala_money", "catala_money"), function(e1, e2) { catala_decimal(v = as.bigq(e1@v / e2@v)) }) setMethod("Compare", "catala_money", function(e1, e2) { - v <- callGeneric(e1@v, e2@v) - new("catala_money", v = v) + callGeneric(e1@v, e2@v) }) ################ Duration ################# @@ -56,12 +70,14 @@ setMethod("+", c("catala_duration", "catala_duration"), function(e1, e2) { setMethod("-", c("catala_duration", "catala_duration"), function(e1, e2) { catala_duration(v = e1@v - e2@v) }) +setMethod("-", c("catala_duration", "missing"), function(e1) { + catala_duration(v = -e1@v) +}) setMethod("/", c("catala_duration", "catala_duration"), function(e1, e2) { catala_duration(v = e1@v / e2@v) }) setMethod("Compare", "catala_duration", function(e1, e2) { - v <- callGeneric(e1@v, e2@v) - new("catala_duration", v = v) + callGeneric(e1@v, e2@v) }) @@ -80,13 +96,12 @@ setMethod("-", c("catala_date", "catala_date"), function(e1, e2) { catala_date(v = e1@v - e2@v) }) setMethod("Compare", "catala_date", function(e1, e2) { - v <- callGeneric(e1@v, e2@v) - new("catala_date", v = v) + callGeneric(e1@v, e2@v) }) ################ Unit ################# -catala_unit <- setClass("catala_unit") +catala_unit <- setClass("catala_unit", representation(v = "numeric")) ################ Constructors and conversions ################# @@ -300,7 +315,7 @@ catala_assertion_failure <- function(pos) { handle_default <- function(pos, exceptions, just, cons) { acc <- Reduce(function(acc, exception) { new_val <- tryCatch( - exception(catala_unit()), + exception(catala_unit(v = 0)), catala_empty_error = function(e) { NULL } @@ -316,8 +331,8 @@ handle_default <- function(pos, exceptions, just, cons) { } }, exceptions, NULL) if (is.null(acc)) { - if (just(catala_unit())) { - cons(catala_unit()) + if (just(catala_unit(v = 0))) { + cons(catala_unit(v = 0)) } else { stop(catala_empty_error()) } diff --git a/test.catala_en b/test.catala_en index 2fcc5e88..a3d87dc4 100644 --- a/test.catala_en +++ b/test.catala_en @@ -7,7 +7,6 @@ declaration structure S: data a content integer data b content boolean data c content collection decimal - data d content integer depends on x content boolean declaration enumeration E: -- Case1 content S @@ -15,5 +14,16 @@ declaration enumeration E: declaration scope Foo: input x content integer - output y content integer + internal y content E + output z content boolean + +scope Foo: + definition y equals Case2 + + exception definition y under condition x = 1 consequence equals + Case1 content S { --a: 1 --b: true --c: [0.2;0.3]} + + definition z equals match y with pattern + -- Case1: true + -- Case2: false ``` \ No newline at end of file diff --git a/test.r b/test.r index 03ece45d..091e312b 100644 --- a/test.r +++ b/test.r @@ -6,56 +6,127 @@ catala_struct_S <- setRefClass("catala_struct_S", fields = list( a = "catala_integer", b = "logical", c = "list" # array("catala_decimal") - ), - methods = list( - d = # bool → integer - function() { - stop("uninitialized") - } ) ) catala_struct_Foo <- setRefClass("catala_struct_Foo", - fields = list(y = "catala_integer"), methods = list() + fields = list(z = "logical") ) -# Enum cases: "Case1" ("catala_class_S"), "Case2" ("catala_unit") +# Enum cases: "Case1" ("catala_struct_S"), "Case2" ("catala_unit") catala_enum_E <- setRefClass("catala_enum_E", fields = list(code = "character", value = "ANY") ) catala_struct_FooIn <- setRefClass("catala_struct_FooIn", - fields = list(x_in = "catala_integer"), methods = list() + fields = list(x_in = "catala_integer") ) foo <- function( - foo_in # ("catala_class_FooIn") + foo_in # ("catala_struct_FooIn") ) { x <- foo_in$x_in tryCatch( { temp_y <- function(dummy_var # ("catala_unit") ) { - stop(catala_empty_error()) + return(catala_enum_E( + code = "Case2", + value = catala_unit(v = 0) + )) } temp_y_1 <- function(dummy_var # ("catala_unit") ) { - return(FALSE) + return(TRUE) } - temp_y_2 <- handle_default( + temp_y_2 <- function(dummy_var # ("catala_unit") + ) { + temp_y_3 <- function(dummy_var # ("catala_unit") + ) { + return(catala_enum_E( + code = "Case1", + value = catala_struct_S( + a = catala_integer_from_numeric(1), + b = TRUE, c = list( + catala_decimal_from_string("0.2"), + catala_decimal_from_string("0.3") + ) + ) + )) + } + temp_y_4 <- function(dummy_var # ("catala_unit") + ) { + return((x == catala_integer_from_numeric(1))) + } + return(handle_default( + catala_position( + filename = "", + start_line = 0, start_column = 1, + end_line = 0, end_column = 1, + law_headings = c() + ), list(), temp_y_4, + temp_y_3 + )) + } + temp_y_5 <- handle_default( catala_position( filename = "", start_line = 0, start_column = 1, end_line = 0, end_column = 1, law_headings = c() - ), list(), temp_y_1, - temp_y + ), list(temp_y_2), + temp_y_1, temp_y ) }, catala_empty_error = function(dummy__arg) { - temp_y_2 <- dead_value + temp_y_5 <- dead_value + stop(catala_no_value_provided_error( + catala_position( + filename = "test.catala_en", + start_line = 17, + start_column = 12, + end_line = 17, + end_column = 13, + law_headings = c( + "Coucou", + "Salut" + ) + ) + )) + } + ) + y <- temp_y_5 + tryCatch( + { + temp_z <- function(dummy_var # ("catala_unit") + ) { + match_arg <- y + if (match_arg$code == "Case1") { + dummy_var <- match_arg$value + return(TRUE) + } else if (match_arg$code == "Case2") { + dummy_var <- match_arg$value + return(FALSE) + } + } + temp_z_1 <- function(dummy_var # ("catala_unit") + ) { + return(TRUE) + } + temp_z_2 <- handle_default( + catala_position( + filename = "", + start_line = 0, start_column = 1, + end_line = 0, end_column = 1, + law_headings = c() + ), list(), temp_z_1, + temp_z + ) + }, + catala_empty_error = function(dummy__arg) { + temp_z_2 <- dead_value stop(catala_no_value_provided_error( catala_position( filename = "test.catala_en", @@ -71,6 +142,6 @@ foo <- function( )) } ) - y <- temp_y_2 - return(Foo(y = y)) + z <- temp_z_2 + return(catala_struct_Foo(z = z)) }