remove fail

src/passes/1-parser/pascaligo/AST.ml

@@ -50,7 +50,6 @@ type kwd_down       = Region.t
 type kwd_else       = Region.t
 type kwd_end        = Region.t
 type kwd_entrypoint = Region.t
-type kwd_fail       = Region.t
 type kwd_for        = Region.t
 type kwd_from       = Region.t
 type kwd_function   = Region.t
@@ -343,7 +342,6 @@ and single_instr =
 | Assign      of assignment reg
 | Loop        of loop
 | ProcCall    of fun_call
-| Fail        of fail_instr reg
 | Skip        of kwd_skip
 | RecordPatch of record_patch reg
 | MapPatch    of map_patch reg
@@ -394,11 +392,6 @@ and record_patch = {
   record_inj : record_expr
 }
 
-and fail_instr = {
-  kwd_fail  : kwd_fail;
-  fail_expr : expr
-}
-
 and conditional = {
   kwd_if     : kwd_if;
   test       : expr;
@@ -757,7 +750,6 @@ let instr_to_region = function
 | Single Loop For ForCollect {region; _}
 | Single ProcCall            {region; _}
 | Single Skip                region
-| Single Fail                {region; _}
 | Single RecordPatch         {region; _}
 | Single MapPatch            {region; _}
 | Single SetPatch            {region; _}

src/passes/1-parser/pascaligo/AST.mli

@@ -34,7 +34,6 @@ type kwd_down       = Region.t
 type kwd_else       = Region.t
 type kwd_end        = Region.t
 type kwd_entrypoint = Region.t
-type kwd_fail       = Region.t
 type kwd_for        = Region.t
 type kwd_from       = Region.t
 type kwd_function   = Region.t
@@ -327,7 +326,6 @@ and single_instr =
 | Assign      of assignment reg
 | Loop        of loop
 | ProcCall    of fun_call
-| Fail        of fail_instr reg
 | Skip        of kwd_skip
 | RecordPatch of record_patch reg
 | MapPatch    of map_patch reg
@@ -378,11 +376,6 @@ and record_patch = {
   record_inj : field_assign reg injection reg
 }
 
-and fail_instr = {
-  kwd_fail  : kwd_fail;
-  fail_expr : expr
-}
-
 and conditional = {
   kwd_if     : kwd_if;
   test       : expr;

src/passes/1-parser/pascaligo/ParToken.mly

@@ -54,7 +54,6 @@
 %token <Region.t> Else        (* "else"       *)
 %token <Region.t> End         (* "end"        *)
 %token <Region.t> Entrypoint  (* "entrypoint" *)
-%token <Region.t> Fail        (* "fail"       *)
 %token <Region.t> For         (* "for"        *)
 %token <Region.t> Function    (* "function"   *)
 %token <Region.t> From        (* "from"       *)

src/passes/1-parser/pascaligo/Parser.mly

@@ -445,7 +445,6 @@ single_instr:
 | assignment   {      Assign $1 }
 | loop         {        Loop $1 }
 | proc_call    {    ProcCall $1 }
-| fail_instr   {        Fail $1 }
 | Skip         {        Skip $1 }
 | record_patch { RecordPatch $1 }
 | map_patch    {    MapPatch $1 }
@@ -555,12 +554,6 @@ record_patch:
       record_inj = $4}
     in {region; value}}
 
-fail_instr:
-  Fail expr {
-    let region = cover $1 (expr_to_region $2)
-    and value  = {kwd_fail = $1; fail_expr = $2}
-    in {region; value}}
-
 proc_call:
   fun_call { $1 }
 

src/passes/1-parser/pascaligo/ParserLog.ml

@@ -287,7 +287,6 @@ and print_single_instr = function
 | Assign      assign     -> print_assignment assign
 | Loop        loop       -> print_loop loop
 | ProcCall    fun_call   -> print_fun_call fun_call
-| Fail        {value; _} -> print_fail value
 | Skip        kwd_skip   -> print_token kwd_skip "skip"
 | RecordPatch {value; _} -> print_record_patch value
 | MapPatch    {value; _} -> print_map_patch value
@@ -295,10 +294,6 @@ and print_single_instr = function
 | MapRemove   {value; _} -> print_map_remove value
 | SetRemove   {value; _} -> print_set_remove value
 
