Fix tryWith compilation

compiler/plugins/python.ml

@@ -34,6 +34,7 @@ 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...";

compiler/scalc/ast.ml

@@ -41,7 +41,6 @@ and naked_expr =
   | ELit : lit -> naked_expr
   | EApp : expr * expr list -> naked_expr
   | EOp : operator -> naked_expr
-  | ETryExcept : expr * except * expr -> naked_expr
 
 type stmt =
   | SInnerFuncDef of VarName.t Mark.pos * func

compiler/scalc/from_lcalc.ml

@@ -92,12 +92,6 @@ let rec translate_expr (ctxt : 'm ctxt) (expr : 'm L.expr) : A.block * A.expr =
     args_stmts, (A.EArray new_args, Expr.pos expr)
   | EOp { op; _ } -> [], (A.EOp (Operator.translate op), Expr.pos expr)
   | ELit l -> [], (A.ELit l, Expr.pos expr)
-  | ECatch { body; exn; handler }
-    when ctxt.compilation_options.try_catch_type = Expression ->
-    let try_stmts, new_e_try = translate_expr ctxt body in
-    let catch_stmts, new_e_catch = translate_expr ctxt handler in
-    ( try_stmts @ catch_stmts,
-      (A.ETryExcept (new_e_try, exn, new_e_catch), Expr.pos expr) )
   | _ ->
     let tmp_var =
       A.VarName.fresh
@@ -243,8 +237,7 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
     let s_e_false = translate_statements ctxt efalse in
     cond_stmts
     @ [A.SIfThenElse (s_cond, s_e_true, s_e_false), Expr.pos block_expr]
-  | ECatch { body; exn; handler }
-    when ctxt.compilation_options.try_catch_type = Statement ->
+  | ECatch { body; exn; handler } ->
     let s_e_try = translate_statements ctxt body in
     let s_e_catch = translate_statements ctxt handler in
     [A.STryExcept (s_e_try, exn, s_e_catch), Expr.pos block_expr]

compiler/scalc/print.ml

@@ -85,9 +85,6 @@ let rec format_expr
          format_with_parens)
       args
   | EOp op -> Print.operator ~debug fmt op
-  | ETryExcept (e_try, except, e_with) ->
-    Format.fprintf fmt "@[<v 2>%a(%a,@;%a,@;%a)@]" Print.keyword "tryWithExn"
-      format_expr e_try Print.except except format_expr e_with
 
 let rec format_statement
     (decl_ctx : decl_ctx)

compiler/scalc/to_python.ml

@@ -381,9 +381,6 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
          (format_expression ctx))
       args
   | EOp op -> Format.fprintf fmt "%a" format_op (op, Pos.no_pos)
-  | ETryExcept _ ->
-    Message.raise_internal_error
-      "Python needs TryExcept to be compiled as statements and not expressions"
 
 let rec format_statement
     (ctx : decl_ctx)

compiler/scalc/to_r.ml

@@ -385,12 +385,6 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
          (format_expression ctx))
       args
   | EOp op -> Format.fprintf fmt "%a" format_op (op, Pos.no_pos)
-  | ETryExcept (e_try, except, e_catch) ->
-    Format.fprintf fmt
-      (* TODO escape dummy__arg*)
-      "tryCatch@[<hov 2>(%a, %a = function(dummy__arg) @[<hov 2>{@;%a@;}@])@]"
-      (format_expression ctx) e_try format_exception_name except
-      (format_expression ctx) e_catch
 
 let rec format_statement
     (ctx : decl_ctx)
@@ -411,9 +405,17 @@ let rec format_statement
   | SLocalDef (v, e) ->
     Format.fprintf fmt "@[<hov 2>%a <- %a@]" format_var (Mark.remove v)
       (format_expression ctx) e
-  | STryExcept (_try_b, _except, _catch_b) ->
-    Message.raise_internal_error
-      "R needs TryExcept to be compiled as exceptions and not statements"
+  | STryExcept (try_b, except, catch_b) ->
+    Format.fprintf fmt
+      (* TODO escape dummy__arg*)
+      "tryCatch@[<hov 2>(@[<hov 2>{@;\
+       %a@;\
+       }@],@;\
+       %a = function(dummy__arg) @[<hov 2>{@;\
+       %a@;\
+       }@])@]"
+      (format_block ctx) try_b format_exception_name except (format_block ctx)
+      catch_b
   | SRaise except ->
     Format.fprintf fmt "@[<hov 2>stop(%a)@]" format_exception
       (except, Mark.get s)

runner.r

@@ -0,0 +1,3 @@
+source("test.r")
+
+foo(catala_struct_FooIn(x_in = catala_integer_from_numeric(1)))

runtimes/r/format_r_file.sh

@@ -0,0 +1,5 @@
+#! /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

runtimes/r/runtime.R

@@ -297,7 +297,7 @@ catala_assertion_failure <- function(pos) {
 
 ################ Defaults #################
 
-catala_handle_default <- function(pos, exceptions, just, cons) {
+handle_default <- function(pos, exceptions, just, cons) {
   acc <- Reduce(function(acc, exception) {
     new_val <- tryCatch(
       exception(catala_unit()),

test.r

@@ -3,49 +3,74 @@
 source("runtimes/r/runtime.R")
 
 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") }))
+  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(y = "catala_integer"), methods = list()
+)
 
 # Enum cases: "Case1" ("catala_class_S"), "Case2" ("catala_unit")
 catala_enum_E <- setRefClass("catala_enum_E",
-  fields = list(code = "character", value = "ANY"))
+  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"), methods = list()
+)
 
 
 
 foo <- function(
-  foo_in# ("catala_class_FooIn")
-  ) {
+    foo_in # ("catala_class_FooIn")
+    ) {
   x <- foo_in$x_in
-  temp_y <- function(
-    dummy_var# ("catala_unit")
-    ) {
-    stop(catala_empty_error())
-  }
-  temp_y_1 <- function(
-    dummy_var# ("catala_unit")
-    ) {
-    return(FALSE)
-  }
-  temp_y_2 <- dead_value
-  stop(catala_no_value_provided_error(catala_position(filename="test.catala_en",
-                                                      start_line=18,
-                                                      start_column=10,
-                                                      end_line=18,
-                                                      end_column=11,
-                                                      law_headings=c("Coucou",
-                                                      "Salut"))))
-  y <- tryCatch(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), catala_empty_error = function(dummy__arg) 
-                 { temp_y_2 })
+  tryCatch(
+    {
+      temp_y <- function(dummy_var # ("catala_unit")
+      ) {
+        stop(catala_empty_error())
+      }
+      temp_y_1 <- function(dummy_var # ("catala_unit")
+      ) {
+        return(FALSE)
+      }
+      temp_y_2 <- 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
+      )
+    },
+    catala_empty_error = function(dummy__arg) {
+      temp_y_2 <- dead_value
+      stop(catala_no_value_provided_error(
+        catala_position(
+          filename = "test.catala_en",
+          start_line = 18,
+          start_column = 10,
+          end_line = 18,
+          end_column = 11,
+          law_headings = c(
+            "Coucou",
+            "Salut"
+          )
+        )
+      ))
+    }
+  )
+  y <- temp_y_2
   return(Foo(y = y))
 }