Final touches to the pretty printers.
Fixed the syntaxes for field_assignment and field_path_assignment.
This commit is contained in:
parent
dfbba95cbf
commit
c57f499fea
@ -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
|
@ -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
|
||||
}
|
||||
|
@ -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} }
|
||||
|
@ -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 ->
|
||||
|
@ -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 *)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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>
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
}
|
||||
|
@ -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} }
|
||||
|
||||
|
@ -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
|
||||
|
@ -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 *)
|
||||
|
||||
|
@ -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
@ -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
|
||||
|
@ -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} }
|
||||
|
@ -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
|
||||
|
@ -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
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user