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/LexerUnit.ml
../shared/ParserUnit.mli ../shared/ParserUnit.mli
../shared/ParserUnit.ml ../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; lbrace : lbrace;
record : path; record : path;
kwd_with : kwd_with; kwd_with : kwd_with;
updates : field_path_assign reg ne_injection reg; updates : field_path_assignment reg ne_injection reg;
rbrace : rbrace rbrace : rbrace
} }
and field_path_assign = { and field_path_assignment = {
field_path : (selection, dot) nsepseq; field_path : path;
assignment : equal; assignment : equal;
field_expr : expr field_expr : expr
} }

View File

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

View File

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

View File

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

View File

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

View File

@ -1948,7 +1948,7 @@ interactive_expr: LBRACE Constr DOT Ident With
## ##
## Ends in an error in state: 523. ## 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: ## The known suffix of the stack is as follows:
## Constr DOT Ident ## Constr DOT Ident
@ -1960,7 +1960,7 @@ interactive_expr: LBRACE Constr DOT With
## ##
## Ends in an error in state: 522. ## 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: ## The known suffix of the stack is as follows:
## Constr DOT ## Constr DOT
@ -1972,7 +1972,7 @@ interactive_expr: LBRACE Constr With
## ##
## Ends in an error in state: 521. ## 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: ## The known suffix of the stack is as follows:
## Constr ## Constr
@ -2002,7 +2002,7 @@ interactive_expr: LBRACE Ident DOT Ident Verbatim
interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes SEMI With 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 ] ## 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 ] ## 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 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 . [ RBRACE ]
## nsepseq(field_assignment,SEMI) -> field_assignment . SEMI nsepseq(field_assignment,SEMI) [ 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 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 ] ## 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 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 ] ## 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 ] ## 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 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 . [ RBRACE ]
## nsepseq(field_assignment,SEMI) -> field_assignment . SEMI nsepseq(field_assignment,SEMI) [ 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> <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 ] ## 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 ] ## 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> <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 . [ RBRACE ]
## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . SEMI nsepseq(field_path_assignment,SEMI) [ 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 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 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 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> <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 ] ## 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 ] ## 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> <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 . [ RBRACE ]
## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . SEMI nsepseq(field_path_assignment,SEMI) [ 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 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 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 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> <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. ## 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: ## The known suffix of the stack is as follows:
## nsepseq(selection,DOT) EQ ## path EQ
## ##
<YOUR SYNTAX ERROR MESSAGE HERE> <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. ## 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: ## The known suffix of the stack is as follows:
## nsepseq(selection,DOT) ## path
## ##
## WARNING: This example involves spurious reductions. ## WARNING: This example involves spurious reductions.
## This implies that, although the LR(1) items shown above provide an ## This implies that, although the LR(1) items shown above provide an
## accurate view of the past (what has been recognized so far), they ## accurate view of the past (what has been recognized so far), they
## may provide an INCOMPLETE view of the future (what was expected next). ## 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 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> <YOUR SYNTAX ERROR MESSAGE HERE>
@ -2275,7 +2290,7 @@ interactive_expr: LBRACE With
interactive_expr: LBRACKET Verbatim SEMI Verbatim SEMI 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 ] ## nsepseq(expr,SEMI) -> expr SEMI . nsepseq(expr,SEMI) [ RBRACKET ]
## seq(__anonymous_0(expr,SEMI)) -> expr SEMI . seq(__anonymous_0(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 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 . [ RBRACKET ]
## nsepseq(expr,SEMI) -> expr . SEMI nsepseq(expr,SEMI) [ 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 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 ] ## nsepseq(expr,SEMI) -> expr SEMI . nsepseq(expr,SEMI) [ RBRACKET ]
## nseq(__anonymous_0(expr,SEMI)) -> expr SEMI . seq(__anonymous_0(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 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 . [ RBRACKET ]
## nsepseq(expr,SEMI) -> expr . SEMI nsepseq(expr,SEMI) [ 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 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 ] ## 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 28, spurious reduction of production cartesian -> core_type
## In state 36, spurious reduction of production fun_type -> cartesian ## In state 36, spurious reduction of production fun_type -> cartesian
## In state 27, spurious reduction of production type_expr -> fun_type ## 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> <YOUR SYNTAX ERROR MESSAGE HERE>
interactive_expr: LPAR Verbatim COLON With 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 ] ## annot_expr -> expr COLON . type_expr [ RPAR ]
## ##
@ -2408,7 +2423,7 @@ interactive_expr: LPAR Verbatim COLON With
interactive_expr: LPAR Verbatim 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 ] ## 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 ] ## 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 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 ] ## 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 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 ] ## 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 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 ] ## 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 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 ] ## 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 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 ] ## 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 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 ] ## 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 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 ] ## 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 ] ## 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 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 ] ## 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 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 ] ## 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 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 ] ## 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 interactive_expr: Verbatim With
## ##
## Ends in an error in state: 597. ## Ends in an error in state: 598.
## ##
## interactive_expr -> expr . EOF [ # ] ## interactive_expr -> expr . EOF [ # ]
## ##
@ -3776,7 +3791,7 @@ interactive_expr: Verbatim With
interactive_expr: With interactive_expr: With
## ##
## Ends in an error in state: 595. ## Ends in an error in state: 596.
## ##
## interactive_expr' -> . interactive_expr [ # ] ## interactive_expr' -> . interactive_expr [ # ]
## ##
@ -4222,7 +4237,7 @@ contract: Let LPAR With
contract: Let Rec WILD EQ Bytes 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 ] ## 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 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 ] ## 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 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 . [ EOF ]
## declarations -> declaration . declarations [ 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 36, spurious reduction of production fun_type -> cartesian
## In state 27, spurious reduction of production type_expr -> fun_type ## 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 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> <YOUR SYNTAX ERROR MESSAGE HERE>

