balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'feature/failwith-typed' into 'dev'

Browse Source 
Feature/failwith typed

See merge request ligolang/ligo!98
This commit is contained in:
Gabriel Alfour 2019-09-26 20:25:46 +00:00
commit ebf699cde7
21 changed files with 56 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/passes/1-parser/pascaligo/AST.ml
View File

@ -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; _}

7
src/passes/1-parser/pascaligo/AST.mli
View File

@ -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;

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

@ -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" *)

7
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -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 }

5
src/passes/1-parser/pascaligo/ParserLog.ml
View File

@ -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

4
src/passes/2-simplify/pascaligo.ml
View File

@ -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 ()

4
src/passes/3-self_ast_simplified/helpers.ml
View File

@ -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

73
src/passes/4-typer/typer.ml
View File

@ -396,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 @@ needs_annotation ae "the failwith keyword"
| E_variable name ->
let%bind tv' =
trace_option (unbound_variable e name ae.location)
@ -645,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
@ -868,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

4
src/passes/6-transpiler/transpiler.ml
View File

@ -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 =

5
src/passes/operators/operators.ml
View File

@ -312,11 +312,12 @@ module Typer = struct
then ok @@ t_bytes ()
else simple_fail "bad slice"
let failwith_ = typer_1 "FAILWITH" @@ fun t ->
let failwith_ = typer_1_opt "FAILWITH" @@ fun t opt ->
let%bind () =
Assert.assert_true @@
(is_t_string t) in
ok @@ t_unit ()
let default = t_unit () in
ok @@ Simple_utils.Option.unopt ~default opt
let map_get_force = typer_2 "MAP_GET_FORCE" @@ fun i m ->
let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in

2
src/stages/ast_simplified/PP.ml
View File

@ -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

8
src/stages/ast_simplified/combinators.ml
View File

@ -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)

2
src/stages/ast_simplified/misc.ml
View File

@ -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)

1
src/stages/ast_simplified/types.ml
View File

@ -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)

1
src/stages/ast_typed/PP.ml
View File

@ -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) ->

3
src/stages/ast_typed/misc.ml
View File

@ -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

1
src/stages/ast_typed/misc_smart.ml
View File

@ -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

1
src/stages/ast_typed/types.ml
View File

@ -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)

6
src/test/contracts/coase.ligo
View File

@ -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

21
src/test/contracts/failwith.ligo
View File

@ -10,3 +10,24 @@ function main (const p : param; const s : unit) : list(operation) * unit is
end
}
with ((nil : list(operation)), s)
function foobar (const i : int) : int is
var p : param := Zero (42n) ;
block {
if i > 0 then block {
i := i + 1 ;
if i > 10 then block {
i := 20 ;
failwith ("who knows") ;
i := 30 ;
} else skip
} else block {
case p of
| Zero (n) -> failwith ("wooo")
| Pos (n) -> skip
end
}
} with case p of
| Zero (n) -> i
| Pos (n) -> (failwith ("waaaa") : int)
end

7
src/test/integration_tests.ml
View File

@ -670,6 +670,11 @@ let failwith_ligo () : unit result =
let%bind _ = should_fail (e_pair (e_constructor "Zero" (e_nat 1)) (e_unit ())) in
let%bind _ = should_work (e_pair (e_constructor "Pos" (e_nat 1)) (e_unit ())) in
let%bind _ = should_fail (e_pair (e_constructor "Pos" (e_nat 0)) (e_unit ())) in
let should_fail input = expect_fail program "foobar" (e_int input) in
let should_work input n = expect_eq program "foobar" (e_int input) (e_int n) in
let%bind () = should_fail 10 in
let%bind () = should_fail @@ -10 in
let%bind () = should_work 5 6 in
ok ()
let failwith_mligo () : unit result =
@ -698,7 +703,7 @@ let guess_string_mligo () : unit result =
in expect_eq_n program "main" make_input make_expected
let basic_mligo () : unit result =
let%bind typed = mtype_file ~debug_simplify:true "./contracts/basic.mligo" in
let%bind typed = mtype_file "./contracts/basic.mligo" in
let%bind result = Run.Of_typed.evaluate_entry typed "foo" in
Ast_typed.assert_value_eq
(Ast_typed.Combinators.e_a_empty_int (42 + 127), result)