Remove the now unused HandleDefault operator

(we now only need HandleDefaultOpt)

compiler/lcalc/to_ocaml.ml

@@ -411,7 +411,7 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
     Format.fprintf fmt "%a" format_with_parens arg1
   | EAppOp
       {
-        op = ((HandleDefault | HandleDefaultOpt) as op), _;
+        op = (HandleDefaultOpt as op), _;
         args = (EArray excs, _) :: _ as args;
         _;
       } ->

compiler/plugins/explain.ml

@@ -1085,7 +1085,6 @@ let expr_to_dot_label0 :
           | Reduce -> xlang () ~en:"reduce" ~fr:"réunion"
           | Filter -> xlang () ~en:"filter" ~fr:"filtre"
           | Fold -> xlang () ~en:"fold" ~fr:"pliage"
-          | HandleDefault -> ""
           | HandleDefaultOpt -> ""
           | ToClosureEnv -> ""
           | FromClosureEnv -> ""

compiler/scalc/to_c.ml

@@ -313,7 +313,6 @@ 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"
-  | HandleDefault -> Format.pp_print_string fmt "catala_handle_default"
   | HandleDefaultOpt | FromClosureEnv | ToClosureEnv | Map2 ->
     failwith "unimplemented"
 
@@ -368,7 +367,7 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
     Format.fprintf fmt "%a %a" format_op op (format_expression ctx) arg1
   | EAppOp { op; args = [arg1] } ->
     Format.fprintf fmt "%a(%a)" format_op op (format_expression ctx) arg1
-  | EAppOp { op = (HandleDefaultOpt | HandleDefault), _; args = _ } ->
+  | EAppOp { op = HandleDefaultOpt, _; args = _ } ->
     failwith "should not happen because of keep_special_ops"
   | EApp { f; args } ->
     Format.fprintf fmt "%a(@[<hov 0>%a)@]" (format_expression ctx) f

compiler/scalc/to_python.ml

@@ -88,7 +88,6 @@ let format_op (fmt : Format.formatter) (op : operator Mark.pos) : unit =
   | Reduce -> Format.pp_print_string fmt "list_reduce"
   | Filter -> Format.pp_print_string fmt "list_filter"
   | Fold -> Format.pp_print_string fmt "list_fold_left"
-  | HandleDefault -> Format.pp_print_string fmt "handle_default"
   | HandleDefaultOpt -> Format.pp_print_string fmt "handle_default_opt"
   | FromClosureEnv | ToClosureEnv -> failwith "unimplemented"
 
@@ -349,7 +348,7 @@ let rec format_expression ctx (fmt : Format.formatter) (e : expr) : unit =
     Format.fprintf fmt "%a %a" format_op op (format_expression ctx) arg1
   | EAppOp { op; args = [arg1] } ->
     Format.fprintf fmt "%a(%a)" format_op op (format_expression ctx) arg1
-  | EAppOp { op = ((HandleDefault | HandleDefaultOpt), _) as op; args } ->
+  | EAppOp { op = (HandleDefaultOpt, _) as op; args } ->
     let pos = Mark.get e in
     Format.fprintf fmt
       "%a(@[<hov 0>SourcePosition(filename=\"%s\",@ start_line=%d,@ \

compiler/scalc/to_r.ml

@@ -103,7 +103,6 @@ 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"
-  | HandleDefault -> Format.pp_print_string fmt "catala_handle_default"
   | HandleDefaultOpt | FromClosureEnv | ToClosureEnv -> failwith "unimplemented"
 
 let format_string_list (fmt : Format.formatter) (uids : string list) : unit =
@@ -324,18 +323,19 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
   | EAppOp { op = HandleDefaultOpt, _; _ } ->
     Message.error ~internal:true
       "R compilation does not currently support the avoiding of exceptions"
-  | EAppOp { op = (HandleDefault as op), _; args; _ } ->
-    let pos = Mark.get e in
-    Format.fprintf fmt
-      "%a(@[<hov 0>catala_position(filename=\"%s\",@ start_line=%d,@ \
-       start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)@]"
-      format_op (op, pos) (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.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
-         (format_expression ctx))
-      args
+  (* TODO: port the following to avoid-exceptions
+   * | EAppOp { op = (HandleDefault as op), _; args; _ } ->
+   *   let pos = Mark.get e in
+   *   Format.fprintf fmt
+   *     "%a(@[<hov 0>catala_position(filename=\"%s\",@ start_line=%d,@ \
+   *      start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)@]"
+   *     format_op (op, pos) (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.pp_print_list
+   *        ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
+   *        (format_expression ctx))
+   *     args *)
   | EApp { f = EFunc x, pos; args }
     when Ast.FuncName.compare x Ast.handle_default = 0
          || Ast.FuncName.compare x Ast.handle_default_opt = 0 ->

