Final touches to the pretty printers.

Fixed the syntaxes for field_assignment and field_path_assignment.
This commit is contained in:
Christian Rinderknecht 2020-06-10 16:58:59 +02:00
parent dfbba95cbf
commit c57f499fea
21 changed files with 1601 additions and 1681 deletions

View File

@ -19,5 +19,3 @@ $HOME/git/OCaml-build/Makefile
../shared/LexerUnit.ml
../shared/ParserUnit.mli
../shared/ParserUnit.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml

View File

@ -344,12 +344,12 @@ and update = {
lbrace : lbrace;
record : path;
kwd_with : kwd_with;
updates : field_path_assign reg ne_injection reg;
updates : field_path_assignment reg ne_injection reg;
rbrace : rbrace
}
and field_path_assign = {
field_path : (selection, dot) nsepseq;
and field_path_assignment = {
field_path : path;
assignment : equal;
field_expr : expr
}

View File

@ -524,8 +524,7 @@ mult_expr_level:
| unary_expr_level { $1 }
unary_expr_level:
call_expr_level { $1 }
| "-" call_expr_level {
"-" call_expr_level {
let start = $1 in
let stop = expr_to_region $2 in
let region = cover start stop
@ -537,7 +536,9 @@ unary_expr_level:
let stop = expr_to_region $2 in
let region = cover start stop
and value = {op=$1; arg=$2} in
ELogic (BoolExpr (Not ({region; value}))) }
ELogic (BoolExpr (Not ({region; value})))
}
| call_expr_level { $1 }
call_expr_level:
call_expr | constr_expr | core_expr { $1 }
@ -595,7 +596,7 @@ module_field:
module_fun:
field_name { $1 }
| "or" { {value="or"; region=$1} }
| "or" { {value="or"; region=$1} }
projection:
struct_name "." nsepseq(selection,".") {
@ -643,20 +644,15 @@ update_record:
in {region; value} }
field_path_assignment :
nsepseq(selection,".") "=" expr {
let start = nsepseq_to_region selection_to_region $1 in
let region = cover start (expr_to_region $3) in
let value = {field_path = $1;
assignment = $2;
field_expr = $3}
in {region; value}}
path "=" expr {
let region = cover (path_to_region $1) (expr_to_region $3)
and value = {field_path=$1; assignment=$2; field_expr=$3}
in {region; value} }
field_assignment:
field_name "=" expr {
let start = $1.region in
let stop = expr_to_region $3 in
let region = cover start stop in
let value = {field_name = $1;
let region = cover $1.region (expr_to_region $3)
and value = {field_name = $1;
assignment = $2;
field_expr = $3}
in {region; value} }

View File

@ -526,7 +526,7 @@ and print_field_assign state {value; _} =
and print_field_path_assign state {value; _} =
let {field_path; assignment; field_expr} = value in
print_nsepseq state "." print_selection field_path;
print_path state field_path;
print_token state assignment "=";
print_expr state field_expr
@ -945,7 +945,7 @@ and pp_projection state proj =
List.iteri (apply len) selections
and pp_update state update =
pp_path state update.record;
pp_path (state#pad 2 0) update.record;
pp_ne_injection pp_field_path_assign state update.updates.value
and pp_path state = function
@ -970,10 +970,10 @@ and pp_field_assign state {value; _} =
pp_expr (state#pad 2 1) value.field_expr
and pp_field_path_assign state {value; _} =
pp_node state "<field path for update>";
let path = Utils.nsepseq_to_list value.field_path in
List.iter (pp_selection (state#pad 2 0)) path;
pp_expr (state#pad 2 1) value.field_expr
let {field_path; field_expr; _} = value in
pp_node state "<update>";
pp_path (state#pad 2 0) field_path;
pp_expr (state#pad 2 1) field_expr
and pp_constr_expr state = function
ENone region ->

View File

@ -70,7 +70,7 @@ module ParserLog =
module Lexer = Lexer.Make (LexToken)
module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
(* Main *)

View File

@ -286,18 +286,14 @@ and pp_ne_injection :
string opening ^^ nest 1 elements ^^ string closing
and pp_nsepseq :
'a.string ->
('a -> document) ->
('a, t) Utils.nsepseq ->
document =
'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
fun sep printer elements ->
let elems = Utils.nsepseq_to_list elements
and sep = string sep ^^ break 1
in separate_map sep printer elems
and pp_nseq : 'a.('a -> document) -> 'a Utils.nseq -> document =
fun printer (head, tail) ->
separate_map (break 1) printer (head::tail)
fun printer (head, tail) -> separate_map (break 1) printer (head::tail)
and pp_projection {value; _} =
let {struct_name; field_path; _} = value in
@ -319,9 +315,7 @@ and pp_update {value; _} =
and pp_field_path_assign {value; _} =
let {field_path; field_expr; _} = value in
let fields = Utils.nsepseq_to_list field_path
and sep = string "." ^^ break 0 in
let path = separate_map sep pp_ident fields in
let path = pp_path field_path in
prefix 2 1 (path ^^ string " =") (pp_expr field_expr)
and pp_path = function

View File

@ -1948,7 +1948,7 @@ interactive_expr: LBRACE Constr DOT Ident With
##
## Ends in an error in state: 523.
##
## projection -> Constr DOT Ident . DOT nsepseq(selection,DOT) [ With ]
## projection -> Constr DOT Ident . DOT nsepseq(selection,DOT) [ With EQ ]
##
## The known suffix of the stack is as follows:
## Constr DOT Ident
@ -1960,7 +1960,7 @@ interactive_expr: LBRACE Constr DOT With
##
## Ends in an error in state: 522.
##
## projection -> Constr DOT . Ident DOT nsepseq(selection,DOT) [ With ]
## projection -> Constr DOT . Ident DOT nsepseq(selection,DOT) [ With EQ ]
##
## The known suffix of the stack is as follows:
## Constr DOT
@ -1972,7 +1972,7 @@ interactive_expr: LBRACE Constr With
##
## Ends in an error in state: 521.
##
## projection -> Constr . DOT Ident DOT nsepseq(selection,DOT) [ With ]
## projection -> Constr . DOT Ident DOT nsepseq(selection,DOT) [ With EQ ]
##
## The known suffix of the stack is as follows:
## Constr
@ -2002,7 +2002,7 @@ interactive_expr: LBRACE Ident DOT Ident Verbatim
interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes SEMI With
##
## Ends in an error in state: 551.
## Ends in an error in state: 552.
##
## nsepseq(field_assignment,SEMI) -> field_assignment SEMI . nsepseq(field_assignment,SEMI) [ RBRACE ]
## seq(__anonymous_0(field_assignment,SEMI)) -> field_assignment SEMI . seq(__anonymous_0(field_assignment,SEMI)) [ RBRACE ]
@ -2015,7 +2015,7 @@ interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes SEMI With
interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes With
##
## Ends in an error in state: 550.
## Ends in an error in state: 551.
##
## nsepseq(field_assignment,SEMI) -> field_assignment . [ RBRACE ]
## nsepseq(field_assignment,SEMI) -> field_assignment . SEMI nsepseq(field_assignment,SEMI) [ RBRACE ]
@ -2047,7 +2047,7 @@ interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes With
interactive_expr: LBRACE Ident EQ Bytes SEMI Ident With
##
## Ends in an error in state: 547.
## Ends in an error in state: 548.
##
## field_assignment -> Ident . EQ expr [ SEMI RBRACE ]
##
@ -2059,7 +2059,7 @@ interactive_expr: LBRACE Ident EQ Bytes SEMI Ident With
interactive_expr: LBRACE Ident EQ Bytes SEMI With
##
## Ends in an error in state: 546.
## Ends in an error in state: 547.
##
## nsepseq(field_assignment,SEMI) -> field_assignment SEMI . nsepseq(field_assignment,SEMI) [ RBRACE ]
## nseq(__anonymous_0(field_assignment,SEMI)) -> field_assignment SEMI . seq(__anonymous_0(field_assignment,SEMI)) [ RBRACE ]
@ -2072,7 +2072,7 @@ interactive_expr: LBRACE Ident EQ Bytes SEMI With
interactive_expr: LBRACE Ident EQ Bytes With
##
## Ends in an error in state: 545.
## Ends in an error in state: 546.
##
## nsepseq(field_assignment,SEMI) -> field_assignment . [ RBRACE ]
## nsepseq(field_assignment,SEMI) -> field_assignment . SEMI nsepseq(field_assignment,SEMI) [ RBRACE ]
@ -2128,9 +2128,9 @@ interactive_expr: LBRACE Ident WILD
<YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LBRACE Ident With Int EQ Bytes SEMI Int EQ Bytes SEMI With
interactive_expr: LBRACE Ident With Ident DOT Ident EQ Bytes SEMI Ident DOT Ident EQ Bytes SEMI With
##
## Ends in an error in state: 541.
## Ends in an error in state: 542.
##
## nsepseq(field_path_assignment,SEMI) -> field_path_assignment SEMI . nsepseq(field_path_assignment,SEMI) [ RBRACE ]
## seq(__anonymous_0(field_path_assignment,SEMI)) -> field_path_assignment SEMI . seq(__anonymous_0(field_path_assignment,SEMI)) [ RBRACE ]
@ -2141,9 +2141,9 @@ interactive_expr: LBRACE Ident With Int EQ Bytes SEMI Int EQ Bytes SEMI With
<YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LBRACE Ident With Int EQ Bytes SEMI Int EQ Bytes With
interactive_expr: LBRACE Ident With Ident DOT Ident EQ Bytes SEMI Ident DOT Ident EQ Bytes With
##
## Ends in an error in state: 540.
## Ends in an error in state: 541.
##
## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . [ RBRACE ]
## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . SEMI nsepseq(field_path_assignment,SEMI) [ RBRACE ]
@ -2168,14 +2168,14 @@ interactive_expr: LBRACE Ident With Int EQ Bytes SEMI Int EQ Bytes With
## In state 368, spurious reduction of production base_expr(expr) -> disj_expr_level
## In state 370, spurious reduction of production base_cond__open(expr) -> base_expr(expr)
## In state 371, spurious reduction of production expr -> base_cond__open(expr)
## In state 534, spurious reduction of production field_path_assignment -> nsepseq(selection,DOT) EQ expr
## In state 534, spurious reduction of production field_path_assignment -> path EQ expr
##
<YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LBRACE Ident With Int EQ Bytes SEMI With
interactive_expr: LBRACE Ident With Ident DOT Ident EQ Bytes SEMI With
##
## Ends in an error in state: 537.
## Ends in an error in state: 538.
##
## nsepseq(field_path_assignment,SEMI) -> field_path_assignment SEMI . nsepseq(field_path_assignment,SEMI) [ RBRACE ]
## nseq(__anonymous_0(field_path_assignment,SEMI)) -> field_path_assignment SEMI . seq(__anonymous_0(field_path_assignment,SEMI)) [ RBRACE ]
@ -2186,9 +2186,9 @@ interactive_expr: LBRACE Ident With Int EQ Bytes SEMI With
<YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LBRACE Ident With Int EQ Bytes With
interactive_expr: LBRACE Ident With Ident DOT Ident EQ Bytes With
##
## Ends in an error in state: 536.
## Ends in an error in state: 537.
##
## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . [ RBRACE ]
## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . SEMI nsepseq(field_path_assignment,SEMI) [ RBRACE ]
@ -2213,37 +2213,52 @@ interactive_expr: LBRACE Ident With Int EQ Bytes With
## In state 368, spurious reduction of production base_expr(expr) -> disj_expr_level
## In state 370, spurious reduction of production base_cond__open(expr) -> base_expr(expr)
## In state 371, spurious reduction of production expr -> base_cond__open(expr)
## In state 534, spurious reduction of production field_path_assignment -> nsepseq(selection,DOT) EQ expr
## In state 534, spurious reduction of production field_path_assignment -> path EQ expr
##
<YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LBRACE Ident With Int EQ With
interactive_expr: LBRACE Ident With Ident DOT Ident EQ With
##
## Ends in an error in state: 533.
##
## field_path_assignment -> nsepseq(selection,DOT) EQ . expr [ SEMI RBRACE ]
## field_path_assignment -> path EQ . expr [ SEMI RBRACE ]
##
## The known suffix of the stack is as follows:
## nsepseq(selection,DOT) EQ
## path EQ
##
<YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LBRACE Ident With Int With
interactive_expr: LBRACE Ident With Ident DOT Ident With
##
## Ends in an error in state: 532.
##
## field_path_assignment -> nsepseq(selection,DOT) . EQ expr [ SEMI RBRACE ]
## field_path_assignment -> path . EQ expr [ SEMI RBRACE ]
##
## The known suffix of the stack is as follows:
## nsepseq(selection,DOT)
## path
##
## WARNING: This example involves spurious reductions.
## This implies that, although the LR(1) items shown above provide an
## accurate view of the past (what has been recognized so far), they
## may provide an INCOMPLETE view of the future (what was expected next).
## In state 187, spurious reduction of production nsepseq(selection,DOT) -> selection
## In state 190, spurious reduction of production projection -> Ident DOT nsepseq(selection,DOT)
## In state 526, spurious reduction of production path -> projection
##
<YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LBRACE Ident With Ident With
##
## Ends in an error in state: 529.
##
## path -> Ident . [ EQ ]
## projection -> Ident . DOT nsepseq(selection,DOT) [ EQ ]
##
## The known suffix of the stack is as follows:
## Ident
##
<YOUR SYNTAX ERROR MESSAGE HERE>
@ -2275,7 +2290,7 @@ interactive_expr: LBRACE With
interactive_expr: LBRACKET Verbatim SEMI Verbatim SEMI With
##
## Ends in an error in state: 566.
## Ends in an error in state: 567.
##
## nsepseq(expr,SEMI) -> expr SEMI . nsepseq(expr,SEMI) [ RBRACKET ]
## seq(__anonymous_0(expr,SEMI)) -> expr SEMI . seq(__anonymous_0(expr,SEMI)) [ RBRACKET ]
@ -2288,7 +2303,7 @@ interactive_expr: LBRACKET Verbatim SEMI Verbatim SEMI With
interactive_expr: LBRACKET Verbatim SEMI Verbatim With
##
## Ends in an error in state: 565.
## Ends in an error in state: 566.
##
## nsepseq(expr,SEMI) -> expr . [ RBRACKET ]
## nsepseq(expr,SEMI) -> expr . SEMI nsepseq(expr,SEMI) [ RBRACKET ]
@ -2319,7 +2334,7 @@ interactive_expr: LBRACKET Verbatim SEMI Verbatim With
interactive_expr: LBRACKET Verbatim SEMI With
##
## Ends in an error in state: 562.
## Ends in an error in state: 563.
##
## nsepseq(expr,SEMI) -> expr SEMI . nsepseq(expr,SEMI) [ RBRACKET ]
## nseq(__anonymous_0(expr,SEMI)) -> expr SEMI . seq(__anonymous_0(expr,SEMI)) [ RBRACKET ]
@ -2332,7 +2347,7 @@ interactive_expr: LBRACKET Verbatim SEMI With
interactive_expr: LBRACKET Verbatim With
##
## Ends in an error in state: 561.
## Ends in an error in state: 562.
##
## nsepseq(expr,SEMI) -> expr . [ RBRACKET ]
## nsepseq(expr,SEMI) -> expr . SEMI nsepseq(expr,SEMI) [ RBRACKET ]
@ -2375,7 +2390,7 @@ interactive_expr: LBRACKET With
interactive_expr: LPAR Verbatim COLON Ident VBAR
##
## Ends in an error in state: 580.
## Ends in an error in state: 581.
##
## par(annot_expr) -> LPAR annot_expr . RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
##
@ -2389,14 +2404,14 @@ interactive_expr: LPAR Verbatim COLON Ident VBAR
## In state 28, spurious reduction of production cartesian -> core_type
## In state 36, spurious reduction of production fun_type -> cartesian
## In state 27, spurious reduction of production type_expr -> fun_type
## In state 579, spurious reduction of production annot_expr -> expr COLON type_expr
## In state 580, spurious reduction of production annot_expr -> expr COLON type_expr
##
<YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LPAR Verbatim COLON With
##
## Ends in an error in state: 578.
## Ends in an error in state: 579.
##
## annot_expr -> expr COLON . type_expr [ RPAR ]
##
@ -2408,7 +2423,7 @@ interactive_expr: LPAR Verbatim COLON With
interactive_expr: LPAR Verbatim With
##
## Ends in an error in state: 576.
## Ends in an error in state: 577.
##
## annot_expr -> expr . COLON type_expr [ RPAR ]
## par(expr) -> LPAR expr . RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
@ -2525,7 +2540,7 @@ interactive_expr: Let Rec With
interactive_expr: Let WILD EQ Bytes Attr Type
##
## Ends in an error in state: 554.
## Ends in an error in state: 555.
##
## let_expr(expr) -> Let let_binding seq(Attr) . In expr [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -2544,7 +2559,7 @@ interactive_expr: Let WILD EQ Bytes Attr Type
interactive_expr: Let WILD EQ Bytes In With
##
## Ends in an error in state: 555.
## Ends in an error in state: 556.
##
## let_expr(expr) -> Let let_binding seq(Attr) In . expr [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -2556,7 +2571,7 @@ interactive_expr: Let WILD EQ Bytes In With
interactive_expr: Let WILD EQ Bytes With
##
## Ends in an error in state: 553.
## Ends in an error in state: 554.
##
## let_expr(expr) -> Let let_binding . seq(Attr) In expr [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -2611,7 +2626,7 @@ interactive_expr: MINUS With
interactive_expr: Match Verbatim Type
##
## Ends in an error in state: 569.
## Ends in an error in state: 570.
##
## match_expr(base_cond) -> Match expr . With option(VBAR) cases(base_cond) [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -2653,7 +2668,7 @@ interactive_expr: Match Verbatim With LPAR Bytes RPAR With
interactive_expr: Match Verbatim With VBAR Begin
##
## Ends in an error in state: 571.
## Ends in an error in state: 572.
##
## match_expr(base_cond) -> Match expr With option(VBAR) . cases(base_cond) [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -2665,7 +2680,7 @@ interactive_expr: Match Verbatim With VBAR Begin
interactive_expr: Match Verbatim With WILD ARROW Bytes VBAR With
##
## Ends in an error in state: 575.
## Ends in an error in state: 576.
##
## cases(base_cond) -> cases(base_cond) VBAR . case_clause(base_cond) [ With VBAR Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -3200,7 +3215,7 @@ interactive_expr: Match Verbatim With WILD ARROW Let With
interactive_expr: Match Verbatim With WILD ARROW Verbatim COMMA Bytes Else
##
## Ends in an error in state: 574.
## Ends in an error in state: 575.
##
## cases(base_cond) -> cases(base_cond) . VBAR case_clause(base_cond) [ With VBAR Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
## match_expr(base_cond) -> Match expr With option(VBAR) cases(base_cond) . [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
@ -3264,7 +3279,7 @@ interactive_expr: Match Verbatim With WILD ARROW Verbatim End
interactive_expr: Match Verbatim With WILD ARROW With
##
## Ends in an error in state: 573.
## Ends in an error in state: 574.
##
## case_clause(base_cond) -> pattern ARROW . base_cond [ With VBAR Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -3313,7 +3328,7 @@ interactive_expr: Match Verbatim With WILD COMMA With
interactive_expr: Match Verbatim With WILD CONS Bytes SEMI
##
## Ends in an error in state: 572.
## Ends in an error in state: 573.
##
## case_clause(base_cond) -> pattern . ARROW base_cond [ With VBAR Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -3357,7 +3372,7 @@ interactive_expr: Match Verbatim With WILD With
interactive_expr: Match Verbatim With With
##
## Ends in an error in state: 570.
## Ends in an error in state: 571.
##
## match_expr(base_cond) -> Match expr With . option(VBAR) cases(base_cond) [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
##
@ -3747,7 +3762,7 @@ interactive_expr: Verbatim WILD
interactive_expr: Verbatim With
##
## Ends in an error in state: 597.
## Ends in an error in state: 598.
##
## interactive_expr -> expr . EOF [ # ]
##
@ -3776,7 +3791,7 @@ interactive_expr: Verbatim With
interactive_expr: With
##
## Ends in an error in state: 595.
## Ends in an error in state: 596.
##
## interactive_expr' -> . interactive_expr [ # ]
##
@ -4222,7 +4237,7 @@ contract: Let LPAR With
contract: Let Rec WILD EQ Bytes With
##
## Ends in an error in state: 584.
## Ends in an error in state: 585.
##
## let_declaration -> Let Rec let_binding . seq(Attr) [ Type Let EOF ]
##
@ -4347,7 +4362,7 @@ contract: Let WILD EQ Bytes Attr With
contract: Let WILD EQ Bytes With
##
## Ends in an error in state: 586.
## Ends in an error in state: 587.
##
## let_declaration -> Let let_binding . seq(Attr) [ Type Let EOF ]
##
@ -4483,7 +4498,7 @@ contract: Type Ident EQ Constr With
contract: Type Ident EQ Ident VBAR
##
## Ends in an error in state: 592.
## Ends in an error in state: 593.
##
## declarations -> declaration . [ EOF ]
## declarations -> declaration . declarations [ EOF ]
@ -4499,7 +4514,7 @@ contract: Type Ident EQ Ident VBAR
## In state 36, spurious reduction of production fun_type -> cartesian
## In state 27, spurious reduction of production type_expr -> fun_type
## In state 61, spurious reduction of production type_decl -> Type Ident EQ type_expr
## In state 588, spurious reduction of production declaration -> type_decl
## In state 589, spurious reduction of production declaration -> type_decl
##
<YOUR SYNTAX ERROR MESSAGE HERE>

View File

@ -21,5 +21,3 @@ $HOME/git/OCaml-build/Makefile
../shared/ParserUnit.mli
../shared/ParserUnit.ml
../shared/LexerLib.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml

View File

@ -541,13 +541,13 @@ and constr_expr =
| NoneExpr of c_None
| ConstrApp of (constr * arguments option) reg
and field_assign = {
and field_assignment = {
field_name : field_name;
assignment : equal;
field_expr : expr
}
and record = field_assign reg ne_injection
and record = field_assignment reg ne_injection
and projection = {
struct_name : variable;
@ -558,11 +558,11 @@ and projection = {
and update = {
record : path;
kwd_with : kwd_with;
updates : field_path_assign reg ne_injection reg
updates : field_path_assignment reg ne_injection reg
}
and field_path_assign = {
field_path : (selection, dot) nsepseq;
and field_path_assignment = {
field_path : path;
assignment : equal;
field_expr : expr
}

View File

@ -949,7 +949,7 @@ record_expr:
"record" sep_or_term_list(field_assignment,";") "end" {
let ne_elements, terminator = $2 in
let region = cover $1 $3
and value : field_assign AST.reg ne_injection = {
and value : field_assignment AST.reg ne_injection = {
kind = NEInjRecord $1;
enclosing = End $3;
ne_elements;
@ -959,7 +959,7 @@ record_expr:
| "record" "[" sep_or_term_list(field_assignment,";") "]" {
let ne_elements, terminator = $3 in
let region = cover $1 $4
and value : field_assign AST.reg ne_injection = {
and value : field_assignment AST.reg ne_injection = {
kind = NEInjRecord $1;
enclosing = Brackets ($2,$4);
ne_elements;
@ -969,8 +969,8 @@ record_expr:
update_record:
path "with" ne_injection("record",field_path_assignment) {
let updates = $3 (fun region -> NEInjRecord region) in
let region = cover (path_to_region $1) updates.region in
let value = {record=$1; kwd_with=$2; updates}
let region = cover (path_to_region $1) updates.region in
let value = {record=$1; kwd_with=$2; updates}
in {region; value} }
field_assignment:
@ -980,10 +980,8 @@ field_assignment:
in {region; value} }
field_path_assignment:
nsepseq(selection,".") "=" expr {
let start = nsepseq_to_region selection_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
path "=" expr {
let region = cover (path_to_region $1) (expr_to_region $3)
and value = {field_path=$1; assignment=$2; field_expr=$3}
in {region; value} }

View File

@ -616,25 +616,25 @@ and print_constr_expr state = function
| ConstrApp e -> print_constr_app state e
and print_record_expr state =
print_ne_injection state print_field_assign
print_ne_injection state print_field_assignment
and print_field_assign state {value; _} =
and print_field_assignment state {value; _} =
let {field_name; assignment; field_expr} = value in
print_var state field_name;
print_token state assignment "=";
print_expr state field_expr
and print_field_path_assign state {value; _} =
and print_field_path_assignment state {value; _} =
let {field_path; assignment; field_expr} = value in
print_nsepseq state "field_path" print_selection field_path;
print_token state assignment "=";
print_expr state field_expr
print_path state field_path;
print_token state assignment "=";
print_expr state field_expr
and print_update_expr state {value; _} =
let {record; kwd_with; updates} = value in
print_path state record;
print_token state kwd_with "with";
print_ne_injection state print_field_path_assign updates
print_ne_injection state print_field_path_assignment updates
and print_projection state {value; _} =
let {struct_name; selector; field_path} = value in
@ -654,7 +654,7 @@ and print_record_patch state node =
print_token state kwd_patch "patch";
print_path state path;
print_token state kwd_with "with";
print_ne_injection state print_field_assign record_inj
print_ne_injection state print_field_assignment record_inj
and print_set_patch state node =
let {kwd_patch; path; kwd_with; set_inj} = node in
@ -1272,7 +1272,7 @@ and pp_projection state proj =
and pp_update state update =
pp_path (state#pad 2 0) update.record;
pp_ne_injection pp_field_path_assign state update.updates.value
pp_ne_injection pp_field_path_assignment state update.updates.value
and pp_selection state = function
FieldName name ->
@ -1380,18 +1380,18 @@ and pp_fun_call state (expr, args) =
and pp_record_patch state patch =
pp_path (state#pad 2 0) patch.path;
pp_ne_injection pp_field_assign state patch.record_inj.value
pp_ne_injection pp_field_assignment state patch.record_inj.value
and pp_field_assign state {value; _} =
and pp_field_assignment state {value; _} =
pp_node state "<field assignment>";
pp_ident (state#pad 2 0) value.field_name;
pp_expr (state#pad 2 1) value.field_expr
and pp_field_path_assign state {value; _} =
and pp_field_path_assignment state {value; _} =
let {field_path; field_expr; _} = value in
pp_node state "<update>";
let path = Utils.nsepseq_to_list value.field_path in
List.iter (pp_selection (state#pad 2 0)) path;
pp_expr (state#pad 2 1) value.field_expr
pp_path (state#pad 2 0) field_path;
pp_expr (state#pad 2 1) field_expr
and pp_map_patch state patch =
pp_path (state#pad 2 0) patch.path;
@ -1461,7 +1461,7 @@ and pp_expr state = function
pp_constr_expr (state#pad 1 0) e_constr
| ERecord {value; region} ->
pp_loc_node state "ERecord" region;
pp_ne_injection pp_field_assign state value
pp_ne_injection pp_field_assignment state value
| EProj {value; region} ->
pp_loc_node state "EProj" region;
pp_projection state value

View File

@ -70,7 +70,7 @@ module ParserLog =
module Lexer = Lexer.Make (LexToken)
module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
(* Main *)

View File

@ -497,10 +497,8 @@ and pp_update {value; _} =
and pp_field_path_assign {value; _} =
let {field_path; field_expr; _} = value in
let fields = Utils.nsepseq_to_list field_path
and sep = string "." ^^ break 0 in
let fields = separate_map sep pp_ident fields in
group (fields ^^ nest 2 (break 1 ^^ string "= " ^^ pp_expr field_expr))
let path = pp_path field_path in
prefix 2 1 (path ^^ string " =") (pp_expr field_expr)
and pp_selection = function
FieldName v -> string v.value

File diff suppressed because it is too large Load Diff

View File

@ -27,6 +27,3 @@ Stubs/Parser_cameligo.ml
../cameligo/ParserLog.ml
../cameligo/Scoping.mli
../cameligo/Scoping.ml
../cameligo/Pretty.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml

View File

@ -430,14 +430,14 @@ type_expr_simple:
TProd {region = cover $1 $3; value=$2}
}
| "(" type_expr_simple "=>" type_expr_simple ")" {
TPar {
TPar {
value = {
lpar = $1;
rpar = $5;
inside = TFun {
region = cover (type_expr_to_region $2) (type_expr_to_region $4);
value=$2,$3,$4
}
}
};
region = cover $1 $5;
}
@ -912,9 +912,9 @@ update_record:
lbrace = $1;
record = $3;
kwd_with = $4;
updates = {value = {compound = Braces(Region.ghost, Region.ghost);
ne_elements;
terminator};
updates = {value = {compound = Braces (ghost, ghost);
ne_elements;
terminator};
region = cover $4 $6};
rbrace = $6}
in {region; value} }
@ -942,10 +942,9 @@ exprs:
in
let sequence = ESeq {
value = {
compound = BeginEnd(Region.ghost, Region.ghost);
elements = Some val_;
terminator = (snd c)
};
compound = BeginEnd (ghost, ghost);
elements = Some val_;
terminator = snd c};
region = sequence_region
}
in
@ -1012,48 +1011,23 @@ field_assignment_punning:
(* This can only happen with multiple fields -
one item punning does NOT work in ReasonML *)
field_name {
let value = {
field_name = $1;
assignment = ghost;
field_expr = EVar $1 }
let value = {field_name = $1;
assignment = ghost;
field_expr = EVar $1}
in {$1 with value}
}
| field_assignment { $1 }
field_assignment:
field_name ":" expr {
let start = $1.region in
let stop = expr_to_region $3 in
let region = cover start stop in
let value = {
field_name = $1;
assignment = $2;
field_expr = $3}
let region = cover $1.region (expr_to_region $3)
and value = {field_name = $1;
assignment = $2;
field_expr = $3}
in {region; value} }
real_selection:
field_name { FieldName $1 }
| "<int>" { Component $1 }
field_path_assignment:
real_selection {
let region = selection_to_region $1
and value = {
field_path = ($1,[]);
assignment = ghost;
field_expr = match $1 with
FieldName var -> EVar var
| Component {value;region} ->
let value = Z.to_string (snd value) in
EVar {value;region} }
in {region; value}
}
| nsepseq(real_selection,".") ":" expr {
let start = nsepseq_to_region selection_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {
field_path = $1;
assignment = $2;
field_expr = $3}
path ":" expr {
let region = cover (path_to_region $1) (expr_to_region $3)
and value = {field_path=$1; assignment=$2; field_expr=$3}
in {region; value} }

View File

@ -70,7 +70,7 @@ module ParserLog =
module Lexer = Lexer.Make (LexToken)
module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
(* Main *)
@ -78,7 +78,7 @@ let wrap = function
Stdlib.Ok ast ->
if IO.options#pretty then
begin
let doc = Pretty.make ast in
let doc = Pretty.print ast in
let width =
match Terminal_size.get_columns () with
None -> 60

View File

@ -40,14 +40,14 @@ and pp_let_binding let_ (binding : let_binding) =
let patterns = Utils.nseq_to_list binders in
let patterns = group (separate_map (break 0) pp_pattern patterns) in
let lhs =
string let_ ^^
string let_ ^^
match lhs_type with
None -> patterns ^^ string " = "
| Some (_,e) ->
patterns ^^ group (break 0 ^^ string ": " ^^ pp_type_expr e ^^ string " = ")
in
let rhs = pp_expr let_rhs in
match let_rhs with
let rhs = pp_expr let_rhs in
match let_rhs with
| EFun _
| ESeq _
| ERecord _ -> lhs ^^ rhs
@ -110,7 +110,7 @@ and pp_list_comp e = group (pp_injection pp_pattern e)
and pp_cons {value; _} =
let patt1, _, patt2 = value in
string "[" ^^ (pp_pattern patt1 ^^ string ", ") ^^ group ( break 0 ^^ string "..." ^^ pp_pattern patt2) ^^ string "]"
string "[" ^^ (pp_pattern patt1 ^^ string ", ") ^^ group ( break 0 ^^ string "..." ^^ pp_pattern patt2) ^^ string "]"
and pp_ptuple {value; _} =
let head, tail = value in
@ -162,8 +162,9 @@ and pp_expr = function
and pp_case_expr {value; _} =
let {expr; cases; _} = value in
group (string "switch" ^^ string "(" ^^ nest 1 (pp_expr expr) ^^ (string ") " ^^ string "{")
^^ (pp_cases cases) ^^ hardline ^^ string "}" )
group (string "switch" ^^ string "(" ^^ nest 1 (pp_expr expr)
^^ string ") " ^^ string "{"
^^ pp_cases cases ^^ hardline ^^ string "}")
and pp_cases {value; _} =
let head, tail = value in
@ -238,7 +239,7 @@ and pp_string_expr = function
| Verbatim e -> pp_verbatim e
and pp_list_expr = function
| ECons {value = {arg1; arg2; _}; _ } ->
| ECons {value = {arg1; arg2; _}; _ } ->
string "[" ^^ pp_expr arg1 ^^ string "," ^^ break 1 ^^ string "..." ^^ pp_expr arg2 ^^ string "]"
| EListComp e -> group (pp_injection pp_expr e)
@ -294,29 +295,22 @@ and pp_ne_injection :
string opening ^^ nest 2 (break 0 ^^ elements) ^^ break 1 ^^ string closing
and pp_nsepseq :
'a.string ->
('a -> document) ->
('a, t) Utils.nsepseq ->
document =
'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
fun sep printer elements ->
let elems = Utils.nsepseq_to_list elements
and sep = string sep ^^ break 1
in separate_map sep printer elems
and pp_nseq : 'a.('a -> document) -> 'a Utils.nseq -> document =
fun printer (head, tail) ->
separate_map (break 1) printer (head::tail)
and pp_projection {value; _} =
let {struct_name; field_path; _ } = value in
let fields = Utils.nsepseq_to_list field_path
and sep = break 0 in
let fields = separate_map sep pp_selection fields in
group (pp_ident struct_name ^^ break 0 ^^ fields)
let {struct_name; field_path; _} = value in
let subpath = Utils.nsepseq_to_list field_path in
let subpath = concat_map pp_selection subpath in
group (pp_ident struct_name ^^ subpath)
and pp_selection = function
FieldName v -> string "." ^^ string v.value
| Component cmp -> string "[" ^^ (cmp.value |> snd |> Z.to_string |> string) ^^ string "]"
FieldName v -> string "." ^^ break 0 ^^ string v.value
| Component cmp ->
string "[" ^^ (cmp.value |> snd |> Z.to_string |> string) ^^ string "]"
and pp_update {value; _} =
let {record; updates; _} = value in
@ -327,9 +321,7 @@ and pp_update {value; _} =
and pp_field_path_assign {value; _} =
let {field_path; field_expr; _} = value in
let fields = Utils.nsepseq_to_list field_path
and sep = string "." ^^ break 0 in
let path = separate_map sep pp_ident fields in
let path = pp_path field_path in
prefix 2 1 (path ^^ string ":") (pp_expr field_expr)
and pp_path = function
@ -376,8 +368,8 @@ and pp_fun {value; _} =
None -> empty
| Some (_,e) ->
group (break 0 ^^ string ": " ^^ nest 2 (pp_type_expr e))
in
match body with
in
match body with
| ESeq _ -> string "(" ^^ nest 1 binders ^^ string ")" ^^ annot ^^ string " => " ^^ pp_expr body
| _ -> (prefix 2 0 (string "(" ^^ nest 1 binders ^^ string ")" ^^ annot
^^ string " => ") (pp_expr body))
@ -411,7 +403,7 @@ and pp_cartesian {value; _} =
| [e] -> group (break 1 ^^ pp_type_expr e)
| e::items ->
group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items
in
in
string "(" ^^ nest 1 (pp_type_expr head ^^ (if tail <> [] then string "," else empty) ^^ app (List.map snd tail)) ^^ string ")"
and pp_variants {value; _} =
@ -435,17 +427,16 @@ and pp_fields fields = group (pp_ne_injection pp_field_decl fields)
and pp_field_decl {value; _} =
let {field_name; field_type; _} = value in
let name = pp_ident field_name in
match field_type with
match field_type with
| TVar v when v = field_name ->
name
| _ -> (
| _ ->
let t_expr = pp_type_expr field_type
in prefix 2 1 (name ^^ string ":") t_expr
)
and pp_type_app {value; _} =
let ctor, tuple = value in
prefix 2 0 (pp_type_constr ctor) (string "(" ^^ nest 1 (pp_type_tuple tuple) ^^ string ")")
prefix 2 0 (pp_type_constr ctor) (string "(" ^^ nest 1 (pp_type_tuple tuple) ^^ string ")")
and pp_type_tuple {value; _} =
let head, tail = value.inside in
@ -465,14 +456,14 @@ and pp_type_constr ctor = string ctor.value
and pp_fun_args {value; _} =
let lhs, _, rhs = value in
match rhs with
match rhs with
| TFun tf -> group (pp_type_expr lhs ^^ string ", " ^^ pp_fun_args tf)
| _ -> group (pp_type_expr lhs ^^ string ")" ^^ string " =>" ^/^ pp_type_expr rhs)
and pp_fun_type {value; _} =
let lhs, _, rhs = value in
match lhs, rhs with
| _, TFun tf -> string "(" ^^ pp_type_expr lhs ^^ string ", " ^^ pp_fun_args tf
match lhs, rhs with
| _, TFun tf -> string "(" ^^ pp_type_expr lhs ^^ string ", " ^^ pp_fun_args tf
| TVar _ , _ -> group (pp_type_expr lhs ^^ string " =>" ^/^ pp_type_expr rhs)
| _ -> group (string "(" ^^ nest 1 (pp_type_expr lhs) ^^ string ")" ^^ string " =>" ^/^ pp_type_expr rhs)

File diff suppressed because it is too large Load Diff

View File

@ -352,38 +352,32 @@ let rec compile_expression :
let compile_selection : Raw.selection -> access = fun s ->
match s with
| FieldName property -> Access_record property.value
| Component index -> (Access_tuple (snd index.value))
in
let compile_path : Raw.path -> string * access list = fun p ->
match p with
| Raw.Name v -> (v.value , [])
| Raw.Path p -> (
let p' = p.value in
let var = p'.struct_name.value in
let path = p'.field_path in
let path' = List.map compile_selection @@ npseq_to_list path in
(var , path')
)
in
let compile_update = fun (u:Raw.update Region.reg) ->
let (u, loc) = r_split u in
let (name, path) = compile_path u.record in
let record = match path with
| [] -> e_variable (Var.of_name name)
| _ -> e_accessor (e_variable (Var.of_name name)) path in
let updates = u.updates.value.ne_elements in
let%bind updates' =
let aux (f:Raw.field_path_assign Raw.reg) =
let (f,_) = r_split f in
let%bind expr = compile_expression f.field_expr in
ok ( List.map compile_selection (npseq_to_list f.field_path), expr)
in
bind_map_list aux @@ npseq_to_list updates
in
let aux ur (path, expr) = ok @@ e_update ~loc ur path expr in
bind_fold_list aux record updates'
in
trace (abstracting_expr t) @@
| Component index -> (Access_tuple (snd index.value)) in
let compile_path : Raw.path -> string * access list = function
Raw.Name v -> v.value, []
| Raw.Path {value; _} ->
let Raw.{struct_name; field_path; _} = value in
let var = struct_name.value in
let path = List.map compile_selection @@ npseq_to_list field_path
in var, path in
let compile_update (u: Raw.update Region.reg) =
let u, loc = r_split u in
let name, path = compile_path u.record in
let var = e_variable (Var.of_name name) in
let record = if path = [] then var else e_accessor var path in
let updates = u.updates.value.ne_elements in
let%bind updates' =
let aux (f: Raw.field_path_assignment Raw.reg) =
let f, _ = r_split f in
let%bind expr = compile_expression f.field_expr
in ok (compile_path f.field_path, expr)
in bind_map_list aux @@ npseq_to_list updates in
let aux ur ((var, path), expr) =
ok @@ e_update ~loc ur (Access_record var :: path) expr
in bind_fold_list aux record updates'
in trace (abstracting_expr t) @@
match t with
Raw.ELetIn e ->
let Raw.{kwd_rec; binding; body; attributes; _} = e.value in

View File

@ -328,7 +328,8 @@ let rec compile_expression (t:Raw.expr) : expr result =
| ERecord r ->
let%bind fields = bind_list
@@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = compile_expression v in ok (k.value, v))
@@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
@@ List.map (fun (x:Raw.field_assignment Raw.reg) ->
(x.value.field_name, x.value.field_expr))
@@ npseq_to_list r.value.ne_elements in
let aux prev (k, v) = SMap.add k v prev in
return @@ e_record (List.fold_left aux SMap.empty fields)
@ -458,36 +459,28 @@ let rec compile_expression (t:Raw.expr) : expr result =
let (f , loc) = r_split f in
let%bind (_ty_opt, f') = compile_fun_expression ~loc f
in return @@ f'
and compile_update = fun (u:Raw.update Region.reg) ->
let (u, loc) = r_split u in
let (name, path) = compile_path u.record in
let record = match path with
| [] -> e_variable (Var.of_name name)
| _ -> e_accessor (e_variable (Var.of_name name)) path in
let updates = u.updates.value.ne_elements in
and compile_update (u: Raw.update Region.reg) =
let u, loc = r_split u in
let name, path = compile_path u.record in
let var = e_variable (Var.of_name name) in
let record = if path = [] then var else e_accessor var path in
let updates = u.updates.value.ne_elements in
let%bind updates' =
let aux (f:Raw.field_path_assign Raw.reg) =
let (f,_) = r_split f in
let%bind expr = compile_expression f.field_expr in
ok ( List.map compile_selection (npseq_to_list f.field_path), expr)
in
bind_map_list aux @@ npseq_to_list updates in
let aux ur (path, expr) = ok @@ e_update ~loc ur path expr
let aux (f: Raw.field_path_assignment Raw.reg) =
let f, _ = r_split f in
let%bind expr = compile_expression f.field_expr
in ok (compile_path f.field_path, expr)
in bind_map_list aux @@ npseq_to_list updates in
let aux ur ((var, path), expr) =
ok @@ e_update ~loc ur (Access_record var :: path) expr
in bind_fold_list aux record updates'
and compile_logic_expression (t:Raw.logic_expr) : expression result =
let return x = ok x in
match t with
| BoolExpr (False reg) -> (
let loc = Location.lift reg in
return @@ e_bool ~loc false
)
| BoolExpr (True reg) -> (
let loc = Location.lift reg in
return @@ e_bool ~loc true
)
| BoolExpr (False reg) ->
ok @@ e_bool ~loc:(Location.lift reg) false
| BoolExpr (True reg) ->
ok @@ e_bool ~loc:(Location.lift reg) true
| BoolExpr (Or b) ->
compile_binop "OR" b
| BoolExpr (And b) ->
@ -857,25 +850,25 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
let (a , loc) = r_split a in
let%bind value_expr = compile_expression a.rhs in
match a.lhs with
| Path path -> (
let (name , path') = compile_path path in
| Path path ->
let name , path' = compile_path path in
let name = Var.of_name name in
return_statement @@ e_assign ~loc name path' value_expr
)
| MapPath v -> (
| MapPath v ->
let v' = v.value in
let%bind (varname,map,path) = match v'.path with
| Name name -> ok (name.value , e_variable (Var.of_name name.value), [])
| Name name ->
ok (name.value ,
e_variable (Var.of_name name.value), [])
| Path p ->
let (name,p') = compile_path v'.path in
let%bind accessor = compile_projection p in
ok @@ (name , accessor , p')
in
let%bind key_expr = compile_expression v'.index.value.inside in
let name, p' = compile_path v'.path in
let%bind accessor = compile_projection p in
ok @@ (name, accessor, p') in
let%bind key_expr =
compile_expression v'.index.value.inside in
let expr' = e_map_add key_expr value_expr map in
let varname = Var.of_name varname in
return_statement @@ e_assign ~loc varname path expr'
)
)
| CaseInstr c -> (
let (c , loc) = r_split c in
@ -891,7 +884,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
LongBlock {value; _} ->
compile_block value
| ShortBlock {value; _} ->
compile_statements @@ fst value.inside in
compile_statements @@ fst value.inside in
let%bind case_clause = case_clause None in
ok (x.value.pattern, case_clause) in
bind_list
@ -902,13 +895,13 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
)
| RecordPatch r ->
let reg = r.region in
let (r,loc) = r_split r in
let aux (fa :Raw.field_assign Raw.reg) : Raw.field_path_assign Raw.reg =
{value = {field_path = FieldName fa.value.field_name, [];
let r, loc = r_split r in
let aux (fa: Raw.field_assignment Raw.reg) : Raw.field_path_assignment Raw.reg =
{value = {field_path = Name fa.value.field_name;
assignment = fa.value.assignment;
field_expr = fa.value.field_expr};
region = fa.region} in
let update : Raw.field_path_assign Raw.reg Raw.ne_injection Raw.reg = {
let update : Raw.field_path_assignment Raw.reg Raw.ne_injection Raw.reg = {
value = Raw.map_ne_injection aux r.record_inj.value;
region = r.record_inj.region} in
let u : Raw.update = {
@ -916,12 +909,12 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
kwd_with = r.kwd_with;
updates = update} in
let%bind expr = compile_update {value=u;region=reg} in
let (name , access_path) = compile_path r.path in
let name, access_path = compile_path r.path in
let name = Var.of_name name in
return_statement @@ e_assign ~loc name access_path expr
| MapPatch patch ->
let (map_p, loc) = r_split patch in
let (name, access_path) = compile_path map_p.path in
let map_p, loc = r_split patch in
let name, access_path = compile_path map_p.path in
let%bind inj = bind_list
@@ List.map (fun (x:Raw.binding Region.reg) ->
let x = x.value in
@ -931,7 +924,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
in ok @@ (key', value')
)
@@ npseq_to_list map_p.map_inj.value.ne_elements in
match inj with
(match inj with
| [] -> return_statement @@ e_skip ~loc ()
| _ :: _ ->
let assigns = List.fold_right
@ -939,10 +932,10 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
inj
(e_accessor ~loc (e_variable (Var.of_name name)) access_path)
and name = Var.of_name name in
return_statement @@ e_assign ~loc name access_path assigns
return_statement @@ e_assign ~loc name access_path assigns)
| SetPatch patch -> (
let (setp, loc) = r_split patch in
let (name , access_path) = compile_path setp.path in
let setp, loc = r_split patch in
let name, access_path = compile_path setp.path in
let%bind inj =
bind_list @@
List.map compile_expression @@
@ -956,13 +949,13 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
let name = Var.of_name name in
return_statement @@ e_assign ~loc name access_path assigns
)
| MapRemove r -> (
| MapRemove r ->
let (v , loc) = r_split r in
let key = v.key in
let%bind (name,map,path) = match v.map with
| Name v -> ok (v.value , e_variable (Var.of_name v.value) , [])
| Path p ->
let (name,p') = compile_path v.map in
let name, p' = compile_path v.map in
let%bind accessor = compile_projection p in
ok @@ (name , accessor , p')
in
@ -970,37 +963,32 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
let expr = e_constant ~loc C_MAP_REMOVE [key' ; map] in
let name = Var.of_name name in
return_statement @@ e_assign ~loc name path expr
)
| SetRemove r -> (
let (set_rm, loc) = r_split r in
let%bind (name, set, path) = match set_rm.set with
| Name v -> ok (v.value, e_variable (Var.of_name v.value), [])
| SetRemove r ->
let set_rm, loc = r_split r in
let%bind (name, set, path) =
match set_rm.set with
| Name v ->
ok (v.value, e_variable (Var.of_name v.value), [])
| Path path ->
let(name, p') = compile_path set_rm.set in
let%bind accessor = compile_projection path in
ok @@ (name, accessor, p')
in
let name, p' = compile_path set_rm.set in
let%bind accessor = compile_projection path in
ok @@ (name, accessor, p') in
let%bind removed' = compile_expression set_rm.element in
let expr = e_constant ~loc C_SET_REMOVE [removed' ; set] in
let name = Var.of_name name in
return_statement @@ e_assign ~loc name path expr
)
and compile_path : Raw.path -> string * access list = fun p ->
match p with
| Raw.Name v -> (v.value , [])
| Raw.Path p -> (
let p' = p.value in
let var = p'.struct_name.value in
let path = p'.field_path in
let path' = List.map compile_selection @@ npseq_to_list path in
(var , path')
)
and compile_path : Raw.path -> string * access list = function
Raw.Name v -> v.value, []
| Raw.Path {value; _} ->
let Raw.{struct_name; field_path; _} = value in
let var = struct_name.value in
let path = List.map compile_selection @@ npseq_to_list field_path
in var, path
and compile_selection : Raw.selection -> access = fun s ->
match s with
| FieldName property -> Access_record property.value
| Component index -> (Access_tuple (snd index.value))
and compile_selection : Raw.selection -> access = function
FieldName property -> Access_record property.value
| Component index -> Access_tuple (snd index.value)
and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fun t ->
let open Raw in