Merge branch 'rinderknecht@pprint' of https://gitlab.com/ligolang/ligo into reasonligo-pretty-printer
This commit is contained in:
Sander Spies
commit
c770aa3541
@ -7,7 +7,7 @@ let%expect_test _ =
|
||||
let%expect_test _ =
|
||||
run_ligo_bad ["interpret" ; "(\"thisisnotasignature\":signature)" ; "--syntax=pascaligo"] ;
|
||||
[%expect {|
|
||||
ligo: in file "", line 0, characters 1-32. Badly formatted literal: Signature thisisnotasignature {"location":"in file \"\", line 0, characters 1-32"}
|
||||
ligo: in file "", line 0, characters 0-33. Badly formatted literal: Signature thisisnotasignature {"location":"in file \"\", line 0, characters 0-33"}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -25,7 +25,7 @@ let%expect_test _ =
|
||||
let%expect_test _ =
|
||||
run_ligo_bad ["interpret" ; "(\"thisisnotapublickey\":key)" ; "--syntax=pascaligo"] ;
|
||||
[%expect {|
|
||||
ligo: in file "", line 0, characters 1-26. Badly formatted literal: key thisisnotapublickey {"location":"in file \"\", line 0, characters 1-26"}
|
||||
ligo: in file "", line 0, characters 0-27. Badly formatted literal: key thisisnotapublickey {"location":"in file \"\", line 0, characters 0-27"}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
|
||||
@ -228,7 +228,7 @@ and field_pattern = {
|
||||
and expr =
|
||||
ECase of expr case reg
|
||||
| ECond of cond_expr reg
|
||||
| EAnnot of (expr * colon * type_expr) par reg
|
||||
| EAnnot of annot_expr par reg
|
||||
| ELogic of logic_expr
|
||||
| EArith of arith_expr
|
||||
| EString of string_expr
|
||||
@ -247,6 +247,8 @@ and expr =
|
||||
| EFun of fun_expr reg
|
||||
| ESeq of expr injection reg
|
||||
|
||||
and annot_expr = expr * colon * type_expr
|
||||
|
||||
and 'a injection = {
|
||||
compound : compound;
|
||||
elements : ('a, semi) sepseq;
|
||||
|
||||
@ -583,7 +583,10 @@ core_expr:
|
||||
| record_expr { ERecord $1 }
|
||||
| update_record { EUpdate $1 }
|
||||
| par(expr) { EPar $1 }
|
||||
| par(expr ":" type_expr {$1,$2,$3}) { EAnnot $1 }
|
||||
| par(annot_expr) { EAnnot $1 }
|
||||
|
||||
annot_expr:
|
||||
expr ":" type_expr { $1,$2,$3 }
|
||||
|
||||
module_field:
|
||||
module_name "." module_fun {
|
||||
|
||||
@ -41,8 +41,9 @@ and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
|
||||
|
||||
and pp_let_binding (binding : let_binding) =
|
||||
let {binders; lhs_type; let_rhs; _} = binding in
|
||||
let patterns = Utils.nseq_to_list binders in
|
||||
let patterns = group (separate_map (break 1) pp_pattern patterns) in
|
||||
let head, tail = binders in
|
||||
let patterns =
|
||||
group (nest 2 (separate_map (break 1) pp_pattern (head::tail))) in
|
||||
let lhs =
|
||||
patterns ^^
|
||||
match lhs_type with
|
||||
@ -71,9 +72,9 @@ and pp_pattern = function
|
||||
and pp_pconstr = function
|
||||
PNone _ -> string "None"
|
||||
| PSomeApp p -> pp_patt_some p
|
||||
| PConstrApp a -> pp_patt_c_app a
|
||||
| PConstrApp a -> pp_pconstr_app a
|
||||
|
||||
and pp_patt_c_app {value; _} =
|
||||
and pp_pconstr_app {value; _} =
|
||||
match value with
|
||||
constr, None -> pp_ident constr
|
||||
| constr, Some pat ->
|
||||
@ -95,11 +96,11 @@ and pp_ppar p = pp_par pp_pattern p
|
||||
|
||||
and pp_plist = function
|
||||
PListComp cmp -> pp_list_comp cmp
|
||||
| PCons cons -> pp_cons cons
|
||||
| PCons cons -> pp_pcons cons
|
||||
|
||||
and pp_list_comp e = group (pp_injection pp_pattern e)
|
||||
|
||||
and pp_cons {value; _} =
|
||||
and pp_pcons {value; _} =
|
||||
let patt1, _, patt2 = value in
|
||||
prefix 2 1 (pp_pattern patt1 ^^ string " ::") (pp_pattern patt2)
|
||||
|
||||
@ -126,14 +127,15 @@ and pp_ptyped {value; _} =
|
||||
|
||||
and pp_type_decl decl =
|
||||
let {name; type_expr; _} = decl.value in
|
||||
let padding = match type_expr with TSum _ -> 0 | _ -> 2 in
|
||||
string "type " ^^ string name.value ^^ string " ="
|
||||
^^ group (nest 2 (break 1 ^^ pp_type_expr type_expr))
|
||||
^^ group (nest padding (break 1 ^^ pp_type_expr type_expr))
|
||||
|
||||
and pp_expr = function
|
||||
ECase e -> pp_case_expr e
|
||||
| ECond e -> group (pp_cond_expr e)
|
||||
| EAnnot e -> pp_annot_expr e
|
||||
| ELogic e -> pp_logic_expr e
|
||||
| ELogic e -> group (pp_logic_expr e)
|
||||
| EArith e -> group (pp_arith_expr e)
|
||||
| EString e -> pp_string_expr e
|
||||
| EList e -> group (pp_list_expr e)
|
||||
@ -166,14 +168,15 @@ and pp_cases {value; _} =
|
||||
|
||||
and pp_clause {value; _} =
|
||||
let {pattern; rhs; _} = value in
|
||||
prefix 4 1 (pp_pattern pattern ^^ string " ->") (pp_expr rhs)
|
||||
pp_pattern pattern ^^ prefix 4 1 (string " ->") (pp_expr rhs)
|
||||
|
||||
and pp_cond_expr {value; _} =
|
||||
let {test; ifso; kwd_else; ifnot; _} = value in
|
||||
let test = string "if " ^^ group (nest 3 (pp_expr test))
|
||||
and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso))
|
||||
and ifnot = string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot))
|
||||
in if kwd_else#is_ghost then test ^/^ ifso
|
||||
in if kwd_else#is_ghost
|
||||
then test ^/^ ifso
|
||||
else test ^/^ ifso ^/^ ifnot
|
||||
|
||||
and pp_annot_expr {value; _} =
|
||||
@ -420,7 +423,7 @@ and pp_field_decl {value; _} =
|
||||
in prefix 2 1 (name ^^ string " :") t_expr
|
||||
|
||||
and pp_type_app {value = ctor, tuple; _} =
|
||||
prefix 2 1 (pp_type_tuple tuple) (pp_type_constr ctor)
|
||||
pp_type_tuple tuple ^^ group (nest 2 (break 1 ^^ pp_type_constr ctor))
|
||||
|
||||
and pp_type_tuple {value; _} =
|
||||
let head, tail = value.inside in
|
||||
|
||||
@ -2380,14 +2380,14 @@ interactive_expr: LBRACKET With
|
||||
|
||||
<YOUR SYNTAX ERROR MESSAGE HERE>
|
||||
|
||||
interactive_expr: LPAR Verbatim COLON String VBAR
|
||||
interactive_expr: LPAR Verbatim COLON Ident VBAR
|
||||
##
|
||||
## Ends in an error in state: 582.
|
||||
## Ends in an error in state: 583.
|
||||
##
|
||||
## par(__anonymous_1) -> LPAR expr COLON type_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 ]
|
||||
##
|
||||
## The known suffix of the stack is as follows:
|
||||
## LPAR expr COLON type_expr
|
||||
## LPAR annot_expr
|
||||
##
|
||||
## WARNING: This example involves spurious reductions.
|
||||
## This implies that, although the LR(1) items shown above provide an
|
||||
@ -2396,6 +2396,7 @@ interactive_expr: LPAR Verbatim COLON String 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 582, spurious reduction of production annot_expr -> expr COLON type_expr
|
||||
##
|
||||
|
||||
<YOUR SYNTAX ERROR MESSAGE HERE>
|
||||
@ -2404,10 +2405,10 @@ interactive_expr: LPAR Verbatim COLON With
|
||||
##
|
||||
## Ends in an error in state: 581.
|
||||
##
|
||||
## par(__anonymous_1) -> LPAR expr COLON . type_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 ]
|
||||
## annot_expr -> expr COLON . type_expr [ RPAR ]
|
||||
##
|
||||
## The known suffix of the stack is as follows:
|
||||
## LPAR expr COLON
|
||||
## expr COLON
|
||||
##
|
||||
|
||||
<YOUR SYNTAX ERROR MESSAGE HERE>
|
||||
@ -2416,7 +2417,7 @@ interactive_expr: LPAR Verbatim With
|
||||
##
|
||||
## Ends in an error in state: 579.
|
||||
##
|
||||
## par(__anonymous_1) -> LPAR expr . COLON type_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 ]
|
||||
## 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 ]
|
||||
##
|
||||
## The known suffix of the stack is as follows:
|
||||
@ -2446,7 +2447,7 @@ interactive_expr: LPAR With
|
||||
##
|
||||
## Ends in an error in state: 167.
|
||||
##
|
||||
## par(__anonymous_1) -> LPAR . expr COLON type_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 ]
|
||||
## 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 ]
|
||||
## unit -> LPAR . 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 ]
|
||||
##
|
||||
@ -3753,7 +3754,7 @@ interactive_expr: Verbatim WILD
|
||||
|
||||
interactive_expr: Verbatim With
|
||||
##
|
||||
## Ends in an error in state: 599.
|
||||
## Ends in an error in state: 600.
|
||||
##
|
||||
## interactive_expr -> expr . EOF [ # ]
|
||||
##
|
||||
@ -3782,7 +3783,7 @@ interactive_expr: Verbatim With
|
||||
|
||||
interactive_expr: With
|
||||
##
|
||||
## Ends in an error in state: 597.
|
||||
## Ends in an error in state: 598.
|
||||
##
|
||||
## interactive_expr' -> . interactive_expr [ # ]
|
||||
##
|
||||
@ -4228,7 +4229,7 @@ contract: Let LPAR With
|
||||
|
||||
contract: Let Rec WILD EQ Bytes With
|
||||
##
|
||||
## Ends in an error in state: 586.
|
||||
## Ends in an error in state: 587.
|
||||
##
|
||||
## let_declaration -> Let Rec let_binding . seq(Attr) [ Type Let EOF ]
|
||||
##
|
||||
@ -4353,7 +4354,7 @@ contract: Let WILD EQ Bytes Attr With
|
||||
|
||||
contract: Let WILD EQ Bytes With
|
||||
##
|
||||
## Ends in an error in state: 588.
|
||||
## Ends in an error in state: 589.
|
||||
##
|
||||
## let_declaration -> Let let_binding . seq(Attr) [ Type Let EOF ]
|
||||
##
|
||||
@ -4489,7 +4490,7 @@ contract: Type Ident EQ Constr With
|
||||
|
||||
contract: Type Ident EQ Ident VBAR
|
||||
##
|
||||
## Ends in an error in state: 594.
|
||||
## Ends in an error in state: 595.
|
||||
##
|
||||
## declarations -> declaration . [ EOF ]
|
||||
## declarations -> declaration . declarations [ EOF ]
|
||||
@ -4505,7 +4506,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 590, spurious reduction of production declaration -> type_decl
|
||||
## In state 591, spurious reduction of production declaration -> type_decl
|
||||
##
|
||||
|
||||
<YOUR SYNTAX ERROR MESSAGE HERE>
|
||||
|
||||
@ -206,7 +206,6 @@ and type_tuple = (type_expr, comma) nsepseq par reg
|
||||
(* Function and procedure declarations *)
|
||||
|
||||
and fun_expr = {
|
||||
kwd_recursive: kwd_recursive option;
|
||||
kwd_function : kwd_function;
|
||||
param : parameters;
|
||||
colon : colon;
|
||||
@ -417,8 +416,7 @@ and for_int = {
|
||||
assign : var_assign reg;
|
||||
kwd_to : kwd_to;
|
||||
bound : expr;
|
||||
kwd_step : kwd_step option;
|
||||
step : expr option;
|
||||
step : (kwd_step * expr) option;
|
||||
block : block reg
|
||||
}
|
||||
|
||||
@ -448,7 +446,7 @@ and collection =
|
||||
and expr =
|
||||
ECase of expr case reg
|
||||
| ECond of cond_expr reg
|
||||
| EAnnot of annot_expr reg
|
||||
| EAnnot of annot_expr par reg
|
||||
| ELogic of logic_expr
|
||||
| EArith of arith_expr
|
||||
| EString of string_expr
|
||||
@ -467,7 +465,7 @@ and expr =
|
||||
| EPar of expr par reg
|
||||
| EFun of fun_expr reg
|
||||
|
||||
and annot_expr = expr * type_expr
|
||||
and annot_expr = expr * colon * type_expr
|
||||
|
||||
and set_expr =
|
||||
SetInj of expr injection reg
|
||||
@ -545,7 +543,7 @@ and constr_expr =
|
||||
|
||||
and field_assign = {
|
||||
field_name : field_name;
|
||||
equal : equal;
|
||||
assignment : equal;
|
||||
field_expr : expr
|
||||
}
|
||||
|
||||
@ -565,7 +563,7 @@ and update = {
|
||||
|
||||
and field_path_assign = {
|
||||
field_path : (field_name, dot) nsepseq;
|
||||
equal : equal;
|
||||
assignment : equal;
|
||||
field_expr : expr
|
||||
}
|
||||
|
||||
|
||||
@ -239,16 +239,15 @@ field_decl:
|
||||
|
||||
|
||||
fun_expr:
|
||||
ioption ("recursive") "function" parameters ":" type_expr "is" expr {
|
||||
let stop = expr_to_region $7 in
|
||||
let region = cover $2 stop
|
||||
and value = {kwd_recursive= $1;
|
||||
kwd_function = $2;
|
||||
param = $3;
|
||||
colon = $4;
|
||||
ret_type = $5;
|
||||
kwd_is = $6;
|
||||
return = $7}
|
||||
"function" parameters ":" type_expr "is" expr {
|
||||
let stop = expr_to_region $6 in
|
||||
let region = cover $1 stop
|
||||
and value = {kwd_function = $1;
|
||||
param = $2;
|
||||
colon = $3;
|
||||
ret_type = $4;
|
||||
kwd_is = $5;
|
||||
return = $6}
|
||||
in {region; value} }
|
||||
|
||||
(* Function declarations *)
|
||||
@ -623,7 +622,6 @@ for_loop:
|
||||
assign = $2;
|
||||
kwd_to = $3;
|
||||
bound = $4;
|
||||
kwd_step = None;
|
||||
step = None;
|
||||
block = $5}
|
||||
in For (ForInt {region; value})
|
||||
@ -634,8 +632,7 @@ for_loop:
|
||||
assign = $2;
|
||||
kwd_to = $3;
|
||||
bound = $4;
|
||||
kwd_step = Some $5;
|
||||
step = Some $6;
|
||||
step = Some ($5, $6);
|
||||
block = $7}
|
||||
in For (ForInt {region; value})
|
||||
}
|
||||
@ -849,7 +846,7 @@ core_expr:
|
||||
| "False" { ELogic (BoolExpr (False $1)) }
|
||||
| "True" { ELogic (BoolExpr (True $1)) }
|
||||
| "Unit" { EUnit $1 }
|
||||
| annot_expr { EAnnot $1 }
|
||||
| par(annot_expr) { EAnnot $1 }
|
||||
| tuple_expr { ETuple $1 }
|
||||
| list_expr { EList $1 }
|
||||
| "None" { EConstr (NoneExpr $1) }
|
||||
@ -891,12 +888,7 @@ fun_call_or_par_or_projection:
|
||||
| fun_call { ECall $1 }
|
||||
|
||||
annot_expr:
|
||||
"(" disj_expr ":" type_expr ")" {
|
||||
let start = expr_to_region $2
|
||||
and stop = type_expr_to_region $4 in
|
||||
let region = cover start stop
|
||||
and value = $2, $4
|
||||
in {region; value} }
|
||||
disj_expr ":" type_expr { $1,$2,$3 }
|
||||
|
||||
set_expr:
|
||||
injection("set",expr) { SetInj ($1 (fun region -> InjSet region)) }
|
||||
@ -984,7 +976,7 @@ update_record:
|
||||
field_assignment:
|
||||
field_name "=" expr {
|
||||
let region = cover $1.region (expr_to_region $3)
|
||||
and value = {field_name=$1; equal=$2; field_expr=$3}
|
||||
and value = {field_name=$1; assignment=$2; field_expr=$3}
|
||||
in {region; value} }
|
||||
|
||||
field_path_assignment:
|
||||
@ -992,7 +984,7 @@ field_path_assignment:
|
||||
let start = nsepseq_to_region (fun x -> x.region) $1
|
||||
and stop = expr_to_region $3 in
|
||||
let region = cover start stop
|
||||
and value = {field_path=$1; equal=$2; field_expr=$3}
|
||||
and value = {field_path=$1; assignment=$2; field_expr=$3}
|
||||
in {region; value} }
|
||||
|
||||
fun_call:
|
||||
|
||||
@ -221,9 +221,8 @@ and print_fun_decl state {value; _} =
|
||||
print_terminator state terminator;
|
||||
|
||||
and print_fun_expr state {value; _} =
|
||||
let {kwd_recursive; kwd_function; param; colon;
|
||||
let {kwd_function; param; colon;
|
||||
ret_type; kwd_is; return} : fun_expr = value in
|
||||
print_token_opt state kwd_recursive "recursive";
|
||||
print_token state kwd_function "function";
|
||||
print_parameters state param;
|
||||
print_token state colon ":";
|
||||
@ -396,19 +395,16 @@ and print_for_loop state = function
|
||||
| ForCollect for_collect -> print_for_collect state for_collect
|
||||
|
||||
and print_for_int state ({value; _} : for_int reg) =
|
||||
let {kwd_for; assign; kwd_to; bound; kwd_step; step; block} = value in
|
||||
let {kwd_for; assign; kwd_to; bound; step; block} = value in
|
||||
print_token state kwd_for "for";
|
||||
print_var_assign state assign;
|
||||
print_token state kwd_to "to";
|
||||
print_expr state bound;
|
||||
match kwd_step with
|
||||
| None -> ();
|
||||
| Some kwd_step ->
|
||||
(match step with
|
||||
None -> ();
|
||||
| Some (kwd_step, expr) ->
|
||||
print_token state kwd_step "step";
|
||||
match step with
|
||||
| None -> ();
|
||||
| Some step ->
|
||||
print_expr state step;
|
||||
print_expr state expr);
|
||||
print_block state block
|
||||
|
||||
and print_var_assign state {value; _} =
|
||||
@ -464,7 +460,9 @@ and print_expr state = function
|
||||
| EPar e -> print_par_expr state e
|
||||
| EFun e -> print_fun_expr state e
|
||||
|
||||
and print_annot_expr state (expr , type_expr) =
|
||||
and print_annot_expr state node =
|
||||
let {inside; _} : annot_expr par = node in
|
||||
let expr, _, type_expr = inside in
|
||||
print_expr state expr;
|
||||
print_type_expr state type_expr
|
||||
|
||||
@ -621,15 +619,15 @@ and print_record_expr state =
|
||||
print_ne_injection state print_field_assign
|
||||
|
||||
and print_field_assign state {value; _} =
|
||||
let {field_name; equal; field_expr} = value in
|
||||
let {field_name; assignment; field_expr} = value in
|
||||
print_var state field_name;
|
||||
print_token state equal "=";
|
||||
print_token state assignment "=";
|
||||
print_expr state field_expr
|
||||
|
||||
and print_field_path_assign state {value; _} =
|
||||
let {field_path; equal; field_expr} = value in
|
||||
let {field_path; assignment; field_expr} = value in
|
||||
print_nsepseq state "field_path" print_var field_path;
|
||||
print_token state equal "=";
|
||||
print_token state assignment "=";
|
||||
print_expr state field_expr
|
||||
|
||||
and print_update_expr state {value; _} =
|
||||
@ -1273,7 +1271,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_selection state = function
|
||||
@ -1314,17 +1312,27 @@ and pp_for_loop state = function
|
||||
pp_for_collect state value
|
||||
|
||||
and pp_for_int state for_int =
|
||||
let {assign; bound; step; block; _} = for_int in
|
||||
let arity =
|
||||
match step with None -> 3 | Some _ -> 4 in
|
||||
let () =
|
||||
let state = state#pad 3 0 in
|
||||
let state = state#pad arity 0 in
|
||||
pp_node state "<init>";
|
||||
pp_var_assign state for_int.assign.value in
|
||||
pp_var_assign state assign.value in
|
||||
let () =
|
||||
let state = state#pad 3 1 in
|
||||
let state = state#pad arity 1 in
|
||||
pp_node state "<bound>";
|
||||
pp_expr (state#pad 1 0) for_int.bound in
|
||||
pp_expr (state#pad 1 0) bound in
|
||||
let () =
|
||||
let state = state#pad 3 2 in
|
||||
let statements = for_int.block.value.statements in
|
||||
match step with
|
||||
None -> ()
|
||||
| Some (_, expr) ->
|
||||
let state = state#pad arity 2 in
|
||||
pp_node state "<step>";
|
||||
pp_expr (state#pad 1 0) expr in
|
||||
let () =
|
||||
let state = state#pad arity (arity-1) in
|
||||
let statements = block.value.statements in
|
||||
pp_node state "<statements>";
|
||||
pp_statements state statements
|
||||
in ()
|
||||
@ -1380,7 +1388,7 @@ 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>";
|
||||
pp_node state "<update>";
|
||||
let path = Utils.nsepseq_to_list value.field_path in
|
||||
List.iter (pp_ident (state#pad 2 0)) path;
|
||||
pp_expr (state#pad 2 1) value.field_expr
|
||||
@ -1432,7 +1440,7 @@ and pp_expr state = function
|
||||
pp_cond_expr state value
|
||||
| EAnnot {value; region} ->
|
||||
pp_loc_node state "EAnnot" region;
|
||||
pp_annotated state value
|
||||
pp_annotated state value.inside
|
||||
| ELogic e_logic ->
|
||||
pp_node state "ELogic";
|
||||
pp_e_logic (state#pad 1 0) e_logic
|
||||
@ -1607,7 +1615,7 @@ and pp_string_expr state = function
|
||||
pp_node state "Verbatim";
|
||||
pp_verbatim (state#pad 1 0) v
|
||||
|
||||
and pp_annotated state (expr, t_expr) =
|
||||
and pp_annotated state (expr, _, t_expr) =
|
||||
pp_expr (state#pad 2 0) expr;
|
||||
pp_type_expr (state#pad 2 1) t_expr
|
||||
|
||||
|
||||
@ -34,13 +34,13 @@ and pp_attr_decl decl = pp_ne_injection pp_string decl
|
||||
|
||||
and pp_const_decl {value; _} =
|
||||
let {name; const_type; init; attributes; _} = value in
|
||||
let start = string ("const " ^ name.value ^ " :") in
|
||||
let start = string ("const " ^ name.value) in
|
||||
let t_expr = pp_type_expr const_type in
|
||||
let attr = match attributes with
|
||||
None -> empty
|
||||
| Some a -> hardline ^^ pp_attr_decl a
|
||||
in prefix 2 1 start t_expr
|
||||
^/^ prefix 2 1 (string "=") (pp_expr init)
|
||||
| Some a -> hardline ^^ pp_attr_decl a in
|
||||
group (start ^/^ nest 2 (string ": " ^^ t_expr))
|
||||
^^ group (break 1 ^^ nest 2 (string "= " ^^ pp_expr init))
|
||||
^^ attr
|
||||
|
||||
(* Type declarations *)
|
||||
@ -119,7 +119,15 @@ and pp_type_tuple {value; _} =
|
||||
|
||||
(* Function and procedure declarations *)
|
||||
|
||||
and pp_fun_expr {value; _} = string "TODO:pp_fun_expr"
|
||||
and pp_fun_expr {value; _} =
|
||||
let {param; ret_type; return; _} : fun_expr = value in
|
||||
let start = string "function" in
|
||||
let parameters = pp_par pp_parameters param in
|
||||
let return_t = pp_type_expr ret_type in
|
||||
let expr = pp_expr return in
|
||||
group (start ^^ nest 2 (break 1 ^^ parameters))
|
||||
^^ group (break 1 ^^ nest 2 (string ": " ^^ return_t))
|
||||
^^ string " is" ^^ group (nest 4 (break 1 ^^ expr))
|
||||
|
||||
and pp_fun_decl {value; _} =
|
||||
let {kwd_recursive; fun_name; param;
|
||||
@ -128,23 +136,22 @@ and pp_fun_decl {value; _} =
|
||||
match kwd_recursive with
|
||||
None -> string "function"
|
||||
| Some _ -> string "recursive" ^/^ string "function" in
|
||||
let start = start ^^ group (break 1 ^^ nest 2 (pp_ident fun_name)) in
|
||||
let parameters = pp_par pp_parameters param in
|
||||
let return_t = pp_type_expr ret_type in
|
||||
let blk_opening, blk_in, blk_closing =
|
||||
match block_with with
|
||||
None -> empty, empty, empty
|
||||
| Some (b,_) ->
|
||||
hardline ^^ string "is block [", pp_block b, string "] with" in
|
||||
let expr = pp_expr return in
|
||||
let attr = match attributes with
|
||||
let body =
|
||||
match block_with with
|
||||
None -> group (nest 2 (break 1 ^^ expr))
|
||||
| Some (b,_) -> hardline ^^ pp_block b ^^ string " with"
|
||||
^^ group (nest 4 (break 1 ^^ expr))
|
||||
and attr =
|
||||
match attributes with
|
||||
None -> empty
|
||||
| Some a -> hardline ^^ pp_attr_decl a
|
||||
in group (start ^^ nest 2 (break 1 ^^ parameters))
|
||||
^/^ string ": " ^^ nest 2 return_t
|
||||
^^ blk_opening
|
||||
^^ nest 2 (break 0 ^^ blk_in)
|
||||
^/^ group (blk_closing ^^ nest 4 (break 1 ^^ expr))
|
||||
^^ attr
|
||||
| Some a -> hardline ^^ pp_attr_decl a in
|
||||
prefix 2 1 start parameters
|
||||
^^ group (nest 2 (break 1 ^^ string ": " ^^ nest 2 return_t ^^ string " is"))
|
||||
^^ body ^^ attr
|
||||
|
||||
and pp_parameters p = pp_nsepseq ";" pp_param_decl p
|
||||
|
||||
@ -164,7 +171,10 @@ and pp_param_var {value; _} =
|
||||
let t_expr = pp_type_expr param_type
|
||||
in prefix 2 1 (name ^^ string " :") t_expr
|
||||
|
||||
and pp_block {value; _} = pp_statements value.statements
|
||||
and pp_block {value; _} =
|
||||
string "block {"
|
||||
^^ nest 2 (hardline ^^ pp_statements value.statements)
|
||||
^^ hardline ^^ string "}"
|
||||
|
||||
and pp_statements s = pp_nsepseq ";" pp_statement s
|
||||
|
||||
@ -180,10 +190,10 @@ and pp_data_decl = function
|
||||
|
||||
and pp_var_decl {value; _} =
|
||||
let {name; var_type; init; _} = value in
|
||||
let start = string ("var " ^ name.value ^ " :") in
|
||||
let t_expr = pp_type_expr var_type
|
||||
in prefix 2 1 start
|
||||
(t_expr ^/^ prefix 2 1 (string ":=") (pp_expr init))
|
||||
let start = string ("var " ^ name.value) in
|
||||
let t_expr = pp_type_expr var_type in
|
||||
group (start ^/^ nest 2 (string ": " ^^ t_expr))
|
||||
^^ group (break 1 ^^ nest 2 (string ":= " ^^ pp_expr init))
|
||||
|
||||
and pp_instruction = function
|
||||
Cond i -> group (pp_conditional i)
|
||||
@ -198,49 +208,76 @@ and pp_instruction = function
|
||||
| MapRemove i -> pp_map_remove i
|
||||
| SetRemove i -> pp_set_remove i
|
||||
|
||||
and pp_set_remove {value; _} = string "TODO:pp_set_remove"
|
||||
and pp_set_remove {value; _} =
|
||||
let {element; set; _} : set_remove = value in
|
||||
string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr element))
|
||||
^^ group (break 1 ^^ prefix 2 1 (string "from set") (pp_path set))
|
||||
|
||||
and pp_map_remove {value; _} = string "TODO:pp_map_remove"
|
||||
and pp_map_remove {value; _} =
|
||||
let {key; map; _} = value in
|
||||
string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr key))
|
||||
^^ group (break 1 ^^ prefix 2 1 (string "from map") (pp_path map))
|
||||
|
||||
and pp_set_patch {value; _} = string "TODO:pp_set_patch"
|
||||
and pp_set_patch {value; _} =
|
||||
let {path; set_inj; _} = value in
|
||||
let inj = pp_ne_injection pp_expr set_inj in
|
||||
string "patch"
|
||||
^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
|
||||
^^ group (nest 2 (break 1 ^^ inj))
|
||||
|
||||
and pp_map_patch {value; _} = string "TODO:pp_map_patch"
|
||||
and pp_map_patch {value; _} =
|
||||
let {path; map_inj; _} = value in
|
||||
let inj = pp_ne_injection pp_binding map_inj in
|
||||
string "patch"
|
||||
^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
|
||||
^^ group (nest 2 (break 1 ^^ inj))
|
||||
|
||||
and pp_binding b = string "TODO:pp_binding"
|
||||
and pp_binding {value; _} =
|
||||
let {source; image; _} = value in
|
||||
pp_expr source
|
||||
^^ string " ->" ^^ group (nest 2 (break 1 ^^ pp_expr image))
|
||||
|
||||
and pp_record_patch {value; _} = string "TODO:pp_record_patch"
|
||||
and pp_record_patch {value; _} =
|
||||
let {path; record_inj; _} = value in
|
||||
let inj = pp_record record_inj in
|
||||
string "patch"
|
||||
^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
|
||||
^^ group (nest 2 (break 1 ^^ inj))
|
||||
|
||||
and pp_cond_expr {value; _} = string "TODO:pp_cond_expr"
|
||||
and pp_cond_expr {value; _} =
|
||||
let {test; ifso; ifnot; _} : cond_expr = value in
|
||||
let test = string "if " ^^ group (nest 3 (pp_expr test))
|
||||
and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso))
|
||||
and ifnot = string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot))
|
||||
in test ^/^ ifso ^/^ ifnot
|
||||
|
||||
and pp_conditional {value; _} =
|
||||
let {test; ifso; ifnot; _} : conditional = value in
|
||||
let test = string "if " ^^ group (nest 3 (pp_expr test))
|
||||
and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_if_clause ifso))
|
||||
and ifnot =
|
||||
if is_clause_block ifnot then
|
||||
and ifnot = match ifnot with
|
||||
ClauseInstr _ | ClauseBlock LongBlock _ ->
|
||||
string "else"
|
||||
^^ group (nest 2 (break 1 ^^ pp_if_clause ifnot))
|
||||
| ClauseBlock ShortBlock _ ->
|
||||
string "else {"
|
||||
^^ group (nest 2 (hardline ^^ pp_if_clause ifnot))
|
||||
^^ hardline ^^ string "}"
|
||||
else
|
||||
string "else" ^^ group (nest 2 (break 1 ^^ pp_if_clause ifnot))
|
||||
in test ^/^ ifso ^/^ ifnot
|
||||
|
||||
and pp_if_clause = function
|
||||
ClauseInstr i -> pp_instruction i
|
||||
| ClauseBlock b -> pp_clause_block b
|
||||
|
||||
and is_clause_block = function
|
||||
ClauseInstr _ -> false
|
||||
| ClauseBlock _ -> true
|
||||
|
||||
and pp_clause_block = function
|
||||
LongBlock b -> pp_block b
|
||||
| ShortBlock {value; _} -> Utils.(pp_statements <@ fst) value.inside
|
||||
| ShortBlock b -> Utils.(pp_statements <@ fst) b.value.inside
|
||||
|
||||
and pp_set_membership {value; _} = string "TODO:pp_set_membership"
|
||||
and pp_set_membership {value; _} =
|
||||
let {set; element; _} : set_membership = value in
|
||||
group (pp_expr set ^/^ string "contains" ^/^ pp_expr element)
|
||||
|
||||
and pp_case :
|
||||
'a.('a -> document) -> 'a case Region.reg -> document =
|
||||
and pp_case : 'a.('a -> document) -> 'a case Region.reg -> document =
|
||||
fun printer {value; _} ->
|
||||
let {expr; cases; _} = value in
|
||||
group (string "case " ^^ nest 5 (pp_expr expr) ^/^ string "of [")
|
||||
@ -249,11 +286,12 @@ and pp_case :
|
||||
|
||||
and pp_cases :
|
||||
'a.('a -> document) ->
|
||||
('a case_clause reg, vbar) Utils.nsepseq Region.reg -> document =
|
||||
('a case_clause reg, vbar) Utils.nsepseq Region.reg ->
|
||||
document =
|
||||
fun printer {value; _} ->
|
||||
let head, tail = value in
|
||||
let head = pp_case_clause printer head in
|
||||
let head = if tail = [] then head else blank 2 ^^ head in
|
||||
let head = blank 2 ^^ head in
|
||||
let rest = List.map snd tail in
|
||||
let app clause = break 1 ^^ string "| " ^^ pp_case_clause printer clause
|
||||
in head ^^ concat_map app rest
|
||||
@ -262,8 +300,7 @@ and pp_case_clause :
|
||||
'a.('a -> document) -> 'a case_clause Region.reg -> document =
|
||||
fun printer {value; _} ->
|
||||
let {pattern; rhs; _} = value in
|
||||
prefix 4 1 (pp_pattern pattern ^^ string " ->") (printer rhs)
|
||||
|
||||
pp_pattern pattern ^^ prefix 4 1 (string " ->") (printer rhs)
|
||||
|
||||
and pp_assignment {value; _} =
|
||||
let {lhs; rhs; _} = value in
|
||||
@ -277,17 +314,37 @@ and pp_loop = function
|
||||
While l -> pp_while_loop l
|
||||
| For f -> pp_for_loop f
|
||||
|
||||
and pp_while_loop {value; _} = string "TODO:pp_while_loop"
|
||||
and pp_while_loop {value; _} =
|
||||
let {cond; block; _} = value in
|
||||
prefix 2 1 (string "while") (pp_expr cond) ^^ hardline ^^ pp_block block
|
||||
|
||||
and pp_for_loop = function
|
||||
ForInt l -> pp_for_int l
|
||||
| ForCollect l -> pp_for_collect l
|
||||
|
||||
and pp_for_int {value; _} = string "TODO:pp_for_int"
|
||||
and pp_for_int {value; _} =
|
||||
let {assign; bound; step; block; _} = value in
|
||||
let step =
|
||||
match step with
|
||||
None -> empty
|
||||
| Some (_, e) -> prefix 2 1 (string " step") (pp_expr e) in
|
||||
prefix 2 1 (string "for") (pp_var_assign assign)
|
||||
^^ prefix 2 1 (string " to") (pp_expr bound)
|
||||
^^ step ^^ hardline ^^ pp_block block
|
||||
|
||||
and pp_var_assign {value; _} = string "TODO:pp_var_assign"
|
||||
and pp_var_assign {value; _} =
|
||||
let {name; expr; _} = value in
|
||||
prefix 2 1 (pp_ident name ^^ string " :=") (pp_expr expr)
|
||||
|
||||
and pp_for_collect {value; _} = string "TODO:pp_for_collect"
|
||||
and pp_for_collect {value; _} =
|
||||
let {var; bind_to; collection; expr; block; _} = value in
|
||||
let binding =
|
||||
match bind_to with
|
||||
None -> pp_ident var
|
||||
| Some (_, dest) -> pp_ident var ^^ string " -> " ^^ pp_ident dest in
|
||||
prefix 2 1 (string "for") binding
|
||||
^^ prefix 2 1 (string " in") (pp_collection collection ^/^ pp_expr expr)
|
||||
^^ hardline ^^ pp_block block
|
||||
|
||||
and pp_collection = function
|
||||
Map _ -> string "map"
|
||||
@ -300,7 +357,7 @@ and pp_expr = function
|
||||
ECase e -> pp_case pp_expr e
|
||||
| ECond e -> group (pp_cond_expr e)
|
||||
| EAnnot e -> pp_annot_expr e
|
||||
| ELogic e -> pp_logic_expr e
|
||||
| ELogic e -> group (pp_logic_expr e)
|
||||
| EArith e -> group (pp_arith_expr e)
|
||||
| EString e -> pp_string_expr e
|
||||
| EList e -> group (pp_list_expr e)
|
||||
@ -318,11 +375,14 @@ and pp_expr = function
|
||||
| EPar e -> pp_par pp_expr e
|
||||
| EFun e -> pp_fun_expr e
|
||||
|
||||
and pp_annot_expr {value; _} = string "TODO:pp_annot_expr"
|
||||
and pp_annot_expr {value; _} =
|
||||
let expr, _, type_expr = value.inside in
|
||||
group (string "(" ^^ nest 1 (pp_expr expr ^/^ string ": "
|
||||
^^ pp_type_expr type_expr ^^ string ")"))
|
||||
|
||||
and pp_set_expr = function
|
||||
SetInj inj -> string "TODO:pp_set_expr:SetInj"
|
||||
| SetMem mem -> string "TODO:pp_set_expr:SetMem"
|
||||
SetInj inj -> pp_injection pp_expr inj
|
||||
| SetMem mem -> pp_set_membership mem
|
||||
|
||||
and pp_map_expr = function
|
||||
MapLookUp fetch -> pp_map_lookup fetch
|
||||
@ -330,7 +390,7 @@ and pp_map_expr = function
|
||||
| BigMapInj inj -> pp_injection pp_binding inj
|
||||
|
||||
and pp_map_lookup {value; _} =
|
||||
pp_path value.path ^^ blank 1 ^^ pp_brackets pp_expr value.index
|
||||
prefix 2 1 (pp_path value.path) (pp_brackets pp_expr value.index)
|
||||
|
||||
and pp_path = function
|
||||
Name v -> pp_ident v
|
||||
@ -390,7 +450,7 @@ and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
|
||||
|
||||
and pp_list_expr = function
|
||||
ECons e -> pp_bin_op "#" e
|
||||
| EListComp e -> group (pp_injection pp_expr e)
|
||||
| EListComp e -> pp_injection pp_expr e
|
||||
| ENil _ -> string "nil"
|
||||
|
||||
and pp_constr_expr = function
|
||||
@ -398,11 +458,20 @@ and pp_constr_expr = function
|
||||
| NoneExpr _ -> string "None"
|
||||
| ConstrApp a -> pp_constr_app a
|
||||
|
||||
and pp_some_app {value; _} = string "TODO:pp_some_app"
|
||||
and pp_some_app {value; _} =
|
||||
prefix 4 1 (string "Some") (pp_arguments (snd value))
|
||||
|
||||
and pp_constr_app {value; _} = string "TODO:pp_constr_app"
|
||||
and pp_constr_app {value; _} =
|
||||
let constr, args = value in
|
||||
let constr = string constr.value in
|
||||
match args with
|
||||
None -> constr
|
||||
| Some tuple -> prefix 2 1 constr (pp_tuple_expr tuple)
|
||||
|
||||
and pp_field_assign {value; _} = string "TODO:pp_field_assign"
|
||||
|
||||
and pp_field_assign {value; _} =
|
||||
let {field_name; field_expr; _} = value in
|
||||
prefix 2 1 (pp_ident field_name ^^ string " =") (pp_expr field_expr)
|
||||
|
||||
and pp_record ne_inj = group (pp_ne_injection pp_field_assign ne_inj)
|
||||
|
||||
@ -413,9 +482,18 @@ and pp_projection {value; _} =
|
||||
let fields = separate_map sep pp_selection fields in
|
||||
group (pp_ident struct_name ^^ string "." ^^ break 0 ^^ fields)
|
||||
|
||||
and pp_update {value; _} = string "TODO:pp_update"
|
||||
and pp_update {value; _} =
|
||||
let {record; updates; _} = value in
|
||||
let updates = group (pp_ne_injection pp_field_path_assign updates)
|
||||
and record = pp_path record in
|
||||
record ^^ string " with" ^^ nest 2 (break 1 ^^ updates)
|
||||
|
||||
and pp_field_path_assign {value; _} = string "TODO:pp_field_path_assign"
|
||||
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))
|
||||
|
||||
and pp_selection = function
|
||||
FieldName v -> string v.value
|
||||
@ -446,14 +524,13 @@ and pp_arguments v = pp_tuple_expr v
|
||||
and pp_injection :
|
||||
'a.('a -> document) -> 'a injection reg -> document =
|
||||
fun printer {value; _} ->
|
||||
let {kind; enclosing; elements; _} = value in
|
||||
let {kind; elements; _} = value in
|
||||
let sep = string ";" ^^ break 1 in
|
||||
let elements = Utils.sepseq_to_list elements in
|
||||
let elements = separate_map sep printer elements in
|
||||
let kwd = pp_injection_kwd kind in
|
||||
let offset = String.length kwd + 2 in
|
||||
string (kwd ^ " [")
|
||||
^^ group (nest 2 (break 0 ^^ elements ^^ string "]"))
|
||||
group (string (kwd ^ " [")
|
||||
^^ nest 2 (break 0 ^^ elements) ^^ break 0 ^^ string "]")
|
||||
|
||||
and pp_injection_kwd = function
|
||||
InjSet _ -> "set"
|
||||
@ -464,12 +541,12 @@ and pp_injection_kwd = function
|
||||
and pp_ne_injection :
|
||||
'a.('a -> document) -> 'a ne_injection reg -> document =
|
||||
fun printer {value; _} ->
|
||||
let {kind; enclosing; ne_elements; _} = value in
|
||||
let {kind; ne_elements; _} = value in
|
||||
let elements = pp_nsepseq ";" printer ne_elements in
|
||||
let kwd = pp_ne_injection_kwd kind in
|
||||
let offset = String.length kwd + 2 in
|
||||
string (kwd ^ " [")
|
||||
^^ group (nest 2 (break 0 ^^ elements ^^ string "]"))
|
||||
group (string (kwd ^ " [")
|
||||
^^ group (nest 2 (break 0 ^^ elements ))
|
||||
^^ break 0 ^^ string "]")
|
||||
|
||||
and pp_ne_injection_kwd = function
|
||||
NEInjAttr _ -> "attributes"
|
||||
@ -478,10 +555,7 @@ and pp_ne_injection_kwd = function
|
||||
| NEInjRecord _ -> "record"
|
||||
|
||||
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
|
||||
@ -520,18 +594,34 @@ and pp_constr_pattern = function
|
||||
and pp_psome {value=_, p; _} =
|
||||
prefix 4 1 (string "Some") (pp_par pp_pattern p)
|
||||
|
||||
and pp_pconstr_app {value; _} = string "TODO:pp_pconstr_app"
|
||||
and pp_pconstr_app {value; _} =
|
||||
match value with
|
||||
constr, None -> pp_ident constr
|
||||
| constr, Some ptuple ->
|
||||
prefix 4 1 (pp_ident constr) (pp_tuple_pattern ptuple)
|
||||
|
||||
and pp_tuple_pattern {value; _} = string "TODO:tuple_pattern"
|
||||
and pp_tuple_pattern {value; _} =
|
||||
let head, tail = value.inside in
|
||||
let rec app = function
|
||||
[] -> empty
|
||||
| [e] -> group (break 1 ^^ pp_pattern e)
|
||||
| e::items ->
|
||||
group (break 1 ^^ pp_pattern e ^^ string ",") ^^ app items in
|
||||
let components =
|
||||
if tail = []
|
||||
then pp_pattern head
|
||||
else pp_pattern head ^^ string "," ^^ app (List.map snd tail)
|
||||
in string "(" ^^ nest 1 (components ^^ string ")")
|
||||
|
||||
and pp_list_pattern = function
|
||||
PListComp cmp -> pp_list_comp cmp
|
||||
| PNil _ -> string "nil"
|
||||
| PParCons p -> pp_ppar_cons p
|
||||
| PCons p -> pp_nsepseq "#" pp_pattern p.value
|
||||
| PCons p -> nest 4 (pp_nsepseq " #" pp_pattern p.value)
|
||||
|
||||
and pp_list_comp {value; _} = string "TODO:pp_list_comp"
|
||||
and pp_list_comp e = pp_injection pp_pattern e
|
||||
|
||||
and pp_ppar_cons {value; _} = string "TODO:pp_ppar_cons"
|
||||
|
||||
and pp_cons {value; _} = string "TODO:pp_cons"
|
||||
and pp_ppar_cons {value; _} =
|
||||
let patt1, _, patt2 = value.inside in
|
||||
let comp = prefix 2 1 (pp_pattern patt1 ^^ string " ::") (pp_pattern patt2)
|
||||
in string "(" ^^ nest 1 (comp ^^ string ")")
|
||||
|
||||
@ -1,10 +1,14 @@
|
||||
function incr_map (const l : list (int)) : list (int) is
|
||||
List.map (function (const i : int) : int is i + 1, l)
|
||||
|
||||
type t is timestamp * nat -> map (string, address)
|
||||
type u is A | B of t * int | C of int -> (string -> int)
|
||||
type v is record aaaaaa : ttttttt; bbbbbb : record ccccccccc : string end end
|
||||
(*
|
||||
|
||||
function back (var store : store) : list (operation) * store is
|
||||
begin
|
||||
var operations : list (operation) := list [];
|
||||
const operations : list (operation) = list [];
|
||||
const a : nat = 0n;
|
||||
x0 := record foo = "1"; bar = 4n end;
|
||||
x1 := nil;
|
||||
@ -13,7 +17,7 @@ function back (var store : store) : list (operation) * store is
|
||||
case foo of
|
||||
10n -> skip
|
||||
end;
|
||||
if s contains x then skip else skip;
|
||||
if saaa.0.1.2.a.b.b.x contains xxxxxxxxxxxxxxx[123] then skip else skip;
|
||||
s := set [3_000mutez; -2; 1n];
|
||||
a := A;
|
||||
b := B (a);
|
||||
@ -21,12 +25,12 @@ function back (var store : store) : list (operation) * store is
|
||||
d := None;
|
||||
e := Some (a, B (b));
|
||||
z := z.1.2;
|
||||
x := map [1 -> "1"; 2 -> "2"];
|
||||
x := if true then map [1 -> "1"; 2 -> "2"; 3 -> "3"; 4 -> "4"; 5 -> "5555555555555555"] else Unit;
|
||||
y := a.b.c[3];
|
||||
a := "hello " ^ "world" ^ "!";
|
||||
r := record a = 0 end;
|
||||
r := r with record a = 42 end;
|
||||
patch store.backers with set [(1); f(2*3)];
|
||||
r := record aaaaaaaaaaaa = 100000000; bbbbbbb = ffffff (2, aa, x, y) + 1 end;
|
||||
r := r with record aaaaaaaaaaa = 444442; bbbbbbbbb = 43 + f (z) / 234 end;
|
||||
patch store.backers.8.aa.33333.5 with set [(1); f(2*3); 123124234/2345];
|
||||
remove (1,2,3) from set foo.bar;
|
||||
remove 3 from map foo.bar;
|
||||
patch store.backers with map [sender -> amount];
|
||||
@ -39,7 +43,7 @@ function back (var store : store) : list (operation) * store is
|
||||
begin
|
||||
acc := 2 - (if toggle then f(x) else Unit);
|
||||
end;
|
||||
for i := 1n to 10n
|
||||
for i := 1n to 10n step 2n
|
||||
begin
|
||||
acc := acc + i;
|
||||
end;
|
||||
@ -53,9 +57,10 @@ function back (var store : store) : list (operation) * store is
|
||||
| False#True#Unit#0xAA#"hi"#4#nil -> skip
|
||||
]
|
||||
end with (operations, store, (more_stuff, and_here_too))
|
||||
*)
|
||||
|
||||
function claim (var store : store; const bar : t; const baz : u; var z : operations * store * (more_stuff * and_here_too)) : list (operation) * store * timestamp * nat -> map (string, address) is
|
||||
begin
|
||||
const operations : list (operation * map (address, map (longname, domain))) = nilllllllllll;
|
||||
var operations : list (operation * map (address, map (longname, domain))) := nilllllllllll;
|
||||
attributes ["foo"; "inline"];
|
||||
if now <= store.deadline then
|
||||
@ -64,20 +69,20 @@ function back (var store : store) : list (operation) * store is
|
||||
case store.backers[sender] of
|
||||
None ->
|
||||
failwith ("Not a backer.")
|
||||
| Some (0) -> skip
|
||||
| Some (quantity) ->
|
||||
if balance >= store.goal or store.funded then
|
||||
failwith ("Goal reached: no refund.")
|
||||
else
|
||||
begin
|
||||
operations.0.foo := list [transaction (unit, sender, quantity)];
|
||||
remove sender from map store.backers
|
||||
operations.0.foo := list [transaction (unit, sender, quantity); transaction (foo, bar, bazzzzzzzzzzzzzzz)];
|
||||
remove sender.0099999.fffff [fiar (abaxxasfdf)] from map store.backers.foooooo.barrrrr.01.bazzzzzzz
|
||||
end
|
||||
end
|
||||
end with long_function_name (operations, store, (more_stuff, (and_here_too, well_in_here_too), hello))
|
||||
|
||||
attributes ["inline"; "foo"]
|
||||
|
||||
(*
|
||||
function withdraw (var store : store) : list (operation) * store is
|
||||
begin
|
||||
var operations : list (operation) := list end;
|
||||
@ -95,4 +100,3 @@ function withdraw (var store : store) : list (operation) * store is
|
||||
nil -> (operations, (store : store))
|
||||
| _ -> (operations, store)
|
||||
end
|
||||
*)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -282,7 +282,8 @@ let rec compile_expression (t:Raw.expr) : expr result =
|
||||
let return x = ok x in
|
||||
match t with
|
||||
| EAnnot a -> (
|
||||
let ((expr , type_expr) , loc) = r_split a in
|
||||
let par, loc = r_split a in
|
||||
let expr, _, type_expr = par.inside in
|
||||
let%bind expr' = compile_expression expr in
|
||||
let%bind type_expr' = compile_type_expression type_expr in
|
||||
return @@ e_annotation ~loc expr' type_expr'
|
||||
@ -698,7 +699,7 @@ and compile_fun_expression :
|
||||
loc:_ -> Raw.fun_expr -> (type_expression option * expression) result =
|
||||
fun ~loc x ->
|
||||
let open! Raw in
|
||||
let {kwd_recursive;param;ret_type;return} : fun_expr = x in
|
||||
let {param; ret_type; return; _} : fun_expr = x in
|
||||
let statements = [] in
|
||||
(match param.value.inside with
|
||||
a, [] -> (
|
||||
@ -714,10 +715,8 @@ and compile_fun_expression :
|
||||
bind_fold_right_list aux result body in
|
||||
let binder = Var.of_name binder in
|
||||
let fun_type = t_function input_type output_type in
|
||||
let expression = match kwd_recursive with
|
||||
| None -> e_lambda ~loc binder (Some input_type)(Some output_type) result
|
||||
| Some _ -> e_recursive ~loc binder fun_type
|
||||
@@ {binder;input_type=Some input_type; output_type= Some output_type; result}
|
||||
let expression =
|
||||
e_lambda ~loc binder (Some input_type)(Some output_type) result
|
||||
in
|
||||
ok (Some fun_type , expression)
|
||||
)
|
||||
@ -745,10 +744,8 @@ and compile_fun_expression :
|
||||
let aux prec cur = cur (Some prec) in
|
||||
bind_fold_right_list aux result body in
|
||||
let fun_type = t_function input_type output_type in
|
||||
let expression = match kwd_recursive with
|
||||
| None -> e_lambda ~loc binder (Some input_type)(Some output_type) result
|
||||
| Some _ -> e_recursive ~loc binder fun_type
|
||||
@@ {binder;input_type=Some input_type; output_type= Some output_type; result}
|
||||
let expression =
|
||||
e_lambda ~loc binder (Some input_type)(Some output_type) result
|
||||
in
|
||||
ok (Some fun_type , expression)
|
||||
)
|
||||
@ -822,7 +819,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
|
||||
let%bind bound = compile_expression fi.bound in
|
||||
let%bind step = match fi.step with
|
||||
| None -> ok @@ e_int_z Z.one
|
||||
| Some step -> compile_expression step in
|
||||
| Some (_, step) -> compile_expression step in
|
||||
let%bind body = compile_block fi.block.value in
|
||||
let%bind body = body @@ None in
|
||||
return_statement @@ e_for ~loc binder start bound step body
|
||||
@ -910,23 +907,24 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
|
||||
let%bind m = compile_cases cases in
|
||||
return_statement @@ e_matching ~loc expr m
|
||||
)
|
||||
| RecordPatch r -> (
|
||||
| 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 = (fa.value.field_name, []); equal=fa.value.equal; field_expr = fa.value.field_expr};
|
||||
region = fa.region}
|
||||
in
|
||||
{value = {field_path = 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 = {
|
||||
value = Raw.map_ne_injection aux r.record_inj.value;
|
||||
region=r.record_inj.region
|
||||
} in
|
||||
let u : Raw.update = {record=r.path;kwd_with=r.kwd_with; updates=update} in
|
||||
region = r.record_inj.region} in
|
||||
let u : Raw.update = {
|
||||
record = r.path;
|
||||
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
|
||||
return_statement @@ e_ez_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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user