-and print_fail {kwd_fail; fail_expr} =
-  print_token kwd_fail "fail";
-  print_expr fail_expr
-
 and print_conditional node =
   let {kwd_if; test; kwd_then; ifso; terminator;
        kwd_else; ifnot} = node in

src/passes/2-simplify/pascaligo.ml

@@ -787,10 +787,6 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
           let%bind lst = bind_map_list simpl_expression args' in
           return_statement @@ e_constant ~loc s lst
     )
-  | Fail e -> (
-      let%bind expr = simpl_expression e.value.fail_expr in
-      return_statement @@ e_failwith expr
-    )
   | Skip reg -> (
       let loc = Location.lift reg in
       return_statement @@ e_skip ~loc ()

src/passes/3-self_ast_simplified/helpers.ml

@@ -45,10 +45,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
       let%bind path' = map_path f path in
       return @@ E_assign (name , path' , e')
     )
-  | E_failwith e -> (
-      let%bind e' = self e in
-      return @@ E_failwith e'
-    )
   | E_matching (e , cases) -> (
       let%bind e' = self e in
       let%bind cases' = map_cases f cases in

src/passes/4-typer/typer.ml

@@ -206,14 +206,6 @@ module Errors = struct
     ] in
     error ~data title message ()
 
-  let deprecated_fail (ae : I.expression) () =
-    let title () = "fail is deprecated, use failwith instead" in
-    let message = title in
-    let data = [
-      ("location" , fun () -> Format.asprintf "%a" Location.pp ae.location) ;
-    ] in
-    error ~data title message ()
-
   let constant_error loc lst tv_opt =
     let title () = "typing constant" in
     let message () = "" in
@@ -404,7 +396,6 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
   trace main_error @@
   match ae.expression with
   (* Basic *)
-  | E_failwith _ -> fail @@ deprecated_fail ae
   | E_variable name ->
       let%bind tv' =
         trace_option (unbound_variable e name ae.location)
@@ -653,54 +644,27 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
   (* Advanced *)
   | E_matching (ex, m) -> (
       let%bind ex' = type_expression e ex in
-      match m with
+      let%bind m' = type_match (type_expression ?tv_opt:None) e ex'.type_annotation m ae ae.location in
-      (* Special case for assert-like failwiths. TODO: CLEAN THIS. *)
+      let tvs =
-      | I.Match_bool { match_false ; match_true } when I.is_e_failwith match_true -> (
+        let aux (cur:O.value O.matching) =
-          let%bind fw = I.get_e_failwith match_true in
+          match cur with
-          let%bind fw' = type_expression e fw in
+          | Match_bool { match_true ; match_false } -> [ match_true ; match_false ]
-          let%bind mf' = type_expression e match_false in
+          | Match_list { match_nil ; match_cons = ((_ , _) , match_cons) } -> [ match_nil ; match_cons ]
-          let t = get_type_annotation ex' in
+          | Match_option { match_none ; match_some = (_ , match_some) } -> [ match_none ; match_some ]
-          let%bind () =
+          | Match_tuple (_ , match_tuple) -> [ match_tuple ]
-            trace_strong (match_error ~expected:m ~actual:t ae.location)
+          | Match_variant (lst , _) -> List.map snd lst in
-            @@ assert_t_bool t in
+        List.map get_type_annotation @@ aux m' in
-          let%bind () =
+      let aux prec cur =
-            trace_strong (match_error
+        let%bind () =
-                            ~msg:"matching not-unit on an assert"
+          match prec with
-                            ~expected:m
+          | None -> ok ()
-                            ~actual:t
+          | Some cur' -> Ast_typed.assert_type_value_eq (cur , cur') in
-                            ae.location)
+        ok (Some cur) in
-            @@ assert_t_unit (get_type_annotation mf') in
+      let%bind tv_opt = bind_fold_list aux None tvs in
-          let mt' = make_a_e
+      let%bind tv =
-              (E_constant ("ASSERT_INFERRED" , [ex' ; fw']))
+        trace_option (match_empty_variant m ae.location) @@
-              (t_unit ())
+        tv_opt in
-              e
+      return (O.E_matching (ex', m')) tv
-          in
-          let m' = O.Match_bool { match_true = mt' ; match_false = mf' } in
-          return (O.E_matching (ex' , m')) (t_unit ())
-        )
-      | _ -> (
-          let%bind m' = type_match (type_expression ?tv_opt:None) e ex'.type_annotation m ae ae.location in
-          let tvs =
-            let aux (cur:O.value O.matching) =
-              match cur with
-              | Match_bool { match_true ; match_false } -> [ match_true ; match_false ]
-              | Match_list { match_nil ; match_cons = ((_ , _) , match_cons) } -> [ match_nil ; match_cons ]
-              | Match_option { match_none ; match_some = (_ , match_some) } -> [ match_none ; match_some ]
-              | Match_tuple (_ , match_tuple) -> [ match_tuple ]
-              | Match_variant (lst , _) -> List.map snd lst in
-            List.map get_type_annotation @@ aux m' in
-          let aux prec cur =
-            let%bind () =
-              match prec with
-              | None -> ok ()
-              | Some cur' -> Ast_typed.assert_type_value_eq (cur , cur') in
-            ok (Some cur) in
-          let%bind tv_opt = bind_fold_list aux None tvs in
-          let%bind tv =
-            trace_option (match_empty_variant m ae.location) @@
-            tv_opt in
-          return (O.E_matching (ex', m')) tv
-        )
     )
   | E_sequence (a , b) ->
     let%bind a' = type_expression e a in