compiler/shared_ast/definitions.ml

@@ -372,7 +372,6 @@ module Op = struct
     (* * polymorphic *)
     | Reduce : < polymorphic ; .. > t
     | Fold : < polymorphic ; .. > t
-    | HandleDefault : < polymorphic ; .. > t
     | HandleDefaultOpt : < polymorphic ; .. > t
 end
 

compiler/shared_ast/interpreter.ml

@@ -422,35 +422,6 @@ let rec evaluate_operator
     ELit (LBool (o_eq_dat_dat x y))
   | Eq_dur_dur, [(ELit (LDuration x), _); (ELit (LDuration y), _)] ->
     ELit (LBool (o_eq_dur_dur (rpos ()) x y))
-  | HandleDefault, [(EArray excepts, _); just; cons] -> (
-    (* This case is for lcalc with exceptions: we rely OCaml exception handling
-       here *)
-    match
-      List.filter_map
-        (fun e ->
-          try Some (evaluate_expr (Expr.unthunk_term_nobox e))
-          with Runtime.Empty -> None)
-        excepts
-    with
-    | [] -> (
-      let just = evaluate_expr (Expr.unthunk_term_nobox just) in
-      match Mark.remove just with
-      | ELit (LBool true) ->
-        Mark.remove (evaluate_expr (Expr.unthunk_term_nobox cons))
-      | ELit (LBool false) -> raise Runtime.Empty
-      | _ ->
-        Message.error ~pos
-          "Default justification has not been reduced to a boolean at@ \
-           evaluation@ (should not happen if the term was well-typed@\n\
-           %a@."
-          Expr.format just)
-    | [e] -> Mark.remove e
-    | es ->
-      raise
-        Runtime.(
-          Error
-            (Conflict, List.map (fun e -> Expr.pos_to_runtime (Expr.pos e)) es))
-    )
   | HandleDefaultOpt, [(EArray exps, _); justification; conclusion] -> (
     let valid_exceptions =
       ListLabels.filter exps ~f:(function
@@ -501,8 +472,7 @@ let rec evaluate_operator
       | Lte_mon_mon | Lte_dat_dat | Lte_dur_dur | Gt_int_int | Gt_rat_rat
       | Gt_mon_mon | Gt_dat_dat | Gt_dur_dur | Gte_int_int | Gte_rat_rat
       | Gte_mon_mon | Gte_dat_dat | Gte_dur_dur | Eq_int_int | Eq_rat_rat
-      | Eq_mon_mon | Eq_dat_dat | Eq_dur_dur | HandleDefault | HandleDefaultOpt
-        ),
+      | Eq_mon_mon | Eq_dat_dat | Eq_dur_dur | HandleDefaultOpt ),
       _ ) ->
     err ()
 

compiler/shared_ast/operator.ml

@@ -108,7 +108,6 @@ let name : type a. a t -> string = function
   | Eq_dur_dur -> "o_eq_dur_dur"
   | Eq_dat_dat -> "o_eq_dat_dat"
   | Fold -> "o_fold"
-  | HandleDefault -> "o_handledefault"
   | HandleDefaultOpt -> "o_handledefaultopt"
   | ToClosureEnv -> "o_toclosureenv"
   | FromClosureEnv -> "o_fromclosureenv"
@@ -232,7 +231,6 @@ let compare (type a1 a2) (t1 : a1 t) (t2 : a2 t) =
   | Eq_dat_dat, Eq_dat_dat
   | Eq_dur_dur, Eq_dur_dur
   | Fold, Fold
-  | HandleDefault, HandleDefault
   | HandleDefaultOpt, HandleDefaultOpt
   | FromClosureEnv, FromClosureEnv | ToClosureEnv, ToClosureEnv -> 0
   | Not, _ -> -1 | _, Not -> 1
@@ -318,7 +316,6 @@ let compare (type a1 a2) (t1 : a1 t) (t2 : a2 t) =
   | Eq_mon_mon, _ -> -1 | _, Eq_mon_mon -> 1
   | Eq_dat_dat, _ -> -1 | _, Eq_dat_dat -> 1
   | Eq_dur_dur, _ -> -1 | _, Eq_dur_dur -> 1
-  | HandleDefault, _ -> -1 | _, HandleDefault -> 1
   | HandleDefaultOpt, _ -> -1 | _, HandleDefaultOpt -> 1
   | FromClosureEnv, _ -> -1 | _, FromClosureEnv -> 1
   | ToClosureEnv, _ -> -1 | _, ToClosureEnv -> 1
