From 98a460e1b3b197516d595edb6a9e2240a63d933c Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Mon, 8 Jul 2024 14:50:03 +0200 Subject: [PATCH] Remove the R backend There are no users at the moment, so we won't be actively maintaining it. If and when the need arises again, we can revert this commit and resurrect it. --- compiler/driver.ml | 26 -- compiler/scalc/to_r.ml | 567 ------------------------------------ compiler/scalc/to_r.mli | 21 -- runtimes/r/.Rbuildignore | 1 - runtimes/r/DESCRIPTION | 16 - runtimes/r/LICENSE.md | 194 ------------ runtimes/r/NAMESPACE | 53 ---- runtimes/r/R/dune | 4 - runtimes/r/R/runtime.R | 372 ----------------------- runtimes/r/format_r_file.sh | 5 - 10 files changed, 1259 deletions(-) delete mode 100644 compiler/scalc/to_r.ml delete mode 100644 compiler/scalc/to_r.mli delete mode 100644 runtimes/r/.Rbuildignore delete mode 100644 runtimes/r/DESCRIPTION delete mode 100644 runtimes/r/LICENSE.md delete mode 100644 runtimes/r/NAMESPACE delete mode 100644 runtimes/r/R/dune delete mode 100644 runtimes/r/R/runtime.R delete mode 100755 runtimes/r/format_r_file.sh diff --git a/compiler/driver.ml b/compiler/driver.ml index f4efd0a9..33143622 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -928,31 +928,6 @@ module Commands = struct $ Cli.Flags.check_invariants $ Cli.Flags.closure_conversion) - let r options includes output optimize check_invariants closure_conversion = - let prg, type_ordering = - Passes.scalc options ~includes ~optimize ~check_invariants - ~closure_conversion ~keep_special_ops:false ~dead_value_assignment:false - ~no_struct_literals:false ~monomorphize_types:false - in - - let output_file, with_output = get_output_format options ~ext:".r" output in - Message.debug "Compiling program into R..."; - Message.debug "Writing to %s..." - (Option.value ~default:"stdout" output_file); - with_output @@ fun fmt -> Scalc.To_r.format_program fmt prg type_ordering - - let r_cmd = - Cmd.v - (Cmd.info "r" ~doc:"Generates an R translation of the Catala program.") - Term.( - const r - $ Cli.Flags.Global.options - $ Cli.Flags.include_dirs - $ Cli.Flags.output - $ Cli.Flags.optimize - $ Cli.Flags.check_invariants - $ Cli.Flags.closure_conversion) - let c options includes output optimize check_invariants = let prg, type_ordering = Passes.scalc options ~includes ~optimize ~check_invariants @@ -1071,7 +1046,6 @@ module Commands = struct proof_cmd; ocaml_cmd; python_cmd; - r_cmd; c_cmd; latex_cmd; html_cmd; diff --git a/compiler/scalc/to_r.ml b/compiler/scalc/to_r.ml deleted file mode 100644 index e9f842f2..00000000 --- a/compiler/scalc/to_r.ml +++ /dev/null @@ -1,567 +0,0 @@ -(* This file is part of the Catala compiler, a specification language for tax - and social benefits computation rules. Copyright (C) 2020 Inria, contributor: - Denis Merigoux - - Licensed under the Apache License, Version 2.0 (the "License"); you may not - use this file except in compliance with the License. You may obtain a copy of - the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, WITHOUT - WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the - License for the specific language governing permissions and limitations under - the License. *) - -open Catala_utils -open Shared_ast -open Ast -module Runtime = Runtime_ocaml.Runtime -module D = Dcalc.Ast -module L = Lcalc.Ast - -let format_lit (fmt : Format.formatter) (l : lit Mark.pos) : unit = - match Mark.remove l with - | LBool true -> Format.pp_print_string fmt "TRUE" - | LBool false -> Format.pp_print_string fmt "FALSE" - | LInt i -> - 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 "new(\"catala_unit\",v=0)" - | LRat i -> - Format.fprintf fmt "catala_decimal_from_fraction(%s,%s)" - (if Z.fits_nativeint (Q.num i) then Z.to_string (Q.num i) - else "\"" ^ Z.to_string (Q.num i) ^ "\"") - (if Z.fits_nativeint (Q.den i) then Z.to_string (Q.den i) - else "\"" ^ Z.to_string (Q.den i) ^ "\"") - | LMoney e -> - if Z.fits_nativeint e then - Format.fprintf fmt "catala_money_from_cents(%s)" - (Runtime.integer_to_string (Runtime.money_to_cents e)) - else - Format.fprintf fmt "catala_money_from_cents(\"%s\")" - (Runtime.integer_to_string (Runtime.money_to_cents e)) - | LDate d -> - Format.fprintf fmt "catala_date_from_ymd(%d,%d,%d)" - (Runtime.integer_to_int (Runtime.year_of_date d)) - (Runtime.integer_to_int (Runtime.month_number_of_date d)) - (Runtime.integer_to_int (Runtime.day_of_month_of_date d)) - | LDuration d -> - let years, months, days = Runtime.duration_to_years_months_days d in - Format.fprintf fmt "catala_duration_from_ymd(%d,%d,%d)" years months days - -let format_op (fmt : Format.formatter) (op : operator Mark.pos) : unit = - match Mark.remove op with - | Log (_entry, _infos) -> assert false - | Minus_int | Minus_rat | Minus_mon | Minus_dur -> - Format.pp_print_string fmt "-" - (* Todo: use the names from [Operator.name] *) - | Not -> Format.pp_print_string fmt "!" - | Length -> Format.pp_print_string fmt "catala_list_length" - | ToRat_int -> Format.pp_print_string fmt "catala_decimal_from_integer" - | ToRat_mon -> Format.pp_print_string fmt "catala_decimal_from_money" - | ToMoney_rat -> Format.pp_print_string fmt "catala_money_from_decimal" - | GetDay -> Format.pp_print_string fmt "catala_day_of_month_of_date" - | GetMonth -> Format.pp_print_string fmt "catala_month_number_of_date" - | GetYear -> Format.pp_print_string fmt "catala_year_of_date" - | FirstDayOfMonth -> - Format.pp_print_string fmt "catala_date_first_day_of_month" - | LastDayOfMonth -> Format.pp_print_string fmt "catala_date_last_day_of_month" - | Round_mon -> Format.pp_print_string fmt "catala_money_round" - | Round_rat -> Format.pp_print_string fmt "catala_decimal_round" - | Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur _ | Add_dur_dur - | Concat -> - Format.pp_print_string fmt "+" - | Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat | Sub_dat_dur - | Sub_dur_dur -> - Format.pp_print_string fmt "-" - | Mult_int_int | Mult_rat_rat | Mult_mon_rat | Mult_dur_int -> - Format.pp_print_string fmt "*" - | Div_int_int | Div_rat_rat | Div_mon_mon | Div_mon_rat | Div_dur_dur -> - Format.pp_print_string fmt "/" - | And -> Format.pp_print_string fmt "&&" - | Or -> Format.pp_print_string fmt "||" - | Eq -> Format.pp_print_string fmt "==" - | Xor -> Format.pp_print_string fmt "!=" - | Lt_int_int | Lt_rat_rat | Lt_mon_mon | Lt_dat_dat | Lt_dur_dur -> - Format.pp_print_string fmt "<" - | Lte_int_int | Lte_rat_rat | Lte_mon_mon | Lte_dat_dat | Lte_dur_dur -> - Format.pp_print_string fmt "<=" - | Gt_int_int | Gt_rat_rat | Gt_mon_mon | Gt_dat_dat | Gt_dur_dur -> - Format.pp_print_string fmt ">" - | Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dat_dat | Gte_dur_dur -> - Format.pp_print_string fmt ">=" - | Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dat_dat | Eq_dur_dur -> - Format.pp_print_string fmt "==" - | Map -> Format.pp_print_string fmt "catala_list_map" - | Map2 -> Format.pp_print_string fmt "catala_list_map2" - | 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 -> failwith "unimplemented" - -let format_string_list (fmt : Format.formatter) (uids : string list) : unit = - let sanitize_quotes = Re.compile (Re.char '"') in - Format.fprintf fmt "c(%a)" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") - (fun fmt info -> - Format.fprintf fmt "\"%s\"" - (Re.replace sanitize_quotes ~f:(fun _ -> "\\\"") info))) - uids - -let avoid_keywords (s : string) : string = - if - match s with - (* list taken from - https://cran.r-project.org/doc/manuals/r-release/R-lang.html#Reserved-words *) - | "if" | "else" | "repeat" | "while" | "function" | "for" | "in" | "next" - | "break" | "TRUE" | "FALSE" | "NULL" | "Inf" | "NaN" | "NA" | "NA_integer_" - | "NA_real_" | "NA_complex_" | "NA_character_" - (* additions of things that are not keywords but that we should not - overwrite*) - | "list" | "c" | "character" | "logical" | "complex" | "setClass" | "new" -> - true - | _ -> false - then s ^ "_" - else s - -let format_struct_name (fmt : Format.formatter) (v : StructName.t) : unit = - Format.fprintf fmt "%s" - (avoid_keywords - (String.to_camel_case - (String.to_ascii (Format.asprintf "%a" StructName.format v)))) - -let format_struct_field_name (fmt : Format.formatter) (v : StructField.t) : unit - = - Format.fprintf fmt "%s" - (avoid_keywords - (String.to_ascii (Format.asprintf "%a" StructField.format v))) - -let format_enum_name (fmt : Format.formatter) (v : EnumName.t) : unit = - Format.fprintf fmt "%s" - (avoid_keywords - (String.to_camel_case - (String.to_ascii (Format.asprintf "%a" EnumName.format v)))) - -let format_enum_cons_name (fmt : Format.formatter) (v : EnumConstructor.t) : - unit = - Format.fprintf fmt "%s" - (avoid_keywords - (String.to_ascii (Format.asprintf "%a" EnumConstructor.format v))) - -let rec format_typ ~inside_comment (fmt : Format.formatter) (typ : typ) : unit = - let format_typ = format_typ in - match Mark.remove typ with - | TLit TUnit -> Format.fprintf fmt "\"catala_unit\"" - | TLit TMoney -> Format.fprintf fmt "\"catala_money\"" - | TLit TInt -> Format.fprintf fmt "\"catala_integer\"" - | TLit TRat -> Format.fprintf fmt "\"catala_decimal\"" - | TLit TDate -> Format.fprintf fmt "\"catala_date\"" - | TLit TDuration -> Format.fprintf fmt "\"catala_duration\"" - | TLit TBool -> Format.fprintf fmt "\"logical\"" - | TTuple ts -> - Format.fprintf fmt "\"list\"@ # tuple(%a)%t" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@;") - (format_typ ~inside_comment:true)) - ts - (fun fmt -> if inside_comment then () else Format.pp_force_newline fmt ()) - | TStruct s -> Format.fprintf fmt "\"catala_struct_%a\"" format_struct_name s - | TOption some_typ | TDefault some_typ -> - (* We loose track of optional value as they're crammed into NULL *) - format_typ ~inside_comment:false fmt some_typ - | TEnum e -> Format.fprintf fmt "\"catala_enum_%a\"" format_enum_name e - | TArrow (t1, t2) -> - Format.fprintf fmt "\"function\" # %a -> %a%t" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ") - (format_typ ~inside_comment:true)) - t1 - (format_typ ~inside_comment:true) - t2 - (fun fmt -> if inside_comment then () else Format.pp_force_newline fmt ()) - | TArray t1 -> - Format.fprintf fmt "\"list\" # array(%a)%t" - (format_typ ~inside_comment:true) t1 (fun fmt -> - if inside_comment then () else Format.pp_force_newline fmt ()) - | TAny -> Format.fprintf fmt "\"ANY\"" - | TClosureEnv -> failwith "unimplemented!" - -let format_name_cleaned (fmt : Format.formatter) (s : string) : unit = - s - |> String.to_ascii - |> String.to_snake_case - |> Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\.") ~subst:(fun _ -> "_dot_") - |> String.to_ascii - |> avoid_keywords - |> Format.fprintf fmt "%s" - -module StringMap = String.Map - -module IntMap = Map.Make (struct - include Int - - let format ppf i = Format.pp_print_int ppf i -end) - -(** For each `VarName.t` defined by its string and then by its hash, we keep - track of which local integer id we've given it. This is used to keep - variable naming with low indices rather than one global counter for all - variables. TODO: should be removed when - https://github.com/CatalaLang/catala/issues/240 is fixed. *) -let string_counter_map : int IntMap.t StringMap.t ref = ref StringMap.empty - -let format_var (fmt : Format.formatter) (v : VarName.t) : unit = - let v_str = Mark.remove (VarName.get_info v) in - let id = VarName.id v in - let local_id = - match StringMap.find_opt v_str !string_counter_map with - | Some ids -> ( - match IntMap.find_opt id ids with - | None -> - let max_id = - snd - (List.hd - (List.fast_sort - (fun (_, x) (_, y) -> Int.compare y x) - (IntMap.bindings ids))) - in - string_counter_map := - StringMap.add v_str - (IntMap.add id (max_id + 1) ids) - !string_counter_map; - max_id + 1 - | Some local_id -> local_id) - | None -> - string_counter_map := - StringMap.add v_str (IntMap.singleton id 0) !string_counter_map; - 0 - in - if v_str = "_" then Format.fprintf fmt "dummy_var" - (* special case for the unit pattern TODO escape dummy_var *) - else if local_id = 0 then format_name_cleaned fmt v_str - else Format.fprintf fmt "%a_%d" format_name_cleaned v_str local_id - -let format_func_name (fmt : Format.formatter) (v : FuncName.t) : unit = - let v_str = Mark.remove (FuncName.get_info v) in - format_name_cleaned fmt v_str - -let format_position ppf pos = - Format.fprintf ppf - "@[catala_position(@,\ - filename=\"%s\",@ start_line=%d, start_column=%d,@ end_line=%d, \ - end_column=%d,@ law_headings=%a@;\ - <0 -2>)@]" (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) - -let format_error (ppf : Format.formatter) (err : Runtime.error Mark.pos) : unit - = - let pos = Mark.get err in - let tag = String.to_snake_case (Runtime.error_to_string (Mark.remove err)) in - Format.fprintf ppf "%s(%a)" tag format_position pos - -let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) : - unit = - match Mark.remove e with - | EVar v -> format_var fmt v - | EFunc f -> format_func_name fmt f - | EStruct { fields = es; name = s } -> - Format.fprintf fmt "new(\"catala_struct_%a\",@ %a)" format_struct_name s - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") - (fun fmt (struct_field, e) -> - Format.fprintf fmt "%a = %a" format_struct_field_name struct_field - (format_expression ctx) e)) - (StructField.Map.bindings es) - | EStructFieldAccess { e1; field; _ } -> - Format.fprintf fmt "%a@%a" (format_expression ctx) e1 - format_struct_field_name field - | EInj { cons; name = 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 R's [NULL] *) - Format.fprintf fmt "NULL" - | EInj { e1 = e; cons; name = 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 R's [NULL] *) - format_expression ctx fmt e - | EInj { e1 = e; cons; name = enum_name; _ } -> - Format.fprintf fmt "new(\"catala_enum_%a\", code = \"%a\",@ value = %a)" - format_enum_name enum_name format_enum_cons_name cons - (format_expression ctx) e - | EArray es -> - Format.fprintf fmt "list(%a)" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") - (fun fmt e -> Format.fprintf fmt "%a" (format_expression ctx) e)) - es - | ELit l -> Format.fprintf fmt "%a" format_lit (Mark.copy e l) - | EAppOp { op = ((Map | Filter), _) as op; args = [arg1; arg2] } -> - Format.fprintf fmt "%a(%a,@ %a)" format_op op (format_expression ctx) arg1 - (format_expression ctx) arg2 - | EAppOp { op; args = [arg1; arg2] } -> - Format.fprintf fmt "(%a %a@ %a)" (format_expression ctx) arg1 format_op op - (format_expression ctx) arg2 - | EAppOp { op = (Not, _) as op; args = [arg1] } -> - Format.fprintf fmt "%a %a" format_op op (format_expression ctx) arg1 - | EAppOp - { - op = ((Minus_int | Minus_rat | Minus_mon | Minus_dur), _) as op; - args = [arg1]; - } -> - Format.fprintf fmt "%a %a" format_op op (format_expression ctx) arg1 - | EAppOp { op = HandleExceptions, _ as op; args = [EArray el, _] as args } -> - Format.fprintf fmt - "%a(%a, %a)@]" - format_op op - (Format.pp_print_list - ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ") - format_position) - (List.map Mark.get el) - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") - (format_expression ctx)) - args - | EAppOp { op; args = [arg1] } -> - Format.fprintf fmt "%a(%a)" format_op op (format_expression ctx) arg1 - | EApp { f; args } -> - Format.fprintf fmt "%a(@[%a)@]" (format_expression ctx) f - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") - (format_expression ctx)) - args - | EAppOp { op; args } -> - Format.fprintf fmt "%a(@[%a)@]" format_op op - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") - (format_expression ctx)) - args - | ETuple args -> - Format.fprintf fmt "list(@[%a)@]" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") - (format_expression ctx)) - args - | ETupleAccess { e1; index } -> - Format.fprintf fmt "(%a)[%d]" (format_expression ctx) e1 index - | EExternal _ -> failwith "TODO" - -let rec format_statement - (ctx : decl_ctx) - (fmt : Format.formatter) - (s : stmt Mark.pos) : unit = - match Mark.remove s with - | SInnerFuncDef { name; func = { func_params; func_body; _ } } -> - Format.fprintf fmt "@[%a <- function(@\n%a) {@\n%a@]@\n}" format_var - (Mark.remove name) - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n,@;") - (fun fmt (var, typ) -> - Format.fprintf fmt "%a# (%a)@\n" format_var (Mark.remove var) - (format_typ ~inside_comment:true) - typ)) - func_params (format_block ctx) func_body - | SLocalDecl _ -> - assert false (* We don't need to declare variables in Python *) - | SLocalDef { name = v; expr = e; _ } | SLocalInit { name = v; expr = e; _ } - -> - Format.fprintf fmt "@[%a <- %a@]" format_var (Mark.remove v) - (format_expression ctx) e - | STryWEmpty { try_block = try_b; with_block = catch_b } -> - Format.fprintf fmt - (* TODO escape dummy__arg*) - "@[tryCatch(@[{@;\ - %a@;\ - }@],@;\ - catala_empty_error() = function(dummy__arg) @[{@;\ - %a@;\ - }@])@]" - (format_block ctx) try_b (format_block ctx) catch_b - | SRaiseEmpty -> Format.pp_print_string fmt "stop(catala_empty_error())" - | SFatalError err -> - Format.fprintf fmt "@[stop(%a)@]" format_error (err, Mark.get s) - | SIfThenElse { if_expr = cond; then_block = b1; else_block = b2 } -> - Format.fprintf fmt - "@[if (%a) {@\n%a@]@\n@[} else {@\n%a@]@\n}" - (format_expression ctx) cond (format_block ctx) b1 (format_block ctx) b2 - | SSwitch - { - switch_expr = e1; - enum_name = e_name; - switch_cases = - [ - { case_block = case_none; _ }; - { case_block = case_some; payload_var_name = case_some_var; _ }; - ]; - _; - } - when EnumName.equal e_name Expr.option_enum -> - (* 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 (is.null(%a)) {@\n\ - %a@]@\n\ - @[} else {@\n\ - %a = %a@\n\ - %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 - | SSwitch { switch_expr = e1; enum_name = e_name; switch_cases = cases; _ } -> - let cases = - List.map2 - (fun x (cons, _) -> x, cons) - cases - (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@]@\n}" format_var - tmp_var (format_expression ctx) e1 - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "@]@\n@[} else if ") - (fun fmt ({ case_block; payload_var_name; _ }, cons_name) -> - 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_name format_var tmp_var (format_block ctx) case_block)) - cases - | SReturn e1 -> - Format.fprintf fmt "@[return(%a)@]" (format_expression ctx) - (e1, Mark.get s) - | SAssert e1 -> - let pos = Mark.get s in - Format.fprintf fmt - "@[if (!(%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@])@])@])@]@\n\ - }" - (format_expression ctx) - (e1, Mark.get s) - (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) - | SSpecialOp _ -> failwith "should not happen" - -and format_block (ctx : decl_ctx) (fmt : Format.formatter) (b : block) : unit = - Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n") - (format_statement ctx) fmt - (List.filter - (fun s -> match Mark.remove s with SLocalDecl _ -> false | _ -> true) - b) - -let format_ctx - (type_ordering : Scopelang.Dependency.TVertex.t list) - (fmt : Format.formatter) - (ctx : decl_ctx) : unit = - let format_struct_decl fmt (struct_name, struct_fields) = - let fields = StructField.Map.bindings struct_fields in - Format.fprintf fmt - "@[setClass(@,\ - \"catala_struct_%a\",@;\ - representation@[(%a)@]@\n\ - )@]" - format_struct_name struct_name - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@;") - (fun fmt (struct_field, typ) -> - Format.fprintf fmt "%a = %a" format_struct_field_name struct_field - (format_typ ~inside_comment:false) - typ)) - fields - in - let format_enum_decl fmt (enum_name, enum_cons) = - if EnumConstructor.Map.is_empty enum_cons then - failwith "no constructors in the enum" - else - Format.fprintf fmt - "# Enum cases: %a@\n\ - @[setClass(@,\ - \"catala_enum_%a\",@;\ - representation@[(code =@;\ - \"character\",@;\ - value =@;\ - \"ANY\")@])@]" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ") - (fun fmt (enum_cons, enum_cons_type) -> - Format.fprintf fmt "\"%a\" (%a)" format_enum_cons_name enum_cons - (format_typ ~inside_comment:false) - enum_cons_type)) - (EnumConstructor.Map.bindings enum_cons) - format_enum_name enum_name - in - - let is_in_type_ordering s = - List.exists - (fun struct_or_enum -> - match struct_or_enum with - | Scopelang.Dependency.TVertex.Enum _ -> false - | Scopelang.Dependency.TVertex.Struct s' -> s = s') - type_ordering - in - let scope_structs = - List.map - (fun (s, _) -> Scopelang.Dependency.TVertex.Struct s) - (StructName.Map.bindings - (StructName.Map.filter - (fun s _ -> not (is_in_type_ordering s)) - ctx.ctx_structs)) - in - List.iter - (fun struct_or_enum -> - match struct_or_enum with - | Scopelang.Dependency.TVertex.Struct s -> - Format.fprintf fmt "%a@\n@\n" format_struct_decl - (s, StructName.Map.find s ctx.ctx_structs) - | Scopelang.Dependency.TVertex.Enum e -> - Format.fprintf fmt "%a@\n@\n" format_enum_decl - (e, EnumName.Map.find e ctx.ctx_enums)) - (type_ordering @ scope_structs) - -let format_program - (fmt : Format.formatter) - (p : Ast.program) - (type_ordering : Scopelang.Dependency.TVertex.t list) : unit = - (* We disable the style flag in order to enjoy formatting from the - pretty-printers of Dcalc and Lcalc but without the color terminal - markers. *) - Format.fprintf fmt - "@[# This file has been generated by the Catala compiler, do not edit!@,\ - @,\ - library(catalaRuntime)@,\ - @,\ - @[%a@]@,\ - @,\ - %a@]@?" - (format_ctx type_ordering) p.ctx.decl_ctx - (Format.pp_print_list ~pp_sep:Format.pp_print_newline (fun fmt -> function - | SVar { var; expr; typ = _ } -> - Format.fprintf fmt "@[%a <- (@,%a@,@])@," format_var var - (format_expression p.ctx.decl_ctx) - expr - | SFunc { var; func } - | SScope { scope_body_var = var; scope_body_func = func; _ } -> - let { Ast.func_params; Ast.func_body; _ } = func in - Format.fprintf fmt "@[%a <- function(@\n%a) {@\n%a@]@\n}@," - format_func_name var - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n,@;") - (fun fmt (var, typ) -> - Format.fprintf fmt "%a# (%a)@\n" format_var (Mark.remove var) - (format_typ ~inside_comment:true) - typ)) - func_params - (format_block p.ctx.decl_ctx) - func_body)) - p.code_items diff --git a/compiler/scalc/to_r.mli b/compiler/scalc/to_r.mli deleted file mode 100644 index 7ab3a4fa..00000000 --- a/compiler/scalc/to_r.mli +++ /dev/null @@ -1,21 +0,0 @@ -(* This file is part of the Catala compiler, a specification language for tax - and social benefits computation rules. Copyright (C) 2021 Inria, contributor: - Denis Merigoux - - Licensed under the Apache License, Version 2.0 (the "License"); you may not - use this file except in compliance with the License. You may obtain a copy of - the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, WITHOUT - WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the - License for the specific language governing permissions and limitations under - the License. *) - -(** Formats a lambda calculus program into a valid R program *) - -val format_program : - Format.formatter -> Ast.program -> Scopelang.Dependency.TVertex.t list -> unit -(** Usage [format_program fmt p type_dependencies_ordering] *) diff --git a/runtimes/r/.Rbuildignore b/runtimes/r/.Rbuildignore deleted file mode 100644 index 5163d0b5..00000000 --- a/runtimes/r/.Rbuildignore +++ /dev/null @@ -1 +0,0 @@ -^LICENSE\.md$ diff --git a/runtimes/r/DESCRIPTION b/runtimes/r/DESCRIPTION deleted file mode 100644 index 3f121b40..00000000 --- a/runtimes/r/DESCRIPTION +++ /dev/null @@ -1,16 +0,0 @@ -Package: catalaRuntime -Title: R runtime for programs compiled from Catala -Version: 0.0.0.9000 -Authors@R: - person("Denis", "Merigoux", , "denis.merigoux@inria.fr", role = c("aut", "cre"), - comment = c(ORCID = "0000-0003-2247-0938")) -Description: This package provides all S4 classes and functions necessary to run - programs generated by the Catala compiler. -License: Apache License (>= 2) -Encoding: UTF-8 -Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 -Imports: - methods, - gmp, - lubridate diff --git a/runtimes/r/LICENSE.md b/runtimes/r/LICENSE.md deleted file mode 100644 index b62a9b5f..00000000 --- a/runtimes/r/LICENSE.md +++ /dev/null @@ -1,194 +0,0 @@ -Apache License -============== - -_Version 2.0, January 2004_ -_<>_ - -### Terms and Conditions for use, reproduction, and distribution - -#### 1. Definitions - -“License” shall mean the terms and conditions for use, reproduction, and -distribution as defined by Sections 1 through 9 of this document. - -“Licensor” shall mean the copyright owner or entity authorized by the copyright -owner that is granting the License. - -“Legal Entity” shall mean the union of the acting entity and all other entities -that control, are controlled by, or are under common control with that entity. -For the purposes of this definition, “control” means **(i)** the power, direct or -indirect, to cause the direction or management of such entity, whether by -contract or otherwise, or **(ii)** ownership of fifty percent (50%) or more of the -outstanding shares, or **(iii)** beneficial ownership of such entity. - -“You” (or “Your”) shall mean an individual or Legal Entity exercising -permissions granted by this License. - -“Source” form shall mean the preferred form for making modifications, including -but not limited to software source code, documentation source, and configuration -files. - -“Object” form shall mean any form resulting from mechanical transformation or -translation of a Source form, including but not limited to compiled object code, -generated documentation, and conversions to other media types. - -“Work” shall mean the work of authorship, whether in Source or Object form, made -available under the License, as indicated by a copyright notice that is included -in or attached to the work (an example is provided in the Appendix below). - -“Derivative Works” shall mean any work, whether in Source or Object form, that -is based on (or derived from) the Work and for which the editorial revisions, -annotations, elaborations, or other modifications represent, as a whole, an -original work of authorship. For the purposes of this License, Derivative Works -shall not include works that remain separable from, or merely link (or bind by -name) to the interfaces of, the Work and Derivative Works thereof. - -“Contribution” shall mean any work of authorship, including the original version -of the Work and any modifications or additions to that Work or Derivative Works -thereof, that is intentionally submitted to Licensor for inclusion in the Work -by the copyright owner or by an individual or Legal Entity authorized to submit -on behalf of the copyright owner. For the purposes of this definition, -“submitted” means any form of electronic, verbal, or written communication sent -to the Licensor or its representatives, including but not limited to -communication on electronic mailing lists, source code control systems, and -issue tracking systems that are managed by, or on behalf of, the Licensor for -the purpose of discussing and improving the Work, but excluding communication -that is conspicuously marked or otherwise designated in writing by the copyright -owner as “Not a Contribution.” - -“Contributor” shall mean Licensor and any individual or Legal Entity on behalf -of whom a Contribution has been received by Licensor and subsequently -incorporated within the Work. - -#### 2. Grant of Copyright License - -Subject to the terms and conditions of this License, each Contributor hereby -grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, -irrevocable copyright license to reproduce, prepare Derivative Works of, -publicly display, publicly perform, sublicense, and distribute the Work and such -Derivative Works in Source or Object form. - -#### 3. Grant of Patent License - -Subject to the terms and conditions of this License, each Contributor hereby -grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, -irrevocable (except as stated in this section) patent license to make, have -made, use, offer to sell, sell, import, and otherwise transfer the Work, where -such license applies only to those patent claims licensable by such Contributor -that are necessarily infringed by their Contribution(s) alone or by combination -of their Contribution(s) with the Work to which such Contribution(s) was -submitted. If You institute patent litigation against any entity (including a -cross-claim or counterclaim in a lawsuit) alleging that the Work or a -Contribution incorporated within the Work constitutes direct or contributory -patent infringement, then any patent licenses granted to You under this License -for that Work shall terminate as of the date such litigation is filed. - -#### 4. Redistribution - -You may reproduce and distribute copies of the Work or Derivative Works thereof -in any medium, with or without modifications, and in Source or Object form, -provided that You meet the following conditions: - -* **(a)** You must give any other recipients of the Work or Derivative Works a copy of -this License; and -* **(b)** You must cause any modified files to carry prominent notices stating that You -changed the files; and -* **(c)** You must retain, in the Source form of any Derivative Works that You distribute, -all copyright, patent, trademark, and attribution notices from the Source form -of the Work, excluding those notices that do not pertain to any part of the -Derivative Works; and -* **(d)** If the Work includes a “NOTICE” text file as part of its distribution, then any -Derivative Works that You distribute must include a readable copy of the -attribution notices contained within such NOTICE file, excluding those notices -that do not pertain to any part of the Derivative Works, in at least one of the -following places: within a NOTICE text file distributed as part of the -Derivative Works; within the Source form or documentation, if provided along -with the Derivative Works; or, within a display generated by the Derivative -Works, if and wherever such third-party notices normally appear. The contents of -the NOTICE file are for informational purposes only and do not modify the -License. You may add Your own attribution notices within Derivative Works that -You distribute, alongside or as an addendum to the NOTICE text from the Work, -provided that such additional attribution notices cannot be construed as -modifying the License. - -You may add Your own copyright statement to Your modifications and may provide -additional or different license terms and conditions for use, reproduction, or -distribution of Your modifications, or for any such Derivative Works as a whole, -provided Your use, reproduction, and distribution of the Work otherwise complies -with the conditions stated in this License. - -#### 5. Submission of Contributions - -Unless You explicitly state otherwise, any Contribution intentionally submitted -for inclusion in the Work by You to the Licensor shall be under the terms and -conditions of this License, without any additional terms or conditions. -Notwithstanding the above, nothing herein shall supersede or modify the terms of -any separate license agreement you may have executed with Licensor regarding -such Contributions. - -#### 6. Trademarks - -This License does not grant permission to use the trade names, trademarks, -service marks, or product names of the Licensor, except as required for -reasonable and customary use in describing the origin of the Work and -reproducing the content of the NOTICE file. - -#### 7. Disclaimer of Warranty - -Unless required by applicable law or agreed to in writing, Licensor provides the -Work (and each Contributor provides its Contributions) on an “AS IS” BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, -including, without limitation, any warranties or conditions of TITLE, -NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are -solely responsible for determining the appropriateness of using or -redistributing the Work and assume any risks associated with Your exercise of -permissions under this License. - -#### 8. Limitation of Liability - -In no event and under no legal theory, whether in tort (including negligence), -contract, or otherwise, unless required by applicable law (such as deliberate -and grossly negligent acts) or agreed to in writing, shall any Contributor be -liable to You for damages, including any direct, indirect, special, incidental, -or consequential damages of any character arising as a result of this License or -out of the use or inability to use the Work (including but not limited to -damages for loss of goodwill, work stoppage, computer failure or malfunction, or -any and all other commercial damages or losses), even if such Contributor has -been advised of the possibility of such damages. - -#### 9. Accepting Warranty or Additional Liability - -While redistributing the Work or Derivative Works thereof, You may choose to -offer, and charge a fee for, acceptance of support, warranty, indemnity, or -other liability obligations and/or rights consistent with this License. However, -in accepting such obligations, You may act only on Your own behalf and on Your -sole responsibility, not on behalf of any other Contributor, and only if You -agree to indemnify, defend, and hold each Contributor harmless for any liability -incurred by, or claims asserted against, such Contributor by reason of your -accepting any such warranty or additional liability. - -_END OF TERMS AND CONDITIONS_ - -### APPENDIX: How to apply the Apache License to your work - -To apply the Apache License to your work, attach the following boilerplate -notice, with the fields enclosed by brackets `[]` replaced with your own -identifying information. (Don't include the brackets!) The text should be -enclosed in the appropriate comment syntax for the file format. We also -recommend that a file or class name and description of purpose be included on -the same “printed page” as the copyright notice for easier identification within -third-party archives. - - Copyright [yyyy] [name of copyright owner] - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. diff --git a/runtimes/r/NAMESPACE b/runtimes/r/NAMESPACE deleted file mode 100644 index ab044451..00000000 --- a/runtimes/r/NAMESPACE +++ /dev/null @@ -1,53 +0,0 @@ -# Generated by roxygen2: do not edit by hand - -export(catala_assertion_failure) -export(catala_conflict_error) -export(catala_date_first_day_of_month) -export(catala_date_from_ymd) -export(catala_date_last_day_of_month) -export(catala_date_to_string) -export(catala_day_of_month_of_date) -export(catala_decimal_from_fraction) -export(catala_decimal_from_integer) -export(catala_decimal_from_money) -export(catala_decimal_from_numeric) -export(catala_decimal_round) -export(catala_decimal_to_numeric) -export(catala_duration_from_ymd) -export(catala_duration_to_ymd) -export(catala_empty_error) -export(catala_integer_from_numeric) -export(catala_integer_from_string) -export(catala_integer_to_numeric) -export(catala_list_filter) -export(catala_list_fold_left) -export(catala_list_length) -export(catala_list_map) -export(catala_list_reduce) -export(catala_money_from_cents) -export(catala_money_from_decimal) -export(catala_money_from_units) -export(catala_money_round) -export(catala_money_to_numeric) -export(catala_money_to_string) -export(catala_month_number_of_date) -export(catala_no_value_provided_error) -export(catala_position_to_string) -export(catala_year_of_date) -export(dead_value) -exportClasses(catala_date) -exportClasses(catala_decimal) -exportClasses(catala_duration) -exportClasses(catala_integer) -exportClasses(catala_money) -exportClasses(catala_position) -exportClasses(catala_unit) -exportMethods("*") -exportMethods("+") -exportMethods("-") -exportMethods("/") -exportMethods(Arith) -exportMethods(Compare) -import(gmp) -import(lubridate) -import(methods) diff --git a/runtimes/r/R/dune b/runtimes/r/R/dune deleted file mode 100644 index 4da0b64c..00000000 --- a/runtimes/r/R/dune +++ /dev/null @@ -1,4 +0,0 @@ -(install - (section lib) - (files - (runtime.R as runtime_r/runtime.R))) diff --git a/runtimes/r/R/runtime.R b/runtimes/r/R/runtime.R deleted file mode 100644 index 006d80fc..00000000 --- a/runtimes/r/R/runtime.R +++ /dev/null @@ -1,372 +0,0 @@ -#' @import methods -#' @import gmp -#' @import lubridate - -################ Integers ################# - -#' @export -setClass( - "catala_integer", - representation(v = "bigz") -) -#' @export -setMethod("Arith", "catala_integer", function(e1, e2) { - v <- callGeneric(e1@v, e2@v) - new("catala_integer", v = v) -}) -#' @export -setMethod("-", c("catala_integer", "missing"), function(e1) { - new("catala_integer", v = -e1@v) -}) -#' @export -setMethod("Compare", "catala_integer", function(e1, e2) { - callGeneric(e1@v, e2@v) -}) - -################ Decimals ################# - -#' @export -setClass( - "catala_decimal", - representation(v = "bigq") -) -#' @export -setMethod("Arith", "catala_decimal", function(e1, e2) { - v <- callGeneric(e1@v, e2@v) - new("catala_decimal", v = v) -}) -#' @export -setMethod("-", c("catala_decimal", "missing"), function(e1) { - new("catala_decimal", v = -e1@v) -}) -#' @export -setMethod("Compare", "catala_decimal", function(e1, e2) { - callGeneric(e1@v, e2@v) -}) - -################ Money ################# - -#' @export -setClass( - "catala_money", - representation(v = "bigz") -) -#' @export -setMethod("+", c("catala_money", "catala_money"), function(e1, e2) { - new("catala_money", v = e1@v + e2@v) -}) -#' @export -setMethod("-", c("catala_money", "catala_money"), function(e1, e2) { - new("catala_money", v = e1@v - e2@v) -}) -#' @export -setMethod("-", c("catala_money", "missing"), function(e1) { - new("catala_money", v = -e1@v) -}) -#' @export -setMethod("*", c("catala_money", "catala_decimal"), function(e1, e2) { - new("catala_money", v = as.bigz(as.bigq(e1@v) * e2@v)) -}) -#' @export -setMethod("/", c("catala_money", "catala_money"), function(e1, e2) { - new("catala_decimal", v = as.bigq(e1@v / e2@v)) -}) -#' @export -setMethod("Compare", "catala_money", function(e1, e2) { - callGeneric(e1@v, e2@v) -}) - -################ Duration ################# - -#' @export -setClass( - "catala_duration", - representation(v = "Period") -) -#' @export -setMethod("+", c("catala_duration", "catala_duration"), function(e1, e2) { - new("catala_duration", v = e1@v + e2@v) -}) -#' @export -setMethod("-", c("catala_duration", "catala_duration"), function(e1, e2) { - new("catala_duration", v = e1@v - e2@v) -}) -#' @export -setMethod("-", c("catala_duration", "missing"), function(e1) { - new("catala_duration", v = -e1@v) -}) -#' @export -setMethod("/", c("catala_duration", "catala_duration"), function(e1, e2) { - new("catala_duration", v = e1@v / e2@v) -}) -#' @export -setMethod("Compare", "catala_duration", function(e1, e2) { - callGeneric(e1@v, e2@v) -}) - - -# TODO: port the dates_calc library to R to make date computations -# more robust. - -################ Dates ################# - -#' @export -setClass( - "catala_date", - representation(v = "Date") -) -#' @export -setMethod("+", c("catala_date", "catala_duration"), function(e1, e2) { - new("catala_date", v = e1@v + e2@v) -}) -#' @export -setMethod("-", c("catala_date", "catala_date"), function(e1, e2) { - new("catala_date", v = e1@v - e2@v) -}) -#' @export -setMethod("Compare", "catala_date", function(e1, e2) { - callGeneric(e1@v, e2@v) -}) - -################ Unit ################# - -#' @export -setClass("catala_unit", representation(v = "numeric")) - -################ Constructors and conversions ################# - -# Money - -#' @export -catala_money_from_units <- function(x) { - new("catala_money", v = as.bigz(x) * as.bigz(100)) -} -#' @export -catala_money_from_cents <- function(x) { - new("catala_money", v = as.bigz(x)) -} -#' @export -catala_money_from_decimal <- function(d) { - num_cents_q <- abs(d@v * as.bigq(100)) - unit_part_num_cents_z <- as.bigz(num_cents_q) - remainder_q <- num_cents_q - as.bigq(unit_part_num_cents_z) - if (remainder_q < as.bigq(0.5)) { - new("catala_money", v = as.bigz(sign(d@v)) * unit_part_num_cents_z) - } else { - new("catala_money", v = as.bigz(sign(d@v)) * (unit_part_num_cents_z + as.bigz(1))) - } -} -#' @export -catala_money_to_numeric <- function(m) { - as.numeric(as.bigq(m@v) / as.bigq(100)) -} -#' @export -catala_money_to_string <- function(m) { - paste0("$", catala_money_to_numeric(m)) -} -#' @export -catala_money_round <- function(m) { - q <- abs(m@v) %/% as.bigz(100) - r <- abs(m@v) %% as.bigz(100) - if (abs(r) < 50) { - new("catala_money", v = sign(m@v) * q * as.bigz(100)) - } else { - new("catala_money", v = sign(m@v) * (q + 1) * as.bigz(100)) - } -} - - -# Decimals - -#' @export -catala_decimal_from_numeric <- function(x) { - new("catala_decimal", v = as.bigq(x)) -} -#' @export -catala_decimal_from_fraction <- function(x, y) { - new("catala_decimal", v = as.bigq(n = x, d = y)) -} -#' @export -catala_decimal_from_integer <- function(x) { - new("catala_decimal", v = as.bigq(x@v)) -} -#' @export -catala_decimal_to_numeric <- function(x) { - as.numeric(x@v) -} -#' @export -catala_decimal_round <- function(d) { - q <- abs(as.bigq(as.bigz(d@v))) - r <- abs(d@v) - as.bigq(q) - if (r < as.bigq(0.5)) { - new("catala_decimal", v = sign(d@v) * q) - } else { - new("catala_decimal", v = sign(d@v) * (q + as.bigq(1))) - } -} -#' @export -catala_decimal_from_money <- function(m) { - new("catala_decimal", v = as.bigq(as.bigq(m@v) / as.bigq(100))) -} - -# Integers - -#' @export -catala_integer_from_numeric <- function(x) { - new("catala_integer", v = as.bigz(x)) -} -#' @export -catala_integer_from_string <- function(x) { - new("catala_integer", v = as.bigz(x)) -} -#' @export -catala_integer_to_numeric <- function(x) { - as.numeric(x@v) -} - -# Dates - -#' @export -catala_date_from_ymd <- function(y, m, d) { - new("catala_date", v = make_date(year = y, month = m, day = d)) -} -#' @export -catala_day_of_month_of_date <- function(d) { - mday(d@v) -} -#' @export -catala_month_number_of_date <- function(d) { - month(d@v) -} -#' @export -catala_year_of_date <- function(d) { - year(d@v) -} -#' @export -catala_date_to_string <- function(d) { - paste0(d@v) -} -#' @export -catala_date_first_day_of_month <- function(d) { - new("catala_date", v = make_date(year = year(d@v), month = month(d@v), day = 1)) -} -#' @export -catala_date_last_day_of_month <- function(d) { - new("catala_date", v = make_date( - year = year(d@v), - month = month(d@v), - day = days_in_month(d@v) - )) -} - -# Durations - -#' @export -catala_duration_from_ymd <- function(y, m, d) { - new("catala_duration", v = years(y) + months(m) + days(d)) -} -#' @export -catala_duration_to_ymd <- function(d) { - c(d@v@year, d@v@month, d@v@day) -} - -# List - -#' @export -catala_list_fold_left <- function(f, init, l) { - Reduce(f, l, init) -} -#' @export -catala_list_filter <- function(f, l) { - Filter(f, l) -} -#' @export -catala_list_map <- function(f, l) { - Map(f, l) -} -#' @export -catala_list_map2 <- function(f, l1, l2) { - Map(f, l1, l2) -} -#' @export -catala_list_reduce <- function(f, default, l) { - if (length(l) == 0) { - default - } else { - Reduce(f, l[-(1:1)], l[[1]]) - } -} -#' @export -catala_list_length <- function(l) { - catala_integer_from_numeric(length(l)) -} - -################ Exceptions ################# - -#' @export -setClass( - "catala_position", - representation( - filename = "character", - start_line = "numeric", - end_line = "numeric", - start_column = "numeric", - end_column = "numeric", - law_headings = "character" - ) -) - -#' @export -catala_position_to_string <- function(pos) { - headings <- paste(pos@law_headings, collapse = ", ") - paste0( - pos@filename, ":", - pos@start_line, ".", - pos@start_column, "-", - pos@end_line, ".", - pos@end_column, " (", - headings, ")" - ) -} - -# Source: http://adv-r.had.co.nz/beyond-exception-handling.html -# We redefine conditions to add our own conditions - -#' @export -catala_empty_error <- function() { - structure( - class = c("catala_empty_error", "error", "condition"), - list(message = "EmptyError", call = sys.call(-1)) - ) -} -#' @export -catala_conflict_error <- function(pos) { - structure( - class = c("catala_conflict_error", "error", "condition"), - list(message = catala_position_to_string(pos), call = sys.call(-1)) - ) -} -#' @export -catala_no_value_provided_error <- function(pos) { - structure( - class = c("catala_no_value_provided_error", "error", "condition"), - list(message = catala_position_to_string(pos), call = sys.call(-1)) - ) -} -#' @export -catala_assertion_failure <- function(pos) { - structure( - class = c("catala_assertion_failure", "error", "condition"), - list(message = catala_position_to_string(pos), call = sys.call(-1)) - ) -} - -################ Defaults ################# - -# This value is used for the R code generation to trump R and forcing -# it to accept dead code. Indeed, when raising an exception during a variable -# definition, R could complains that the later dead code will not know what -# this variable was. So we give this variable a dead value. - -#' @export -dead_value <- 0 diff --git a/runtimes/r/format_r_file.sh b/runtimes/r/format_r_file.sh deleted file mode 100755 index 8e109481..00000000 --- a/runtimes/r/format_r_file.sh +++ /dev/null @@ -1,5 +0,0 @@ -#! /bin/bash - -temp=$(mktemp) -(Rscript -e "options(styler.colored_print.vertical=FALSE); con <- file('stdin'); out <- styler::style_text(readLines(con)); close(con); out" < $1) > $temp -cat $temp > $1