I forbade empty patches (parser). Fixed AST pretty-printer (PascaLIGO).
Changed accordingly the simplifier: the dead code for the error about empty record patches is no long.
This commit is contained in:
parent
0467868bb2
commit
eae3348d51
@ -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
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
@ -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;
|
||||
|
@ -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:("","")
|
||||
|
@ -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 ()
|
||||
|
@ -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
|
||||
|
||||
|
@ -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)
|
||||
|
||||
|
||||
|
||||
|
@ -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)])
|
||||
|
Loading…
Reference in New Issue
Block a user