From 7974469159241f5bc0b5a01719b82fc8aefad25b Mon Sep 17 00:00:00 2001 From: galfour Date: Thu, 26 Sep 2019 19:30:17 +0200 Subject: [PATCH] remove fail --- src/passes/1-parser/pascaligo/AST.ml | 8 -- src/passes/1-parser/pascaligo/AST.mli | 7 -- src/passes/1-parser/pascaligo/ParToken.mly | 1 - src/passes/1-parser/pascaligo/Parser.mly | 7 -- src/passes/1-parser/pascaligo/ParserLog.ml | 5 -- src/passes/2-simplify/pascaligo.ml | 4 - src/passes/3-self_ast_simplified/helpers.ml | 4 - src/passes/4-typer/typer.ml | 81 ++++++--------------- src/passes/6-transpiler/transpiler.ml | 4 - src/stages/ast_simplified/PP.ml | 2 - src/stages/ast_simplified/combinators.ml | 8 -- src/stages/ast_simplified/misc.ml | 2 +- src/stages/ast_simplified/types.ml | 1 - src/stages/ast_typed/PP.ml | 1 - src/stages/ast_typed/misc.ml | 3 +- src/stages/ast_typed/misc_smart.ml | 1 - src/stages/ast_typed/types.ml | 1 - src/test/contracts/coase.ligo | 6 +- 18 files changed, 26 insertions(+), 120 deletions(-) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index a94f3f869..dcceb87ef 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/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; _} diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index b9c7693cb..946382921 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/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; diff --git a/src/passes/1-parser/pascaligo/ParToken.mly b/src/passes/1-parser/pascaligo/ParToken.mly index 67dbaeb25..fa96d2d4b 100644 --- a/src/passes/1-parser/pascaligo/ParToken.mly +++ b/src/passes/1-parser/pascaligo/ParToken.mly @@ -54,7 +54,6 @@ %token Else (* "else" *) %token End (* "end" *) %token Entrypoint (* "entrypoint" *) -%token Fail (* "fail" *) %token For (* "for" *) %token Function (* "function" *) %token From (* "from" *) diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 96647a5ca..e8a569a31 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/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 } diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 46341e800..0074d1d1b 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/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 diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 5380e9f0e..b686c922e 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/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 () diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml index 505264b80..0793e8420 100644 --- a/src/passes/3-self_ast_simplified/helpers.ml +++ b/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 diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index d1e34fce3..391239506 100644 --- a/src/passes/4-typer/typer.ml +++ b/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 - (* Special case for assert-like failwiths. TODO: CLEAN THIS. *) - | I.Match_bool { match_false ; match_true } when I.is_e_failwith match_true -> ( - let%bind fw = I.get_e_failwith match_true in - let%bind fw' = type_expression e fw in - let%bind mf' = type_expression e match_false in - let t = get_type_annotation ex' in - let%bind () = - trace_strong (match_error ~expected:m ~actual:t ae.location) - @@ assert_t_bool t in - let%bind () = - trace_strong (match_error - ~msg:"matching not-unit on an assert" - ~expected:m - ~actual:t - ae.location) - @@ assert_t_unit (get_type_annotation mf') in - let mt' = make_a_e - (E_constant ("ASSERT_INFERRED" , [ex' ; fw'])) - (t_unit ()) - e - 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 - ) + 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 diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index ef3207d2b..70fb22545 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/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 = diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml index 1fb7cb18e..19a802419 100644 --- a/src/stages/ast_simplified/PP.ml +++ b/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 diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index 0890365d1..8e9e6c377 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/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) diff --git a/src/stages/ast_simplified/misc.ml b/src/stages/ast_simplified/misc.ml index ec9044c8a..3f5ec705d 100644 --- a/src/stages/ast_simplified/misc.ml +++ 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) diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml index ea42d849d..ca30d42b4 100644 --- a/src/stages/ast_simplified/types.ml +++ 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) diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index 96825ecc3..fb8923ea9 100644 --- a/src/stages/ast_typed/PP.ml +++ b/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) -> diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index db33f6062..5ba66b4ea 100644 --- a/src/stages/ast_typed/misc.ml +++ b/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 diff --git a/src/stages/ast_typed/misc_smart.ml b/src/stages/ast_typed/misc_smart.ml index 10e52d2e6..f84180312 100644 --- a/src/stages/ast_typed/misc_smart.ml +++ 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 diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index fc297b593..d0b8ee2bb 100644 --- a/src/stages/ast_typed/types.ml +++ b/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) diff --git a/src/test/contracts/coase.ligo b/src/test/contracts/coase.ligo index ea7f9d057..04b891c7d 100644 --- a/src/test/contracts/coase.ligo +++ b/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