@@ -344,7 +341,7 @@ let kind_dispatch :
       _ ) as op ->
     monomorphic op
   | ( ( Log _ | Length | Eq | Map | Map2 | Concat | Filter | Reduce | Fold
-      | HandleDefault | HandleDefaultOpt | FromClosureEnv | ToClosureEnv ),
+      | HandleDefaultOpt | FromClosureEnv | ToClosureEnv ),
       _ ) as op ->
     polymorphic op
   | ( ( Minus | ToRat | ToMoney | Round | Add | Sub | Mult | Div | Lt | Lte | Gt
@@ -377,19 +374,19 @@ type 'a no_overloads =
 let translate (t : 'a no_overloads t Mark.pos) : 'b no_overloads t Mark.pos =
   match t with
   | ( ( Not | GetDay | GetMonth | GetYear | FirstDayOfMonth | LastDayOfMonth
-      | And | Or | Xor | HandleDefault | HandleDefaultOpt | Log _ | Length | Eq
-      | Map | Map2 | Concat | Filter | Reduce | Fold | Minus_int | Minus_rat
-      | Minus_mon | Minus_dur | ToRat_int | ToRat_mon | ToMoney_rat | Round_rat
-      | Round_mon | Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur _
-      | Add_dur_dur | Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat
-      | Sub_dat_dur | Sub_dur_dur | Mult_int_int | Mult_rat_rat | Mult_mon_rat
-      | Mult_dur_int | Div_int_int | Div_rat_rat | Div_mon_mon | Div_mon_rat
-      | Div_dur_dur | Lt_int_int | Lt_rat_rat | Lt_mon_mon | Lt_dat_dat
-      | Lt_dur_dur | Lte_int_int | Lte_rat_rat | Lte_mon_mon | Lte_dat_dat
-      | Lte_dur_dur | Gt_int_int | Gt_rat_rat | Gt_mon_mon | Gt_dat_dat
-      | Gt_dur_dur | Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dat_dat
-      | Gte_dur_dur | Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dat_dat
-      | Eq_dur_dur | FromClosureEnv | ToClosureEnv ),
+      | And | Or | Xor | HandleDefaultOpt | Log _ | Length | Eq | Map | Map2
+      | Concat | Filter | Reduce | Fold | Minus_int | Minus_rat | Minus_mon
+      | Minus_dur | ToRat_int | ToRat_mon | ToMoney_rat | Round_rat | Round_mon
+      | Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur _ | Add_dur_dur
+      | Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat | Sub_dat_dur
+      | Sub_dur_dur | Mult_int_int | Mult_rat_rat | Mult_mon_rat | Mult_dur_int
+      | Div_int_int | Div_rat_rat | Div_mon_mon | Div_mon_rat | Div_dur_dur
+      | Lt_int_int | Lt_rat_rat | Lt_mon_mon | Lt_dat_dat | Lt_dur_dur
+      | Lte_int_int | Lte_rat_rat | Lte_mon_mon | Lte_dat_dat | Lte_dur_dur
+      | Gt_int_int | Gt_rat_rat | Gt_mon_mon | Gt_dat_dat | Gt_dur_dur
+      | Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dat_dat | Gte_dur_dur
+      | Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dat_dat | Eq_dur_dur
+      | FromClosureEnv | ToClosureEnv ),
       _ ) as op ->
     op
 

compiler/shared_ast/print.ml

@@ -280,7 +280,6 @@ let operator_to_string : type a. a Op.t -> string =
   | Eq_dur_dur -> "=^"
   | Eq_dat_dat -> "=@"
   | Fold -> "fold"
-  | HandleDefault -> "handle_default"
   | HandleDefaultOpt -> "handle_default_opt"
   | ToClosureEnv -> "to_closure_env"
   | FromClosureEnv -> "from_closure_env"
@@ -325,7 +324,6 @@ let operator_to_shorter_string : type a. a Op.t -> string =
   | Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dur_dur | Gte_dat_dat | Gte ->
     ">="
   | Fold -> "fold"
-  | HandleDefault -> "handle_default"
   | HandleDefaultOpt -> "handle_default_opt"
   | ToClosureEnv -> "to_closure_env"
   | FromClosureEnv -> "from_closure_env"
@@ -402,8 +400,8 @@ module Precedence = struct
       | Div | Div_int_int | Div_rat_rat | Div_mon_rat | Div_mon_mon
       | Div_dur_dur ->
         Op Div
-      | HandleDefault | HandleDefaultOpt | Map | Map2 | Concat | Filter | Reduce
-      | Fold | ToClosureEnv | FromClosureEnv ->
+      | HandleDefaultOpt | Map | Map2 | Concat | Filter | Reduce | Fold
+      | ToClosureEnv | FromClosureEnv ->
         App)
     | EApp _ -> App
     | EArray _ -> Contained

compiler/shared_ast/typing.ml

@@ -314,7 +314,6 @@ let polymorphic_op_type (op : Operator.polymorphic A.operator Mark.pos) :
     | Log (PosRecordIfTrueBool, _) -> [bt] @-> bt
     | Log _ -> [any] @-> any
     | Length -> [array any] @-> it
-    | HandleDefault -> [array ([ut] @-> any); [ut] @-> bt; [ut] @-> any] @-> any
     | HandleDefaultOpt ->
       [array (option any); [ut] @-> bt; [ut] @-> option any] @-> option any
     | ToClosureEnv -> [any] @-> cet
@@ -348,7 +347,7 @@ let polymorphic_op_return_type
   | Log (PosRecordIfTrueBool, _), _ -> uf (TLit TBool)
   | Log _, [tau] -> tau
   | Length, _ -> uf (TLit TInt)
-  | (HandleDefault | HandleDefaultOpt), [_; _; tf] -> return_type tf 1
+  | HandleDefaultOpt, [_; _; tf] -> return_type tf 1
   | ToClosureEnv, _ -> uf TClosureEnv
   | FromClosureEnv, _ -> any ()
   | _ -> Message.error ~pos "Mismatched operator arguments"

runtimes/ocaml/runtime.ml

@@ -716,27 +716,6 @@ module EventParser = struct
     ctx.events
 end
 
-let handle_default :
-      'a.
-      source_position array ->
-      (unit -> 'a) array ->
-      (unit -> bool) ->
-      (unit -> 'a) ->
-      'a =
- fun pos exceptions just cons ->
-  let len = Array.length exceptions in
-  let rec filt_except i =
-    if i < len then
-      match exceptions.(i) () with
-      | new_val -> (new_val, i) :: filt_except (i + 1)
-      | exception Empty -> filt_except (i + 1)
-    else []
-  in
-  match filt_except 0 with
-  | [] -> if just () then cons () else raise Empty
-  | [(res, _)] -> res
-  | res -> error Conflict (List.map (fun (_, i) -> pos.(i)) res)
-
 let handle_default_opt
     (pos : source_position array)
     (exceptions : 'a Eoption.t array)

runtimes/ocaml/runtime.mli

@@ -335,15 +335,6 @@ val duration_to_string : duration -> string
 
 (**{1 Defaults} *)
 
-val handle_default :
-  source_position array ->
-  (unit -> 'a) array ->
-  (unit -> bool) ->
-  (unit -> 'a) ->
-  'a
-(** @raise Empty
-    @raise Error Conflict *)
-
 val handle_default_opt :
   source_position array ->
   'a Eoption.t array ->

runtimes/python/src/catala/runtime.py

@@ -606,34 +606,6 @@ def list_length(l: List[Alpha]) -> Integer:
 # ========
 
 
-def handle_default(
-    pos: SourcePosition,
-    exceptions: List[Callable[[Unit], Alpha]],
-    just: Callable[[Unit], Alpha],
-    cons: Callable[[Unit], Alpha]
-) -> Alpha:
-    acc: Optional[Alpha] = None
-    for exception in exceptions:
-        new_val: Optional[Alpha]
-        try:
-            new_val = exception(Unit())
-        except Empty:
-            new_val = None
-        if acc is None:
-            acc = new_val
-        elif not (acc is None) and new_val is None:
-            pass  # acc stays the same
-        elif not (acc is None) and not (new_val is None):
-            raise Conflict(pos)
-    if acc is None:
-        if just(Unit()):
-            return cons(Unit())
-        else:
-            raise Empty
-    else:
-        return acc
-
-
 def handle_default_opt(
     pos: SourcePosition,
     exceptions: List[Optional[Any]],

runtimes/r/NAMESPACE

@@ -16,7 +16,6 @@ export(catala_decimal_to_numeric)
 export(catala_duration_from_ymd)
 export(catala_duration_to_ymd)
 export(catala_empty_error)
-export(catala_handle_default)
 export(catala_integer_from_numeric)
 export(catala_integer_from_string)
 export(catala_integer_to_numeric)

runtimes/r/R/runtime.R

@@ -363,36 +363,6 @@ catala_assertion_failure <- function(pos) {
 
 ################ Defaults #################
 
-#' @export
-catala_handle_default <- function(pos, exceptions, just, cons) {
-  acc <- Reduce(function(acc, exception) {
-    new_val <- tryCatch(
-      exception(new("catala_unit", v = 0)),
-      catala_empty_error = function(e) {
-        NULL
-      }
-    )
-    if (is.null(acc)) {
-      new_val
-    } else {
-      if (is.null(new_val)) {
-        acc
-      } else {
-        stop(catala_conflict_error(pos))
-      }
-    }
-  }, exceptions, NULL)
-  if (is.null(acc)) {
-    if (just(new("catala_unit", v = 0))) {
-      cons(new("catala_unit", v = 0))
-    } else {
-      stop(catala_empty_error())
-    }
-  } else {
-    acc
-  }
-}
-
 # 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