@@ -876,9 +840,6 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
       let%bind ae' = untype_expression ae in
       let%bind m' = untype_matching untype_expression m in
       return (e_matching ae' m')
-  | E_failwith ae ->
-      let%bind ae' = untype_expression ae in
-      return (e_failwith ae')
   | E_sequence _
   | E_loop _
   | E_assign _ -> fail @@ not_supported_yet_untranspile "not possible to untranspile statements yet" e.expression

src/passes/6-transpiler/transpiler.ml

@@ -253,10 +253,6 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
     let%bind rhs' = transpile_annotated_expression rhs in
     let%bind result' = transpile_annotated_expression result in
     return (E_let_in ((binder, rhs'.type_value), rhs', result'))
-  | E_failwith ae -> (
-      let%bind ae' = transpile_annotated_expression ae in
-      return @@ E_constant ("FAILWITH" , [ae'])
-    )
   | E_literal l -> return @@ E_literal (transpile_literal l)
   | E_variable name -> (
       let%bind ele =

src/stages/ast_simplified/PP.ml

@@ -52,8 +52,6 @@ let rec expression ppf (e:expression) = match e.expression with
         expression result
   | E_matching (ae, m) ->
       fprintf ppf "match %a with %a" expression ae (matching expression) m
-  | E_failwith ae ->
-      fprintf ppf "failwith %a" expression ae
   | E_sequence (a , b) ->
     fprintf ppf "%a ; %a"
       expression a

src/stages/ast_simplified/combinators.ml

@@ -84,7 +84,6 @@ let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {mat
 let e_accessor ?loc a b = location_wrap ?loc @@ E_accessor (a , b)
 let e_accessor_props ?loc a b = e_accessor ?loc a (List.map (fun x -> Access_record x) b)
 let e_variable ?loc v = location_wrap ?loc @@ E_variable v
-let e_failwith ?loc v = location_wrap ?loc @@ E_failwith v
 let e_skip ?loc () = location_wrap ?loc @@ E_skip
 let e_loop ?loc cond body = location_wrap ?loc @@ E_loop (cond , body)
 let e_sequence ?loc a b = location_wrap ?loc @@ E_sequence (a , b)
@@ -167,13 +166,6 @@ let get_e_tuple = fun t ->
   | E_tuple lst -> ok lst
   | _ -> simple_fail "not a tuple"
 
-let get_e_failwith = fun e ->
-  match e.expression with
-  | E_failwith fw -> ok fw
-  | _ -> simple_fail "not a failwith"
-
-let is_e_failwith e = to_bool @@ get_e_failwith e
-
 let extract_pair : expression -> (expression * expression) result = fun e ->
   match e.expression with
   | E_tuple [ a ; b ] -> ok (a , b)

src/stages/ast_simplified/misc.ml

@@ -163,7 +163,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | (E_variable _, _) | (E_lambda _, _)
   | (E_application _, _) | (E_let_in _, _)
   | (E_accessor _, _)
-  | (E_look_up _, _) | (E_matching _, _) | (E_failwith _, _) | (E_sequence _, _)
+  | (E_look_up _, _) | (E_matching _, _) | (E_sequence _, _)
   | (E_loop _, _) | (E_assign _, _) | (E_skip, _) -> simple_fail "comparing not a value"
 
 let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)

src/stages/ast_simplified/types.ml

@@ -65,7 +65,6 @@ and expression' =
   | E_look_up of (expr * expr)
   (* Matching *)
   | E_matching of (expr * matching_expr)
-  | E_failwith of expr
   (* Replace Statements *)
   | E_sequence of (expr * expr)
   | E_loop of (expr * expr)

src/stages/ast_typed/PP.ml

@@ -47,7 +47,6 @@ and expression ppf (e:expression) : unit =
   | E_look_up (ds, i) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression i
   | E_matching (ae, m) ->
       fprintf ppf "match %a with %a" annotated_expression ae (matching annotated_expression) m
-  | E_failwith ae -> fprintf ppf "failwith %a" annotated_expression ae
   | E_sequence (a , b) -> fprintf ppf "%a ; %a" annotated_expression a annotated_expression b
   | E_loop (expr , body) -> fprintf ppf "while %a { %a }" annotated_expression expr annotated_expression body
   | E_assign (name , path , expr) ->

src/stages/ast_typed/misc.ml

@@ -176,7 +176,6 @@ module Free_variables = struct
     | (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
     | E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
     | E_matching (a , cs) -> union (self a) (matching_expression b cs)
-    | E_failwith a -> self a
     | E_sequence (a , b) -> unions @@ List.map self [ a ; b ]
     | E_loop (expr , body) -> unions @@ List.map self [ expr ; body ]
     | E_assign (_ , _ , expr) -> self expr
@@ -476,7 +475,7 @@ let rec assert_value_eq (a, b: (value*value)) : unit result =
   | (E_literal _, _) | (E_variable _, _) | (E_application _, _)
   | (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _)
   | (E_record_accessor _, _)
-  | (E_look_up _, _) | (E_matching _, _) | (E_failwith _, _)
+  | (E_look_up _, _) | (E_matching _, _)
   | (E_assign _ , _)
   | (E_sequence _, _) | (E_loop _, _)-> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b
 

src/stages/ast_typed/misc_smart.ml

@@ -88,7 +88,6 @@ module Captured_variables = struct
       let%bind a' = self a in
       let%bind cs' = matching_expression b cs in
       ok @@ union a' cs'
-    | E_failwith a -> self a
     | E_sequence (_ , b) -> self b
     | E_loop (expr , body) ->
       let%bind lst' = bind_map_list self [ expr ; body ] in

src/stages/ast_typed/types.ml

@@ -105,7 +105,6 @@ and expression =
   | E_look_up of (ae * ae)
   (* Advanced *)
   | E_matching of (ae * matching_expr)
-  | E_failwith of ae
   (* Replace Statements *)
   | E_sequence of (ae * ae)
   | E_loop of (ae * ae)

src/test/contracts/coase.ligo

@@ -41,7 +41,7 @@ function transfer_single(const action : action_transfer_single ; const s : stora
   begin
     const cards : cards = s.cards ;
     const card : card = get_force(action.card_to_transfer , cards) ;
-    if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ;
+    if (card.card_owner =/= source) then failwith ("This card doesn't belong to you") else skip ;
     card.card_owner := action.destination ;
     cards[action.card_to_transfer] := card ;
     s.cards := cards ;
@@ -51,7 +51,7 @@ function transfer_single(const action : action_transfer_single ; const s : stora
 function sell_single(const action : action_sell_single ; const s : storage_type) : (list(operation) * storage_type) is
   begin
     const card : card = get_force(action.card_to_sell , s.cards) ;
-    if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ;
+    if (card.card_owner =/= source) then failwith ("This card doesn't belong to you") else skip ;
     const card_pattern : card_pattern = get_force(card.card_pattern , s.card_patterns) ;
     card_pattern.quantity := abs(card_pattern.quantity - 1n);
     const card_patterns : card_patterns = s.card_patterns ;
@@ -71,7 +71,7 @@ function buy_single(const action : action_buy_single ; const s : storage_type) :
     // Check funds
     const card_pattern : card_pattern = get_force(action.card_to_buy , s.card_patterns) ;
     const price : tez = card_pattern.coefficient * (card_pattern.quantity + 1n) ;
-    if (price > amount) then fail "Not enough money" else skip ;
+    if (price > amount) then failwith ("Not enough money") else skip ;
     // Administrative procedure
     const operations : list(operation) = nil ;
     // Increase quantity