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

I forbade empty patches (parser). Fixed AST pretty-printer (PascaLIGO).

Browse Source 
Changed accordingly the simplifier: the dead code for the error about
empty record patches is no long.
This commit is contained in:
Christian Rinderknecht 2019-10-23 00:35:29 +02:00
parent 0467868bb2
commit eae3348d51
8 changed files with 147 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -187,7 +187,7 @@ and type_decl = {
and type_expr =
TProd of cartesian
| TSum of (variant reg, vbar) nsepseq reg
| TRecord of field_decl reg injection reg
| TRecord of field_decl reg ne_injection reg
| TApp of (type_name * type_tuple) reg
| TFun of (type_expr * arrow * type_expr) reg
| TPar of type_expr par reg
@ -217,7 +217,7 @@ and fun_decl = {
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
local_decls : local_decl list option;
local_decls : local_decl list;
block : block reg option;
kwd_with : kwd_with option;
return : expr;
@ -315,14 +315,14 @@ and set_patch = {
kwd_patch : kwd_patch;
path : path;
kwd_with : kwd_with;
set_inj : expr injection reg
set_inj : expr ne_injection reg
}
and map_patch = {
kwd_patch : kwd_patch;
path : path;
kwd_with : kwd_with;
map_inj : binding reg injection reg
map_inj : binding reg ne_injection reg
}
and binding = {
@ -335,7 +335,7 @@ and record_patch = {
kwd_patch : kwd_patch;
path : path;
kwd_with : kwd_with;
record_inj : record_expr
record_inj : field_assign reg ne_injection reg
}
and cond_expr = {
@ -479,6 +479,13 @@ and 'a injection = {
closing : closing
}
and 'a ne_injection = {
opening : opening;
ne_elements : ('a, semi) nsepseq;
terminator : semi option;
closing : closing
}
and opening =
Kwd of keyword
| KwdBracket of keyword * lbracket

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

@ -178,7 +178,7 @@ and type_decl = {
and type_expr =
TProd of cartesian
| TSum of (variant reg, vbar) nsepseq reg
| TRecord of field_decl reg injection reg
| TRecord of field_decl reg ne_injection reg
| TApp of (type_name * type_tuple) reg
| TFun of (type_expr * arrow * type_expr) reg
| TPar of type_expr par reg
@ -208,7 +208,7 @@ and fun_decl ={
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
local_decls : local_decl list option;
local_decls : local_decl list;
block : block reg option;
kwd_with : kwd_with option;
return : expr;
@ -306,14 +306,14 @@ and set_patch = {
kwd_patch : kwd_patch;
path : path;
kwd_with : kwd_with;
set_inj : expr injection reg
set_inj : expr ne_injection reg
}
and map_patch = {
kwd_patch : kwd_patch;
path : path;
kwd_with : kwd_with;
map_inj : binding reg injection reg
map_inj : binding reg ne_injection reg
}
and binding = {
@ -326,7 +326,7 @@ and record_patch = {
kwd_patch : kwd_patch;
path : path;
kwd_with : kwd_with;
record_inj : field_assign reg injection reg
record_inj : field_assign reg ne_injection reg
}
and cond_expr = {
@ -470,6 +470,13 @@ and 'a injection = {
closing : closing
}
and 'a ne_injection = {
opening : opening;
ne_elements : ('a, semi) nsepseq;
terminator : semi option;
closing : closing
}
and opening =
Kwd of keyword
| KwdBracket of keyword * lbracket

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

@ -213,21 +213,21 @@ variant:
record_type:
Record sep_or_term_list(field_decl,SEMI) End {
let elements, terminator = $2 in
let ne_elements, terminator = $2 in
let region = cover $1 $3
and value = {
and value = {
opening = Kwd $1;
elements = Some elements;
ne_elements;
terminator;
closing = End $3}
in {region; value}
}
| Record LBRACKET sep_or_term_list(field_decl,SEMI) RBRACKET {
let elements, terminator = $3 in
let ne_elements, terminator = $3 in
let region = cover $1 $4
and value = {
and value = {
opening = KwdBracket ($1,$2);
elements = Some elements;
ne_elements;
terminator;
closing = RBracket $4}
in {region; value} }
@ -258,7 +258,7 @@ fun_decl:
colon = $4;
ret_type = $5;
kwd_is = $6;
local_decls = Some $7;
local_decls = $7;
block = Some $8;
kwd_with = Some $9;
return = $10;
@ -266,7 +266,7 @@ fun_decl:
in {region;value}}
| Function fun_name parameters COLON type_expr Is
expr option(SEMI) {
let stop =
let stop =
match $8 with
Some region -> region
| None -> expr_to_region $7 in
@ -278,7 +278,7 @@ fun_decl:
colon = $4;
ret_type = $5;
kwd_is = $6;
local_decls = None;
local_decls = [];
block = None;
kwd_with = None;
return = $7;
@ -433,7 +433,7 @@ map_remove:
in {region; value}}
set_patch:
Patch path With injection(Set,expr) {
Patch path With ne_injection(Set,expr) {
let region = cover $1 $4.region in
let value = {
kwd_patch = $1;
@ -443,7 +443,7 @@ set_patch:
in {region; value}}
map_patch:
Patch path With injection(Map,binding) {
Patch path With ne_injection(Map,binding) {
let region = cover $1 $4.region in
let value = {
kwd_patch = $1;
@ -491,6 +491,28 @@ injection(Kind,element):
closing = RBracket $3}
in {region; value}}
ne_injection(Kind,element):
Kind sep_or_term_list(element,SEMI) End {
let ne_elements, terminator = $2 in
let region = cover $1 $3
and value = {
opening = Kwd $1;
ne_elements;
terminator;
closing = End $3}
in {region; value}
}
| Kind LBRACKET sep_or_term_list(element,SEMI) RBRACKET {
let ne_elements, terminator = $3 in
let region = cover $1 $4
and value = {
opening = KwdBracket ($1,$2);
ne_elements;
terminator;
closing = RBracket $4}
in {region; value}
}
binding:
expr ARROW expr {
let start = expr_to_region $1
@ -503,7 +525,7 @@ binding:
in {region; value}}
record_patch:
Patch path With record_expr {
Patch path With ne_injection(Record,field_assignment) {
let region = cover $1 $4.region in
let value = {
kwd_patch = $1;
@ -906,7 +928,7 @@ record_expr:
Record sep_or_term_list(field_assignment,SEMI) End {
let elements, terminator = $2 in
let region = cover $1 $3
and value = {
and value : field_assign AST.reg injection = {
opening = Kwd $1;
elements = Some elements;
terminator;
@ -916,7 +938,7 @@ record_expr:
| Record LBRACKET sep_or_term_list(field_assignment,SEMI) RBRACKET {
let elements, terminator = $3 in
let region = cover $1 $4
and value = {
and value : field_assign AST.reg injection = {
opening = KwdBracket ($1,$2);
elements = Some elements;
terminator;

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

@ -125,7 +125,7 @@ and print_sum_type buffer {value; _} =
print_nsepseq buffer "|" print_variant value
and print_record_type buffer record_type =
print_injection buffer "record" print_field_decl record_type
print_ne_injection buffer "record" print_field_decl record_type
and print_type_app buffer {value; _} =
let type_name, type_tuple = value in
@ -222,10 +222,7 @@ and print_block_closing buffer = function
| End kwd_end -> print_token buffer kwd_end "end"
and print_local_decls buffer sequence =
match sequence with
| Some sequence ->
List.iter (print_local_decl buffer) sequence
| None -> ()
List.iter (print_local_decl buffer) sequence
and print_local_decl buffer = function
LocalFun decl -> print_fun_decl buffer decl
@ -576,24 +573,24 @@ and print_selection buffer = function
and print_record_patch buffer node =
let {kwd_patch; path; kwd_with; record_inj} = node in
print_token buffer kwd_patch "patch";
print_path buffer path;
print_token buffer kwd_with "with";
print_record_expr buffer record_inj
print_token buffer kwd_patch "patch";
print_path buffer path;
print_token buffer kwd_with "with";
print_ne_injection buffer "record" print_field_assign record_inj
and print_set_patch buffer node =
let {kwd_patch; path; kwd_with; set_inj} = node in
print_token buffer kwd_patch "patch";
print_path buffer path;
print_token buffer kwd_with "with";
print_injection buffer "set" print_expr set_inj
print_token buffer kwd_patch "patch";
print_path buffer path;
print_token buffer kwd_with "with";
print_ne_injection buffer "set" print_expr set_inj
and print_map_patch buffer node =
let {kwd_patch; path; kwd_with; map_inj} = node in
print_token buffer kwd_patch "patch";
print_path buffer path;
print_token buffer kwd_with "with";
print_injection buffer "map" print_binding map_inj
print_token buffer kwd_patch "patch";
print_path buffer path;
print_token buffer kwd_with "with";
print_ne_injection buffer "map" print_binding map_inj
and print_map_remove buffer node =
let {kwd_remove; key; kwd_from; kwd_map; map} = node in
@ -621,6 +618,16 @@ and print_injection :
print_terminator buffer terminator;
print_closing buffer closing
and print_ne_injection :
'a.Buffer.t -> string -> (Buffer.t -> 'a -> unit) ->
'a ne_injection reg -> unit =
fun buffer kwd print {value; _} ->
let {opening; ne_elements; terminator; closing} = value in
print_opening buffer kwd opening;
print_nsepseq buffer ";" print ne_elements;
print_terminator buffer terminator;
print_closing buffer closing
and print_opening buffer lexeme = function
Kwd kwd ->
print_token buffer kwd lexeme
@ -774,10 +781,10 @@ and pp_declaration buffer ~pad:(_,pc as pad) = function
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.type_expr
| ConstDecl {value; _} ->
pp_node buffer ~pad "ConstDecl";
pp_const_decl buffer ~pad:(mk_pad 1 0 pc) value
pp_const_decl buffer ~pad value
| FunDecl {value; _} ->
pp_node buffer ~pad "FunDecl";
pp_fun_decl buffer ~pad:(mk_pad 1 0 pc) value
pp_fun_decl buffer ~pad value
and pp_const_decl buffer ~pad:(_,pc) decl =
pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value;
@ -817,7 +824,7 @@ and pp_type_expr buffer ~pad:(_,pc as pad) = function
let apply len rank field_decl =
pp_field_decl buffer ~pad:(mk_pad len rank pc)
field_decl.value in
let fields = Utils.sepseq_to_list value.elements in
let fields = Utils.nsepseq_to_list value.ne_elements in
List.iteri (List.length fields |> apply) fields
and pp_cartesian buffer ~pad:(_,pc) {value; _} =
@ -844,23 +851,26 @@ and pp_type_tuple buffer ~pad:(_,pc) {value; _} =
in List.iteri (List.length components |> apply) components
and pp_fun_decl buffer ~pad:(_,pc) decl =
let fields =
if decl.local_decls = [] then 5 else 6 in
let () =
let pad = mk_pad 6 0 pc in
let pad = mk_pad fields 0 pc in
pp_ident buffer ~pad decl.name.value in
let () =
let pad = mk_pad 6 1 pc in
let pad = mk_pad fields 1 pc in
pp_node buffer ~pad "<parameters>";
pp_parameters buffer ~pad decl.param in
let () =
let _, pc as pad = mk_pad 6 2 pc in
let _, pc as pad = mk_pad fields 2 pc in
pp_node buffer ~pad "<return type>";
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) decl.ret_type in
let () =
let pad = mk_pad 6 3 pc in
pp_node buffer ~pad "<local declarations>";
pp_local_decls buffer ~pad decl.local_decls in
if fields = 6 then
let pad = mk_pad fields 3 pc in
pp_node buffer ~pad "<local declarations>";
pp_local_decls buffer ~pad decl.local_decls in
let () =
let pad = mk_pad 6 4 pc in
let pad = mk_pad fields (fields - 2) pc in
pp_node buffer ~pad "<block>";
let statements =
match decl.block with
@ -868,7 +878,7 @@ and pp_fun_decl buffer ~pad:(_,pc) decl =
| None -> Instr (Skip Region.ghost), [] in
pp_statements buffer ~pad statements in
let () =
let _, pc as pad = mk_pad 6 5 pc in
let _, pc as pad = mk_pad fields (fields - 1) pc in
pp_node buffer ~pad "<return>";
pp_expr buffer ~pad:(mk_pad 1 0 pc) decl.return
in ()
@ -1090,6 +1100,15 @@ and pp_injection :
let apply len rank = printer buffer ~pad:(mk_pad len rank pc)
in List.iteri (apply length) elements
and pp_ne_injection :
'a.(Buffer.t -> pad:(string*string) -> 'a -> unit)
-> Buffer.t -> pad:(string*string) -> 'a ne_injection -> unit =
fun printer buffer ~pad:(_,pc) inj ->
let ne_elements = Utils.nsepseq_to_list inj.ne_elements in
let length = List.length ne_elements in
let apply len rank = printer buffer ~pad:(mk_pad len rank pc)
in List.iteri (apply length) ne_elements
and pp_tuple_pattern buffer ~pad:(_,pc) tuple =
let patterns = Utils.nsepseq_to_list tuple.inside in
let length = List.length patterns in
@ -1228,7 +1247,7 @@ and pp_fun_call buffer ~pad:(_,pc) (name, args) =
and pp_record_patch buffer ~pad:(_,pc as pad) patch =
pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path;
pp_injection pp_field_assign buffer
pp_ne_injection pp_field_assign buffer
~pad patch.record_inj.value
and pp_field_assign buffer ~pad:(_,pc as pad) {value; _} =
@ -1238,7 +1257,7 @@ and pp_field_assign buffer ~pad:(_,pc as pad) {value; _} =
and pp_map_patch buffer ~pad:(_,pc as pad) patch =
pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path;
pp_injection pp_binding buffer
pp_ne_injection pp_binding buffer
~pad patch.map_inj.value
and pp_binding buffer ~pad:(_,pc as pad) {value; _} =
@ -1249,7 +1268,7 @@ and pp_binding buffer ~pad:(_,pc as pad) {value; _} =
and pp_set_patch buffer ~pad:(_,pc as pad) patch =
pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path;
pp_injection pp_expr buffer ~pad patch.set_inj.value
pp_ne_injection pp_expr buffer ~pad patch.set_inj.value
and pp_map_remove buffer ~pad:(_,pc) rem =
pp_expr buffer ~pad:(mk_pad 2 0 pc) rem.key;
@ -1260,17 +1279,14 @@ and pp_set_remove buffer ~pad:(_,pc) rem =
pp_path buffer ~pad:(mk_pad 2 1 pc) rem.set
and pp_local_decls buffer ~pad:(_,pc) decls =
match decls with
| Some decls ->
let apply len rank =
pp_local_decl buffer ~pad:(mk_pad len rank pc)
in List.iteri (List.length decls |> apply) decls
| None -> ()
let apply len rank =
pp_local_decl buffer ~pad:(mk_pad len rank pc)
in List.iteri (List.length decls |> apply) decls
and pp_local_decl buffer ~pad:(_,pc as pad) = function
LocalFun {value; _} ->
pp_node buffer ~pad "LocalFun";
pp_fun_decl buffer ~pad:(mk_pad 1 0 pc) value
pp_fun_decl buffer ~pad value
| LocalData data ->
pp_node buffer ~pad "LocalData";
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data
@ -1469,10 +1485,9 @@ and pp_annotated buffer ~pad:(_,pc) (expr, t_expr) =
pp_expr buffer ~pad:(mk_pad 2 0 pc) expr;
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) t_expr
and pp_bin_op node buffer ~pad:(_,pc) op =
pp_node buffer ~pad:(mk_pad 1 0 pc) node;
let _, pc = mk_pad 1 0 pc in
(pp_expr buffer ~pad:(mk_pad 2 0 pc) op.arg1;
pp_expr buffer ~pad:(mk_pad 2 1 pc) op.arg2)
and pp_bin_op node buffer ~pad:(_,pc as pad) op =
pp_node buffer ~pad node;
pp_expr buffer ~pad:(mk_pad 2 0 pc) op.arg1;
pp_expr buffer ~pad:(mk_pad 2 1 pc) op.arg2
let pp_ast buffer = pp_ast buffer ~pad:("","")

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

@ -78,16 +78,6 @@ module Errors = struct
] in
error ~data title message
let unsupported_empty_record_patch record_expr =
let title () = "empty record patch" in
let message () =
Format.asprintf "empty record patches are not supported yet" in
let data = [
("record_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ record_expr.Region.region)
] in
error ~data title message
let unsupported_non_var_pattern p =
let title () = "pattern is not a variable" in
let message () =
@ -225,7 +215,7 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
let%bind lst = bind_list
@@ List.map aux
@@ List.map apply
@@ pseq_to_list r.value.elements in
@@ npseq_to_list r.value.ne_elements in
let m = List.fold_left (fun m (x, y) -> SMap.add x y m) SMap.empty lst in
ok @@ T_record m
| TSum s ->
@ -551,11 +541,6 @@ and simpl_fun_declaration :
fun ~loc x ->
let open! Raw in
let {name;param;ret_type;local_decls;block;return} : fun_decl = x in
let local_decls =
match local_decls with
| Some local_decls -> local_decls
| None -> []
in
let statements =
match block with
| Some block -> npseq_to_list block.value.statements
@ -736,26 +721,32 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
| RecordPatch r -> (
let r = r.value in
let (name , access_path) = simpl_path r.path in
let%bind inj = bind_list
@@ List.map (fun (x:Raw.field_assign Region.reg) ->
let head, tail = r.record_inj.value.ne_elements in
let%bind tail' = bind_list
@@ List.map (fun (x: Raw.field_assign Region.reg) ->
let (x , loc) = r_split x in
let%bind e = simpl_expression x.field_expr
in ok (x.field_name.value, e , loc)
)
@@ pseq_to_list r.record_inj.value.elements in
@@ List.map snd tail in
let%bind head' =
let (x , loc) = r_split head in
let%bind e = simpl_expression x.field_expr
in ok (x.field_name.value, e , loc) in
let%bind expr =
let aux = fun (access , v , loc) ->
e_assign ~loc name (access_path @ [ Access_record access ]) v in
let assigns = List.map aux inj in
match assigns with
| [] -> fail @@ unsupported_empty_record_patch r.record_inj
| hd :: tl -> (
let aux acc cur = e_sequence acc cur in
ok @@ List.fold_left aux hd tl
)
e_assign ~loc name (access_path @ [Access_record access]) v in
let hd, tl = aux head', List.map aux tail' in
let aux acc cur = e_sequence acc cur in
ok @@ List.fold_left aux hd tl
in
return_statement @@ expr
)
)
| MapPatch patch -> (
let (map_p, loc) = r_split patch in
let (name, access_path) = simpl_path map_p.path in
@ -767,7 +758,7 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
let%bind value' = simpl_expression value
in ok @@ (key', value')
)
@@ pseq_to_list map_p.map_inj.value.elements in
@@ npseq_to_list map_p.map_inj.value.ne_elements in
let expr =
match inj with
| [] -> e_skip ~loc ()
@ -785,7 +776,7 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
let%bind inj =
bind_list @@
List.map simpl_expression @@
pseq_to_list setp.set_inj.value.elements in
npseq_to_list setp.set_inj.value.ne_elements in
let expr =
match inj with
| [] -> e_skip ~loc ()

4
src/test/contracts/map.ligo
View File

@ -29,10 +29,6 @@ function patch_ (var m: foobar) : foobar is block {
patch m with map [0 -> 5; 1 -> 6; 2 -> 7]
} with m
function patch_empty (var m : foobar) : foobar is block {
patch m with map []
} with m
function patch_deep (var m: foobar * nat) : foobar * nat is
begin patch m.0 with map [1 -> 9]; end with m

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

@ -26,11 +26,5 @@ function patch_op (var s: set(string)) : set(string) is
function patch_op_deep (var s: set(string)*nat) : set(string)*nat is
begin patch s.0 with set ["foobar"]; end with s
function patch_op_empty (var s: set(string)) : set(string) is
begin patch s with set []; end with s
function mem_op (const s : set(string)) : bool is
begin skip end with set_mem("foobar" , s)

25
src/test/integration_tests.ml
View File

@ -20,7 +20,7 @@ let blockless () : unit result =
let make_expect = fun n-> n + 10 in
expect_eq_n_int program "blockless" make_expect
(* Procedures are not supported yet
(* Procedures are not supported yet
let procedure () : unit result =
let%bind program = type_file "./contracts/procedure.ligo" in
let make_expect = fun n -> n + 1 in
@ -121,7 +121,7 @@ let higher_order () : unit result =
let%bind _ = expect_eq_n_int program "foobar3" make_expect in
let%bind _ = expect_eq_n_int program "foobar4" make_expect in
let%bind _ = expect_eq_n_int program "foobar5" make_expect in
ok ()
ok ()
let shared_function () : unit result =
let%bind program = type_file "./contracts/function-shared.ligo" in
@ -256,11 +256,11 @@ let set_arithmetic () : unit result =
(e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
(e_set [e_string "foo" ; e_string "bar"]) in
let%bind () =
expect_eq program "remove_deep"
(e_pair
expect_eq program "remove_deep"
(e_pair
(e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
(e_nat 42))
(e_pair
(e_pair
(e_set [e_string "foo" ; e_string "bar"])
(e_nat 42))
in
@ -276,10 +276,6 @@ let set_arithmetic () : unit result =
(e_pair
(e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
(e_nat 42)) in
let%bind () =
expect_eq program "patch_op_empty"
(e_set [e_string "foo" ; e_string "bar"])
(e_set [e_string "foo" ; e_string "bar"]) in
let%bind () =
expect_eq program "mem_op"
(e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
@ -451,11 +447,6 @@ let map_ type_f path : unit result =
let expected = ez [(0, 5) ; (1, 6) ; (2, 7)] in
expect_eq program "patch_" input expected
in
let%bind () =
let input = ez [(0,0) ; (1,1) ; (2,2)] in
let expected = ez [(0,0) ; (1,1) ; (2,2)] in
expect_eq program "patch_empty" input expected
in
let%bind () =
let input = (e_pair
(ez [(0,0) ; (1,1) ; (2,2)])
@ -630,9 +621,9 @@ let loop () : unit result =
let make_input = e_nat in
let make_expected = fun n -> e_nat (n * (n + 1) / 2) in
expect_eq_n_pos_mid program "while_sum" make_input make_expected
in(* For loop is currently unsupported
let%bind () =
in(* For loop is currently unsupported
let%bind () =
let make_input = e_nat in
let make_expected = fun n -> e_nat (n * (n + 1) / 2) in
expect_eq_n_pos_mid program "for_sum" make_input make_expected