View File

@ -21,5 +21,3 @@ $HOME/git/OCaml-build/Makefile
../shared/ParserUnit.mli ../shared/ParserUnit.mli
../shared/ParserUnit.ml ../shared/ParserUnit.ml
../shared/LexerLib.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 | NoneExpr of c_None
| ConstrApp of (constr * arguments option) reg | ConstrApp of (constr * arguments option) reg
and field_assign = { and field_assignment = {
field_name : field_name; field_name : field_name;
assignment : equal; assignment : equal;
field_expr : expr field_expr : expr
} }
and record = field_assign reg ne_injection and record = field_assignment reg ne_injection
and projection = { and projection = {
struct_name : variable; struct_name : variable;
@ -558,11 +558,11 @@ and projection = {
and update = { and update = {
record : path; record : path;
kwd_with : kwd_with; kwd_with : kwd_with;
updates : field_path_assign reg ne_injection reg updates : field_path_assignment reg ne_injection reg
} }
and field_path_assign = { and field_path_assignment = {
field_path : (selection, dot) nsepseq; field_path : path;
assignment : equal; assignment : equal;
field_expr : expr field_expr : expr
} }

View File

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

View File

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

View File

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

View File

@ -497,10 +497,8 @@ and pp_update {value; _} =
and pp_field_path_assign {value; _} = and pp_field_path_assign {value; _} =
let {field_path; field_expr; _} = value in let {field_path; field_expr; _} = value in
let fields = Utils.nsepseq_to_list field_path let path = pp_path field_path in
and sep = string "." ^^ break 0 in prefix 2 1 (path ^^ string " =") (pp_expr field_expr)
let fields = separate_map sep pp_ident fields in
group (fields ^^ nest 2 (break 1 ^^ string "= " ^^ pp_expr field_expr))
and pp_selection = function and pp_selection = function
FieldName v -> string v.value 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/ParserLog.ml
../cameligo/Scoping.mli ../cameligo/Scoping.mli
../cameligo/Scoping.ml ../cameligo/Scoping.ml
../cameligo/Pretty.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml

View File

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

View File

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

View File

@ -162,8 +162,9 @@ and pp_expr = function
and pp_case_expr {value; _} = and pp_case_expr {value; _} =
let {expr; cases; _} = value in let {expr; cases; _} = value in
group (string "switch" ^^ string "(" ^^ nest 1 (pp_expr expr) ^^ (string ") " ^^ string "{") group (string "switch" ^^ string "(" ^^ nest 1 (pp_expr expr)
^^ (pp_cases cases) ^^ hardline ^^ string "}" ) ^^ string ") " ^^ string "{"
^^ pp_cases cases ^^ hardline ^^ string "}")
and pp_cases {value; _} = and pp_cases {value; _} =
let head, tail = value in let head, tail = value in
@ -294,29 +295,22 @@ and pp_ne_injection :
string opening ^^ nest 2 (break 0 ^^ elements) ^^ break 1 ^^ string closing string opening ^^ nest 2 (break 0 ^^ elements) ^^ break 1 ^^ string closing
and pp_nsepseq : and pp_nsepseq :
'a.string -> 'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
('a -> document) ->
('a, t) Utils.nsepseq ->
document =
fun sep printer elements -> fun sep printer elements ->
let elems = Utils.nsepseq_to_list elements let elems = Utils.nsepseq_to_list elements
and sep = string sep ^^ break 1 and sep = string sep ^^ break 1
in separate_map sep printer elems 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; _} = and pp_projection {value; _} =
let {struct_name; field_path; _ } = value in let {struct_name; field_path; _} = value in
let fields = Utils.nsepseq_to_list field_path let subpath = Utils.nsepseq_to_list field_path in
and sep = break 0 in let subpath = concat_map pp_selection subpath in
let fields = separate_map sep pp_selection fields in group (pp_ident struct_name ^^ subpath)
group (pp_ident struct_name ^^ break 0 ^^ fields)
and pp_selection = function and pp_selection = function
FieldName v -> string "." ^^ string v.value FieldName v -> string "." ^^ break 0 ^^ string v.value
| Component cmp -> string "[" ^^ (cmp.value |> snd |> Z.to_string |> string) ^^ string "]" | Component cmp ->
string "[" ^^ (cmp.value |> snd |> Z.to_string |> string) ^^ string "]"
and pp_update {value; _} = and pp_update {value; _} =
let {record; updates; _} = value in let {record; updates; _} = value in
@ -327,9 +321,7 @@ and pp_update {value; _} =
and pp_field_path_assign {value; _} = and pp_field_path_assign {value; _} =
let {field_path; field_expr; _} = value in let {field_path; field_expr; _} = value in
let fields = Utils.nsepseq_to_list field_path let path = pp_path field_path in
and sep = string "." ^^ break 0 in
let path = separate_map sep pp_ident fields in
prefix 2 1 (path ^^ string ":") (pp_expr field_expr) prefix 2 1 (path ^^ string ":") (pp_expr field_expr)
and pp_path = function and pp_path = function
@ -438,10 +430,9 @@ and pp_field_decl {value; _} =
match field_type with match field_type with
| TVar v when v = field_name -> | TVar v when v = field_name ->
name name
| _ -> ( | _ ->
let t_expr = pp_type_expr field_type let t_expr = pp_type_expr field_type
in prefix 2 1 (name ^^ string ":") t_expr in prefix 2 1 (name ^^ string ":") t_expr
)
and pp_type_app {value; _} = and pp_type_app {value; _} =
let ctor, tuple = value in let ctor, tuple = value in

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