Merge branch 'rinderknecht-dev' into 'dev'
Refactoring of PascaLIGO's front-end See merge request ligolang/ligo!176
This commit is contained in:
Christian Rinderknecht
commit
759978393a
@ -878,13 +878,13 @@ and pp_arith_expr buffer ~pad:(_,pc as pad) = function
|
|||||||
pp_node buffer ~pad "Mutez";
|
pp_node buffer ~pad "Mutez";
|
||||||
pp_int buffer ~pad m
|
pp_int buffer ~pad m
|
||||||
|
|
||||||
and pp_e_logic buffer ~pad = function
|
and pp_e_logic buffer ~pad:(_,pc as pad) = function
|
||||||
BoolExpr e ->
|
BoolExpr e ->
|
||||||
pp_node buffer ~pad "BoolExpr";
|
pp_node buffer ~pad "BoolExpr";
|
||||||
pp_bool_expr buffer ~pad e
|
pp_bool_expr buffer ~pad:(mk_pad 1 0 pc) e
|
||||||
| CompExpr e ->
|
| CompExpr e ->
|
||||||
pp_node buffer ~pad "CompExpr";
|
pp_node buffer ~pad "CompExpr";
|
||||||
pp_comp_expr buffer ~pad e
|
pp_comp_expr buffer ~pad:(mk_pad 1 0 pc) e
|
||||||
|
|
||||||
and pp_bool_expr buffer ~pad:(_,pc as pad) = function
|
and pp_bool_expr buffer ~pad:(_,pc as pad) = function
|
||||||
Or {value; region} ->
|
Or {value; region} ->
|
||||||
@ -892,13 +892,12 @@ and pp_bool_expr buffer ~pad:(_,pc as pad) = function
|
|||||||
| And {value; region} ->
|
| And {value; region} ->
|
||||||
pp_bin_op "And" region buffer ~pad value
|
pp_bin_op "And" region buffer ~pad value
|
||||||
| Not {value; _} ->
|
| Not {value; _} ->
|
||||||
let _, pc as pad = mk_pad 1 0 pc in
|
|
||||||
pp_node buffer ~pad "Not";
|
pp_node buffer ~pad "Not";
|
||||||
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg
|
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg
|
||||||
| False region ->
|
| False region ->
|
||||||
pp_loc_node buffer ~pad:(mk_pad 1 0 pc) "False" region
|
pp_loc_node buffer ~pad "False" region
|
||||||
| True region ->
|
| True region ->
|
||||||
pp_loc_node buffer ~pad:(mk_pad 1 0 pc) "True" region
|
pp_loc_node buffer ~pad "True" region
|
||||||
|
|
||||||
and pp_comp_expr buffer ~pad = function
|
and pp_comp_expr buffer ~pad = function
|
||||||
Lt {value; region} ->
|
Lt {value; region} ->
|
||||||
|
|||||||
@ -191,13 +191,13 @@ and type_expr =
|
|||||||
| TApp of (type_name * type_tuple) reg
|
| TApp of (type_name * type_tuple) reg
|
||||||
| TFun of (type_expr * arrow * type_expr) reg
|
| TFun of (type_expr * arrow * type_expr) reg
|
||||||
| TPar of type_expr par reg
|
| TPar of type_expr par reg
|
||||||
| TAlias of variable
|
| TVar of variable
|
||||||
|
|
||||||
and cartesian = (type_expr, times) nsepseq reg
|
and cartesian = (type_expr, times) nsepseq reg
|
||||||
|
|
||||||
and variant = {
|
and variant = {
|
||||||
constr : constr;
|
constr : constr;
|
||||||
args : (kwd_of * type_expr) option
|
arg : (kwd_of * type_expr) option
|
||||||
}
|
}
|
||||||
|
|
||||||
and field_decl = {
|
and field_decl = {
|
||||||
@ -211,17 +211,18 @@ and type_tuple = (type_expr, comma) nsepseq par reg
|
|||||||
(* Function and procedure declarations *)
|
(* Function and procedure declarations *)
|
||||||
|
|
||||||
and fun_decl = {
|
and fun_decl = {
|
||||||
kwd_function : kwd_function;
|
kwd_function : kwd_function;
|
||||||
name : variable;
|
name : variable;
|
||||||
param : parameters;
|
param : parameters;
|
||||||
colon : colon;
|
colon : colon;
|
||||||
ret_type : type_expr;
|
ret_type : type_expr;
|
||||||
kwd_is : kwd_is;
|
kwd_is : kwd_is;
|
||||||
local_decls : local_decl list;
|
local_decls : local_decl list;
|
||||||
block : block reg option;
|
block : block reg option;
|
||||||
kwd_with : kwd_with option;
|
kwd_with : kwd_with option;
|
||||||
return : expr;
|
return : expr;
|
||||||
terminator : semi option }
|
terminator : semi option
|
||||||
|
}
|
||||||
|
|
||||||
and parameters = (param_decl, semi) nsepseq par reg
|
and parameters = (param_decl, semi) nsepseq par reg
|
||||||
|
|
||||||
@ -456,7 +457,7 @@ and expr =
|
|||||||
| EList of list_expr
|
| EList of list_expr
|
||||||
| ESet of set_expr
|
| ESet of set_expr
|
||||||
| EConstr of constr_expr
|
| EConstr of constr_expr
|
||||||
| ERecord of record_expr
|
| ERecord of field_assign reg ne_injection reg
|
||||||
| EProj of projection reg
|
| EProj of projection reg
|
||||||
| EMap of map_expr
|
| EMap of map_expr
|
||||||
| EVar of Lexer.lexeme reg
|
| EVar of Lexer.lexeme reg
|
||||||
@ -497,7 +498,7 @@ and closing =
|
|||||||
and map_expr =
|
and map_expr =
|
||||||
MapLookUp of map_lookup reg
|
MapLookUp of map_lookup reg
|
||||||
| MapInj of binding reg injection reg
|
| MapInj of binding reg injection reg
|
||||||
| BigMapInj of binding reg injection reg
|
| BigMapInj of binding reg injection reg
|
||||||
|
|
||||||
and map_lookup = {
|
and map_lookup = {
|
||||||
path : path;
|
path : path;
|
||||||
@ -554,19 +555,15 @@ and string_expr =
|
|||||||
| String of Lexer.lexeme reg
|
| String of Lexer.lexeme reg
|
||||||
|
|
||||||
and list_expr =
|
and list_expr =
|
||||||
Cons of cons bin_op reg
|
ECons of cons bin_op reg
|
||||||
| List of expr injection reg
|
| EListComp of expr injection reg
|
||||||
| Nil of nil
|
| ENil of kwd_nil
|
||||||
|
|
||||||
and nil = kwd_nil
|
|
||||||
|
|
||||||
and constr_expr =
|
and constr_expr =
|
||||||
SomeApp of (c_Some * arguments) reg
|
SomeApp of (c_Some * arguments) reg
|
||||||
| NoneExpr of none_expr
|
| NoneExpr of c_None
|
||||||
| ConstrApp of (constr * arguments option) reg
|
| ConstrApp of (constr * arguments option) reg
|
||||||
|
|
||||||
and record_expr = field_assign reg injection reg
|
|
||||||
|
|
||||||
and field_assign = {
|
and field_assign = {
|
||||||
field_name : field_name;
|
field_name : field_name;
|
||||||
equal : equal;
|
equal : equal;
|
||||||
@ -585,8 +582,6 @@ and selection =
|
|||||||
|
|
||||||
and tuple_expr = (expr, comma) nsepseq par reg
|
and tuple_expr = (expr, comma) nsepseq par reg
|
||||||
|
|
||||||
and none_expr = c_None
|
|
||||||
|
|
||||||
and fun_call = (fun_name * arguments) reg
|
and fun_call = (fun_name * arguments) reg
|
||||||
|
|
||||||
and arguments = tuple_expr
|
and arguments = tuple_expr
|
||||||
@ -594,28 +589,31 @@ and arguments = tuple_expr
|
|||||||
(* Patterns *)
|
(* Patterns *)
|
||||||
|
|
||||||
and pattern =
|
and pattern =
|
||||||
PCons of (pattern, cons) nsepseq reg
|
PConstr of constr_pattern
|
||||||
| PConstr of (constr * tuple_pattern option) reg
|
|
||||||
| PVar of Lexer.lexeme reg
|
| PVar of Lexer.lexeme reg
|
||||||
| PWild of wild
|
| PWild of wild
|
||||||
| PInt of (Lexer.lexeme * Z.t) reg
|
| PInt of (Lexer.lexeme * Z.t) reg
|
||||||
| PNat of (Lexer.lexeme * Z.t) reg
|
| PNat of (Lexer.lexeme * Z.t) reg
|
||||||
| PBytes of (Lexer.lexeme * Hex.t) reg
|
| PBytes of (Lexer.lexeme * Hex.t) reg
|
||||||
| PString of Lexer.lexeme reg
|
| PString of Lexer.lexeme reg
|
||||||
| PUnit of c_Unit
|
|
||||||
| PFalse of c_False
|
|
||||||
| PTrue of c_True
|
|
||||||
| PNone of c_None
|
|
||||||
| PSome of (c_Some * pattern par reg) reg
|
|
||||||
| PList of list_pattern
|
| PList of list_pattern
|
||||||
| PTuple of tuple_pattern
|
| PTuple of tuple_pattern
|
||||||
|
|
||||||
|
and constr_pattern =
|
||||||
|
PUnit of c_Unit
|
||||||
|
| PFalse of c_False
|
||||||
|
| PTrue of c_True
|
||||||
|
| PNone of c_None
|
||||||
|
| PSomeApp of (c_Some * pattern par reg) reg
|
||||||
|
| PConstrApp of (constr * tuple_pattern option) reg
|
||||||
|
|
||||||
and tuple_pattern = (pattern, comma) nsepseq par reg
|
and tuple_pattern = (pattern, comma) nsepseq par reg
|
||||||
|
|
||||||
and list_pattern =
|
and list_pattern =
|
||||||
Sugar of pattern injection reg
|
PListComp of pattern injection reg
|
||||||
| PNil of kwd_nil
|
| PNil of kwd_nil
|
||||||
| Raw of (pattern * cons * pattern) par reg
|
| PParCons of (pattern * cons * pattern) par reg
|
||||||
|
| PCons of (pattern, cons) nsepseq reg
|
||||||
|
|
||||||
(* Projecting regions *)
|
(* Projecting regions *)
|
||||||
|
|
||||||
@ -628,7 +626,7 @@ let type_expr_to_region = function
|
|||||||
| TApp {region; _}
|
| TApp {region; _}
|
||||||
| TFun {region; _}
|
| TFun {region; _}
|
||||||
| TPar {region; _}
|
| TPar {region; _}
|
||||||
| TAlias {region; _} -> region
|
| TVar {region; _} -> region
|
||||||
|
|
||||||
let rec expr_to_region = function
|
let rec expr_to_region = function
|
||||||
| ELogic e -> logic_expr_to_region e
|
| ELogic e -> logic_expr_to_region e
|
||||||
@ -698,9 +696,9 @@ and string_expr_to_region = function
|
|||||||
and annot_expr_to_region {region; _} = region
|
and annot_expr_to_region {region; _} = region
|
||||||
|
|
||||||
and list_expr_to_region = function
|
and list_expr_to_region = function
|
||||||
Cons {region; _}
|
ECons {region; _}
|
||||||
| List {region; _}
|
| EListComp {region; _}
|
||||||
| Nil region -> region
|
| ENil region -> region
|
||||||
|
|
||||||
and constr_expr_to_region = function
|
and constr_expr_to_region = function
|
||||||
NoneExpr region
|
NoneExpr region
|
||||||
@ -733,26 +731,26 @@ let clause_block_to_region = function
|
|||||||
| ShortBlock {region; _} -> region
|
| ShortBlock {region; _} -> region
|
||||||
|
|
||||||
let if_clause_to_region = function
|
let if_clause_to_region = function
|
||||||
ClauseInstr instr -> instr_to_region instr
|
ClauseInstr instr -> instr_to_region instr
|
||||||
| ClauseBlock clause_block -> clause_block_to_region clause_block
|
| ClauseBlock clause_block -> clause_block_to_region clause_block
|
||||||
|
|
||||||
let pattern_to_region = function
|
let pattern_to_region = function
|
||||||
PCons {region; _}
|
PVar {region; _}
|
||||||
| PVar {region; _}
|
|
||||||
| PWild region
|
| PWild region
|
||||||
| PInt {region; _}
|
| PInt {region; _}
|
||||||
| PNat {region; _}
|
| PNat {region; _}
|
||||||
| PBytes {region; _}
|
| PBytes {region; _}
|
||||||
| PString {region; _}
|
| PString {region; _}
|
||||||
| PUnit region
|
| PConstr PUnit region
|
||||||
| PFalse region
|
| PConstr PFalse region
|
||||||
| PTrue region
|
| PConstr PTrue region
|
||||||
| PNone region
|
| PConstr PNone region
|
||||||
| PSome {region; _}
|
| PConstr PSomeApp {region; _}
|
||||||
| PList Sugar {region; _}
|
| PConstr PConstrApp {region; _}
|
||||||
|
| PList PListComp {region; _}
|
||||||
| PList PNil region
|
| PList PNil region
|
||||||
| PList Raw {region; _}
|
| PList PParCons {region; _}
|
||||||
| PConstr {region; _}
|
| PList PCons {region; _}
|
||||||
| PTuple {region; _} -> region
|
| PTuple {region; _} -> region
|
||||||
|
|
||||||
let local_decl_to_region = function
|
let local_decl_to_region = function
|
||||||
|
|||||||
@ -182,13 +182,13 @@ and type_expr =
|
|||||||
| TApp of (type_name * type_tuple) reg
|
| TApp of (type_name * type_tuple) reg
|
||||||
| TFun of (type_expr * arrow * type_expr) reg
|
| TFun of (type_expr * arrow * type_expr) reg
|
||||||
| TPar of type_expr par reg
|
| TPar of type_expr par reg
|
||||||
| TAlias of variable
|
| TVar of variable
|
||||||
|
|
||||||
and cartesian = (type_expr, times) nsepseq reg
|
and cartesian = (type_expr, times) nsepseq reg
|
||||||
|
|
||||||
and variant = {
|
and variant = {
|
||||||
constr : constr;
|
constr : constr;
|
||||||
args : (kwd_of * type_expr) option
|
arg : (kwd_of * type_expr) option
|
||||||
}
|
}
|
||||||
|
|
||||||
and field_decl = {
|
and field_decl = {
|
||||||
@ -447,7 +447,7 @@ and expr =
|
|||||||
| EList of list_expr
|
| EList of list_expr
|
||||||
| ESet of set_expr
|
| ESet of set_expr
|
||||||
| EConstr of constr_expr
|
| EConstr of constr_expr
|
||||||
| ERecord of record_expr
|
| ERecord of field_assign reg ne_injection reg
|
||||||
| EProj of projection reg
|
| EProj of projection reg
|
||||||
| EMap of map_expr
|
| EMap of map_expr
|
||||||
| EVar of Lexer.lexeme reg
|
| EVar of Lexer.lexeme reg
|
||||||
@ -545,19 +545,15 @@ and string_expr =
|
|||||||
| String of Lexer.lexeme reg
|
| String of Lexer.lexeme reg
|
||||||
|
|
||||||
and list_expr =
|
and list_expr =
|
||||||
Cons of cons bin_op reg
|
ECons of cons bin_op reg
|
||||||
| List of expr injection reg
|
| EListComp of expr injection reg
|
||||||
| Nil of nil
|
| ENil of kwd_nil
|
||||||
|
|
||||||
and nil = kwd_nil
|
|
||||||
|
|
||||||
and constr_expr =
|
and constr_expr =
|
||||||
SomeApp of (c_Some * arguments) reg
|
SomeApp of (c_Some * arguments) reg
|
||||||
| NoneExpr of none_expr
|
| NoneExpr of c_None
|
||||||
| ConstrApp of (constr * arguments option) reg
|
| ConstrApp of (constr * arguments option) reg
|
||||||
|
|
||||||
and record_expr = field_assign reg injection reg
|
|
||||||
|
|
||||||
and field_assign = {
|
and field_assign = {
|
||||||
field_name : field_name;
|
field_name : field_name;
|
||||||
equal : equal;
|
equal : equal;
|
||||||
@ -576,8 +572,6 @@ and selection =
|
|||||||
|
|
||||||
and tuple_expr = (expr, comma) nsepseq par reg
|
and tuple_expr = (expr, comma) nsepseq par reg
|
||||||
|
|
||||||
and none_expr = c_None
|
|
||||||
|
|
||||||
and fun_call = (fun_name * arguments) reg
|
and fun_call = (fun_name * arguments) reg
|
||||||
|
|
||||||
and arguments = tuple_expr
|
and arguments = tuple_expr
|
||||||
@ -585,28 +579,31 @@ and arguments = tuple_expr
|
|||||||
(* Patterns *)
|
(* Patterns *)
|
||||||
|
|
||||||
and pattern =
|
and pattern =
|
||||||
PCons of (pattern, cons) nsepseq reg
|
PConstr of constr_pattern
|
||||||
| PConstr of (constr * tuple_pattern option) reg
|
|
||||||
| PVar of Lexer.lexeme reg
|
| PVar of Lexer.lexeme reg
|
||||||
| PWild of wild
|
| PWild of wild
|
||||||
| PInt of (Lexer.lexeme * Z.t) reg
|
| PInt of (Lexer.lexeme * Z.t) reg
|
||||||
| PNat of (Lexer.lexeme * Z.t) reg
|
| PNat of (Lexer.lexeme * Z.t) reg
|
||||||
| PBytes of (Lexer.lexeme * Hex.t) reg
|
| PBytes of (Lexer.lexeme * Hex.t) reg
|
||||||
| PString of Lexer.lexeme reg
|
| PString of Lexer.lexeme reg
|
||||||
| PUnit of c_Unit
|
|
||||||
| PFalse of c_False
|
|
||||||
| PTrue of c_True
|
|
||||||
| PNone of c_None
|
|
||||||
| PSome of (c_Some * pattern par reg) reg
|
|
||||||
| PList of list_pattern
|
| PList of list_pattern
|
||||||
| PTuple of tuple_pattern
|
| PTuple of tuple_pattern
|
||||||
|
|
||||||
|
and constr_pattern =
|
||||||
|
PUnit of c_Unit
|
||||||
|
| PFalse of c_False
|
||||||
|
| PTrue of c_True
|
||||||
|
| PNone of c_None
|
||||||
|
| PSomeApp of (c_Some * pattern par reg) reg
|
||||||
|
| PConstrApp of (constr * tuple_pattern option) reg
|
||||||
|
|
||||||
and tuple_pattern = (pattern, comma) nsepseq par reg
|
and tuple_pattern = (pattern, comma) nsepseq par reg
|
||||||
|
|
||||||
and list_pattern =
|
and list_pattern =
|
||||||
Sugar of pattern injection reg
|
PListComp of pattern injection reg
|
||||||
| PNil of kwd_nil
|
| PNil of kwd_nil
|
||||||
| Raw of (pattern * cons * pattern) par reg
|
| PParCons of (pattern * cons * pattern) par reg
|
||||||
|
| PCons of (pattern, cons) nsepseq reg
|
||||||
|
|
||||||
(* Projecting regions *)
|
(* Projecting regions *)
|
||||||
|
|
||||||
|
|||||||
@ -956,7 +956,7 @@ functions, in the tradition of Pascal. For example,
|
|||||||
begin
|
begin
|
||||||
skip
|
skip
|
||||||
end with i+1
|
end with i+1
|
||||||
const item : int = 0
|
const item : int = 0
|
||||||
begin
|
begin
|
||||||
var temp : list (int) := nil;
|
var temp : list (int) := nil;
|
||||||
for item in l
|
for item in l
|
||||||
|
|||||||
@ -70,51 +70,50 @@ type t =
|
|||||||
|
|
||||||
(* Keywords *)
|
(* Keywords *)
|
||||||
|
|
||||||
| And of Region.t (* "and" *)
|
| And of Region.t (* "and" *)
|
||||||
| Begin of Region.t (* "begin" *)
|
| Begin of Region.t (* "begin" *)
|
||||||
| BigMap of Region.t (* "big_map" *)
|
| BigMap of Region.t (* "big_map" *)
|
||||||
| Block of Region.t (* "block" *)
|
| Block of Region.t (* "block" *)
|
||||||
| Case of Region.t (* "case" *)
|
| Case of Region.t (* "case" *)
|
||||||
| Const of Region.t (* "const" *)
|
| Const of Region.t (* "const" *)
|
||||||
| Contains of Region.t (* "contains" *)
|
| Contains of Region.t (* "contains" *)
|
||||||
| Down of Region.t (* "down" *)
|
| Down of Region.t (* "down" *)
|
||||||
| Else of Region.t (* "else" *)
|
| Else of Region.t (* "else" *)
|
||||||
| End of Region.t (* "end" *)
|
| End of Region.t (* "end" *)
|
||||||
| Fail of Region.t (* "fail" *)
|
| Fail of Region.t (* "fail" *)
|
||||||
| For of Region.t (* "for" *)
|
| False of Region.t (* "False" *)
|
||||||
| From of Region.t (* "from" *)
|
| For of Region.t (* "for" *)
|
||||||
| Function of Region.t (* "function" *)
|
| From of Region.t (* "from" *)
|
||||||
| If of Region.t (* "if" *)
|
| Function of Region.t (* "function" *)
|
||||||
| In of Region.t (* "in" *)
|
| If of Region.t (* "if" *)
|
||||||
| Is of Region.t (* "is" *)
|
| In of Region.t (* "in" *)
|
||||||
| List of Region.t (* "list" *)
|
| Is of Region.t (* "is" *)
|
||||||
| Map of Region.t (* "map" *)
|
| List of Region.t (* "list" *)
|
||||||
| Mod of Region.t (* "mod" *)
|
| Map of Region.t (* "map" *)
|
||||||
| Nil of Region.t (* "nil" *)
|
| Mod of Region.t (* "mod" *)
|
||||||
| Not of Region.t (* "not" *)
|
| Nil of Region.t (* "nil" *)
|
||||||
| Of of Region.t (* "of" *)
|
| Not of Region.t (* "not" *)
|
||||||
| Or of Region.t (* "or" *)
|
| Of of Region.t (* "of" *)
|
||||||
| Patch of Region.t (* "patch" *)
|
| Or of Region.t (* "or" *)
|
||||||
| Procedure of Region.t (* "procedure" *)
|
| Patch of Region.t (* "patch" *)
|
||||||
| Record of Region.t (* "record" *)
|
| Record of Region.t (* "record" *)
|
||||||
| Remove of Region.t (* "remove" *)
|
| Remove of Region.t (* "remove" *)
|
||||||
| Set of Region.t (* "set" *)
|
| Set of Region.t (* "set" *)
|
||||||
| Skip of Region.t (* "skip" *)
|
| Skip of Region.t (* "skip" *)
|
||||||
| Step of Region.t (* "step" *)
|
| Step of Region.t (* "step" *)
|
||||||
| Then of Region.t (* "then" *)
|
| Then of Region.t (* "then" *)
|
||||||
| To of Region.t (* "to" *)
|
| To of Region.t (* "to" *)
|
||||||
| Type of Region.t (* "type" *)
|
| True of Region.t (* "True" *)
|
||||||
| Var of Region.t (* "var" *)
|
| Type of Region.t (* "type" *)
|
||||||
| While of Region.t (* "while" *)
|
| Unit of Region.t (* "Unit" *)
|
||||||
| With of Region.t (* "with" *)
|
| Var of Region.t (* "var" *)
|
||||||
|
| While of Region.t (* "while" *)
|
||||||
|
| With of Region.t (* "with" *)
|
||||||
|
|
||||||
(* Data constructors *)
|
(* Data constructors *)
|
||||||
|
|
||||||
| C_False of Region.t (* "False" *)
|
|
||||||
| C_None of Region.t (* "None" *)
|
| C_None of Region.t (* "None" *)
|
||||||
| C_Some of Region.t (* "Some" *)
|
| C_Some of Region.t (* "Some" *)
|
||||||
| C_True of Region.t (* "True" *)
|
|
||||||
| C_Unit of Region.t (* "Unit" *)
|
|
||||||
|
|
||||||
(* Virtual tokens *)
|
(* Virtual tokens *)
|
||||||
|
|
||||||
|
|||||||
@ -68,73 +68,50 @@ type t =
|
|||||||
|
|
||||||
(* Keywords *)
|
(* Keywords *)
|
||||||
|
|
||||||
| And of Region.t (* "and" *)
|
| And of Region.t (* "and" *)
|
||||||
| Begin of Region.t (* "begin" *)
|
| Begin of Region.t (* "begin" *)
|
||||||
| BigMap of Region.t (* "big_map" *)
|
| BigMap of Region.t (* "big_map" *)
|
||||||
| Block of Region.t (* "block" *)
|
| Block of Region.t (* "block" *)
|
||||||
| Case of Region.t (* "case" *)
|
| Case of Region.t (* "case" *)
|
||||||
| Const of Region.t (* "const" *)
|
| Const of Region.t (* "const" *)
|
||||||
| Contains of Region.t (* "contains" *)
|
| Contains of Region.t (* "contains" *)
|
||||||
| Down of Region.t (* "down" *)
|
| Down of Region.t (* "down" *)
|
||||||
| Else of Region.t (* "else" *)
|
| Else of Region.t (* "else" *)
|
||||||
| End of Region.t (* "end" *)
|
| End of Region.t (* "end" *)
|
||||||
| Fail of Region.t (* "fail" *)
|
| Fail of Region.t (* "fail" *)
|
||||||
| For of Region.t (* "for" *)
|
| False of Region.t (* "False" *)
|
||||||
| From of Region.t (* "from" *)
|
| For of Region.t (* "for" *)
|
||||||
| Function of Region.t (* "function" *)
|
| From of Region.t (* "from" *)
|
||||||
| If of Region.t (* "if" *)
|
| Function of Region.t (* "function" *)
|
||||||
| In of Region.t (* "in" *)
|
| If of Region.t (* "if" *)
|
||||||
| Is of Region.t (* "is" *)
|
| In of Region.t (* "in" *)
|
||||||
| List of Region.t (* "list" *)
|
| Is of Region.t (* "is" *)
|
||||||
| Map of Region.t (* "map" *)
|
| List of Region.t (* "list" *)
|
||||||
| Mod of Region.t (* "mod" *)
|
| Map of Region.t (* "map" *)
|
||||||
| Nil of Region.t (* "nil" *)
|
| Mod of Region.t (* "mod" *)
|
||||||
| Not of Region.t (* "not" *)
|
| Nil of Region.t (* "nil" *)
|
||||||
| Of of Region.t (* "of" *)
|
| Not of Region.t (* "not" *)
|
||||||
| Or of Region.t (* "or" *)
|
| Of of Region.t (* "of" *)
|
||||||
| Patch of Region.t (* "patch" *)
|
| Or of Region.t (* "or" *)
|
||||||
| Procedure of Region.t (* "procedure" *)
|
| Patch of Region.t (* "patch" *)
|
||||||
| Record of Region.t (* "record" *)
|
| Record of Region.t (* "record" *)
|
||||||
| Remove of Region.t (* "remove" *)
|
| Remove of Region.t (* "remove" *)
|
||||||
| Set of Region.t (* "set" *)
|
| Set of Region.t (* "set" *)
|
||||||
| Skip of Region.t (* "skip" *)
|
| Skip of Region.t (* "skip" *)
|
||||||
| Step of Region.t (* "step" *)
|
| Step of Region.t (* "step" *)
|
||||||
| Then of Region.t (* "then" *)
|
| Then of Region.t (* "then" *)
|
||||||
| To of Region.t (* "to" *)
|
| To of Region.t (* "to" *)
|
||||||
| Type of Region.t (* "type" *)
|
| True of Region.t (* "True" *)
|
||||||
| Var of Region.t (* "var" *)
|
| Type of Region.t (* "type" *)
|
||||||
| While of Region.t (* "while" *)
|
| Unit of Region.t (* "Unit" *)
|
||||||
| With of Region.t (* "with" *)
|
| Var of Region.t (* "var" *)
|
||||||
|
| While of Region.t (* "while" *)
|
||||||
|
| With of Region.t (* "with" *)
|
||||||
|
|
||||||
(* Types *)
|
|
||||||
(*
|
|
||||||
| T_address of Region.t (* "address" *)
|
|
||||||
| T_big_map of Region.t (* "big_map" *)
|
|
||||||
| T_bool of Region.t (* "bool" *)
|
|
||||||
| T_bytes of Region.t (* "bytes" *)
|
|
||||||
| T_contract of Region.t (* "contract" *)
|
|
||||||
| T_int of Region.t (* "int" *)
|
|
||||||
| T_key of Region.t (* "key" *)
|
|
||||||
| T_key_hash of Region.t (* "key_hash" *)
|
|
||||||
| T_list of Region.t (* "list" *)
|
|
||||||
| T_map of Region.t (* "map" *)
|
|
||||||
| T_mutez of Region.t (* "mutez" *)
|
|
||||||
| T_nat of Region.t (* "nat" *)
|
|
||||||
| T_operation of Region.t (* "operation" *)
|
|
||||||
| T_option of Region.t (* "option" *)
|
|
||||||
| T_set of Region.t (* "set" *)
|
|
||||||
| T_signature of Region.t (* "signature" *)
|
|
||||||
| T_string of Region.t (* "string" *)
|
|
||||||
| T_timestamp of Region.t (* "timestamp" *)
|
|
||||||
| T_unit of Region.t (* "unit" *)
|
|
||||||
*)
|
|
||||||
(* Data constructors *)
|
(* Data constructors *)
|
||||||
|
|
||||||
| C_False of Region.t (* "False" *)
|
|
||||||
| C_None of Region.t (* "None" *)
|
| C_None of Region.t (* "None" *)
|
||||||
| C_Some of Region.t (* "Some" *)
|
| C_Some of Region.t (* "Some" *)
|
||||||
| C_True of Region.t (* "True" *)
|
|
||||||
| C_Unit of Region.t (* "Unit" *)
|
|
||||||
|
|
||||||
(* Virtual tokens *)
|
(* Virtual tokens *)
|
||||||
|
|
||||||
@ -211,6 +188,7 @@ let proj_token = function
|
|||||||
| Else region -> region, "Else"
|
| Else region -> region, "Else"
|
||||||
| End region -> region, "End"
|
| End region -> region, "End"
|
||||||
| Fail region -> region, "Fail"
|
| Fail region -> region, "Fail"
|
||||||
|
| False region -> region, "False"
|
||||||
| For region -> region, "For"
|
| For region -> region, "For"
|
||||||
| From region -> region, "From"
|
| From region -> region, "From"
|
||||||
| Function region -> region, "Function"
|
| Function region -> region, "Function"
|
||||||
@ -225,7 +203,6 @@ let proj_token = function
|
|||||||
| Of region -> region, "Of"
|
| Of region -> region, "Of"
|
||||||
| Or region -> region, "Or"
|
| Or region -> region, "Or"
|
||||||
| Patch region -> region, "Patch"
|
| Patch region -> region, "Patch"
|
||||||
| Procedure region -> region, "Procedure"
|
|
||||||
| Record region -> region, "Record"
|
| Record region -> region, "Record"
|
||||||
| Remove region -> region, "Remove"
|
| Remove region -> region, "Remove"
|
||||||
| Set region -> region, "Set"
|
| Set region -> region, "Set"
|
||||||
@ -233,18 +210,17 @@ let proj_token = function
|
|||||||
| Step region -> region, "Step"
|
| Step region -> region, "Step"
|
||||||
| Then region -> region, "Then"
|
| Then region -> region, "Then"
|
||||||
| To region -> region, "To"
|
| To region -> region, "To"
|
||||||
|
| True region -> region, "True"
|
||||||
| Type region -> region, "Type"
|
| Type region -> region, "Type"
|
||||||
|
| Unit region -> region, "Unit"
|
||||||
| Var region -> region, "Var"
|
| Var region -> region, "Var"
|
||||||
| While region -> region, "While"
|
| While region -> region, "While"
|
||||||
| With region -> region, "With"
|
| With region -> region, "With"
|
||||||
|
|
||||||
(* Data *)
|
(* Data *)
|
||||||
|
|
||||||
| C_False region -> region, "C_False"
|
|
||||||
| C_None region -> region, "C_None"
|
| C_None region -> region, "C_None"
|
||||||
| C_Some region -> region, "C_Some"
|
| C_Some region -> region, "C_Some"
|
||||||
| C_True region -> region, "C_True"
|
|
||||||
| C_Unit region -> region, "C_Unit"
|
|
||||||
|
|
||||||
(* Virtual tokens *)
|
(* Virtual tokens *)
|
||||||
|
|
||||||
@ -304,6 +280,7 @@ let to_lexeme = function
|
|||||||
| Else _ -> "else"
|
| Else _ -> "else"
|
||||||
| End _ -> "end"
|
| End _ -> "end"
|
||||||
| Fail _ -> "fail"
|
| Fail _ -> "fail"
|
||||||
|
| False _ -> "False"
|
||||||
| For _ -> "for"
|
| For _ -> "for"
|
||||||
| From _ -> "from"
|
| From _ -> "from"
|
||||||
| Function _ -> "function"
|
| Function _ -> "function"
|
||||||
@ -318,7 +295,6 @@ let to_lexeme = function
|
|||||||
| Of _ -> "of"
|
| Of _ -> "of"
|
||||||
| Or _ -> "or"
|
| Or _ -> "or"
|
||||||
| Patch _ -> "patch"
|
| Patch _ -> "patch"
|
||||||
| Procedure _ -> "procedure"
|
|
||||||
| Record _ -> "record"
|
| Record _ -> "record"
|
||||||
| Remove _ -> "remove"
|
| Remove _ -> "remove"
|
||||||
| Set _ -> "set"
|
| Set _ -> "set"
|
||||||
@ -326,18 +302,17 @@ let to_lexeme = function
|
|||||||
| Step _ -> "step"
|
| Step _ -> "step"
|
||||||
| Then _ -> "then"
|
| Then _ -> "then"
|
||||||
| To _ -> "to"
|
| To _ -> "to"
|
||||||
|
| True _ -> "True"
|
||||||
| Type _ -> "type"
|
| Type _ -> "type"
|
||||||
|
| Unit _ -> "Unit"
|
||||||
| Var _ -> "var"
|
| Var _ -> "var"
|
||||||
| While _ -> "while"
|
| While _ -> "while"
|
||||||
| With _ -> "with"
|
| With _ -> "with"
|
||||||
|
|
||||||
(* Data constructors *)
|
(* Data constructors *)
|
||||||
|
|
||||||
| C_False _ -> "False"
|
|
||||||
| C_None _ -> "None"
|
| C_None _ -> "None"
|
||||||
| C_Some _ -> "Some"
|
| C_Some _ -> "Some"
|
||||||
| C_True _ -> "True"
|
|
||||||
| C_Unit _ -> "Unit"
|
|
||||||
|
|
||||||
(* Virtual tokens *)
|
(* Virtual tokens *)
|
||||||
|
|
||||||
@ -368,6 +343,7 @@ let keywords = [
|
|||||||
(fun reg -> From reg);
|
(fun reg -> From reg);
|
||||||
(fun reg -> Function reg);
|
(fun reg -> Function reg);
|
||||||
(fun reg -> Fail reg);
|
(fun reg -> Fail reg);
|
||||||
|
(fun reg -> False reg);
|
||||||
(fun reg -> If reg);
|
(fun reg -> If reg);
|
||||||
(fun reg -> In reg);
|
(fun reg -> In reg);
|
||||||
(fun reg -> Is reg);
|
(fun reg -> Is reg);
|
||||||
@ -376,10 +352,10 @@ let keywords = [
|
|||||||
(fun reg -> Mod reg);
|
(fun reg -> Mod reg);
|
||||||
(fun reg -> Nil reg);
|
(fun reg -> Nil reg);
|
||||||
(fun reg -> Not reg);
|
(fun reg -> Not reg);
|
||||||
|
(fun reg -> C_None reg);
|
||||||
(fun reg -> Of reg);
|
(fun reg -> Of reg);
|
||||||
(fun reg -> Or reg);
|
(fun reg -> Or reg);
|
||||||
(fun reg -> Patch reg);
|
(fun reg -> Patch reg);
|
||||||
(fun reg -> Procedure reg);
|
|
||||||
(fun reg -> Record reg);
|
(fun reg -> Record reg);
|
||||||
(fun reg -> Remove reg);
|
(fun reg -> Remove reg);
|
||||||
(fun reg -> Set reg);
|
(fun reg -> Set reg);
|
||||||
@ -387,7 +363,9 @@ let keywords = [
|
|||||||
(fun reg -> Step reg);
|
(fun reg -> Step reg);
|
||||||
(fun reg -> Then reg);
|
(fun reg -> Then reg);
|
||||||
(fun reg -> To reg);
|
(fun reg -> To reg);
|
||||||
|
(fun reg -> True reg);
|
||||||
(fun reg -> Type reg);
|
(fun reg -> Type reg);
|
||||||
|
(fun reg -> Unit reg);
|
||||||
(fun reg -> Var reg);
|
(fun reg -> Var reg);
|
||||||
(fun reg -> While reg);
|
(fun reg -> While reg);
|
||||||
(fun reg -> With reg)
|
(fun reg -> With reg)
|
||||||
@ -398,11 +376,11 @@ let reserved =
|
|||||||
empty |> add "args"
|
empty |> add "args"
|
||||||
|
|
||||||
let constructors = [
|
let constructors = [
|
||||||
(fun reg -> C_False reg);
|
(fun reg -> False reg);
|
||||||
(fun reg -> C_None reg);
|
(fun reg -> True reg);
|
||||||
(fun reg -> C_Some reg);
|
(fun reg -> Unit reg);
|
||||||
(fun reg -> C_True reg);
|
(fun reg -> C_None reg);
|
||||||
(fun reg -> C_Unit reg)
|
(fun reg -> C_Some reg)
|
||||||
]
|
]
|
||||||
|
|
||||||
let add map (key, value) = SMap.add key value map
|
let add map (key, value) = SMap.add key value map
|
||||||
@ -474,11 +452,11 @@ let mk_bytes lexeme region =
|
|||||||
type int_err = Non_canonical_zero
|
type int_err = Non_canonical_zero
|
||||||
|
|
||||||
let mk_int lexeme region =
|
let mk_int lexeme region =
|
||||||
let z = Str.(global_replace (regexp "_") "" lexeme)
|
let z =
|
||||||
|> Z.of_string in
|
Str.(global_replace (regexp "_") "" lexeme) |> Z.of_string
|
||||||
if Z.equal z Z.zero && lexeme <> "0"
|
in if Z.equal z Z.zero && lexeme <> "0"
|
||||||
then Error Non_canonical_zero
|
then Error Non_canonical_zero
|
||||||
else Ok (Int Region.{region; value = lexeme, z})
|
else Ok (Int Region.{region; value = lexeme,z})
|
||||||
|
|
||||||
type nat_err =
|
type nat_err =
|
||||||
Invalid_natural
|
Invalid_natural
|
||||||
@ -494,7 +472,7 @@ let mk_nat lexeme region =
|
|||||||
Z.of_string in
|
Z.of_string in
|
||||||
if Z.equal z Z.zero && lexeme <> "0n"
|
if Z.equal z Z.zero && lexeme <> "0n"
|
||||||
then Error Non_canonical_zero_nat
|
then Error Non_canonical_zero_nat
|
||||||
else Ok (Nat Region.{region; value = lexeme, z})
|
else Ok (Nat Region.{region; value = lexeme,z})
|
||||||
)
|
)
|
||||||
|
|
||||||
let mk_mutez lexeme region =
|
let mk_mutez lexeme region =
|
||||||
@ -533,9 +511,9 @@ let mk_sym lexeme region =
|
|||||||
| "*" -> Ok (TIMES region)
|
| "*" -> Ok (TIMES region)
|
||||||
| "/" -> Ok (SLASH region)
|
| "/" -> Ok (SLASH region)
|
||||||
| "<" -> Ok (LT region)
|
| "<" -> Ok (LT region)
|
||||||
| "<=" -> Ok (LE region)
|
| "<=" -> Ok (LE region)
|
||||||
| ">" -> Ok (GT region)
|
| ">" -> Ok (GT region)
|
||||||
| ">=" -> Ok (GE region)
|
| ">=" -> Ok (GE region)
|
||||||
|
|
||||||
(* Lexemes specific to PascaLIGO *)
|
(* Lexemes specific to PascaLIGO *)
|
||||||
| "=/=" -> Ok (NE region)
|
| "=/=" -> Ok (NE region)
|
||||||
@ -545,20 +523,17 @@ let mk_sym lexeme region =
|
|||||||
(* Invalid lexemes *)
|
(* Invalid lexemes *)
|
||||||
| _ -> Error Invalid_symbol
|
| _ -> Error Invalid_symbol
|
||||||
|
|
||||||
|
|
||||||
(* Identifiers *)
|
(* Identifiers *)
|
||||||
|
|
||||||
let mk_ident' lexeme region lexicon =
|
let mk_ident lexeme region =
|
||||||
Lexing.from_string lexeme |> scan_ident region lexicon
|
Lexing.from_string lexeme |> scan_ident region lexicon
|
||||||
|
|
||||||
let mk_ident lexeme region = mk_ident' lexeme region lexicon
|
|
||||||
|
|
||||||
(* Constructors *)
|
(* Constructors *)
|
||||||
|
|
||||||
let mk_constr' lexeme region lexicon =
|
let mk_constr lexeme region =
|
||||||
Lexing.from_string lexeme |> scan_constr region lexicon
|
Lexing.from_string lexeme |> scan_constr region lexicon
|
||||||
|
|
||||||
let mk_constr lexeme region = mk_constr' lexeme region lexicon
|
|
||||||
|
|
||||||
(* Predicates *)
|
(* Predicates *)
|
||||||
|
|
||||||
let is_string = function
|
let is_string = function
|
||||||
@ -589,6 +564,7 @@ let is_kwd = function
|
|||||||
| Else _
|
| Else _
|
||||||
| End _
|
| End _
|
||||||
| Fail _
|
| Fail _
|
||||||
|
| False _
|
||||||
| For _
|
| For _
|
||||||
| From _
|
| From _
|
||||||
| Function _
|
| Function _
|
||||||
@ -603,7 +579,6 @@ let is_kwd = function
|
|||||||
| Of _
|
| Of _
|
||||||
| Or _
|
| Or _
|
||||||
| Patch _
|
| Patch _
|
||||||
| Procedure _
|
|
||||||
| Record _
|
| Record _
|
||||||
| Remove _
|
| Remove _
|
||||||
| Set _
|
| Set _
|
||||||
@ -611,7 +586,9 @@ let is_kwd = function
|
|||||||
| Step _
|
| Step _
|
||||||
| Then _
|
| Then _
|
||||||
| To _
|
| To _
|
||||||
|
| True _
|
||||||
| Type _
|
| Type _
|
||||||
|
| Unit _
|
||||||
| Var _
|
| Var _
|
||||||
| While _
|
| While _
|
||||||
| With _ -> true
|
| With _ -> true
|
||||||
@ -619,11 +596,8 @@ let is_kwd = function
|
|||||||
|
|
||||||
let is_constr = function
|
let is_constr = function
|
||||||
Constr _
|
Constr _
|
||||||
| C_False _
|
|
||||||
| C_None _
|
| C_None _
|
||||||
| C_Some _
|
| C_Some _ -> true
|
||||||
| C_True _
|
|
||||||
| C_Unit _ -> true
|
|
||||||
| _ -> false
|
| _ -> false
|
||||||
|
|
||||||
let is_sym = function
|
let is_sym = function
|
||||||
|
|||||||
@ -53,6 +53,7 @@
|
|||||||
%token <Region.t> Contains (* "contains" *)
|
%token <Region.t> Contains (* "contains" *)
|
||||||
%token <Region.t> Else (* "else" *)
|
%token <Region.t> Else (* "else" *)
|
||||||
%token <Region.t> End (* "end" *)
|
%token <Region.t> End (* "end" *)
|
||||||
|
%token <Region.t> False (* "False" *)
|
||||||
%token <Region.t> For (* "for" *)
|
%token <Region.t> For (* "for" *)
|
||||||
%token <Region.t> Function (* "function" *)
|
%token <Region.t> Function (* "function" *)
|
||||||
%token <Region.t> From (* "from" *)
|
%token <Region.t> From (* "from" *)
|
||||||
@ -73,18 +74,17 @@
|
|||||||
%token <Region.t> Skip (* "skip" *)
|
%token <Region.t> Skip (* "skip" *)
|
||||||
%token <Region.t> Then (* "then" *)
|
%token <Region.t> Then (* "then" *)
|
||||||
%token <Region.t> To (* "to" *)
|
%token <Region.t> To (* "to" *)
|
||||||
|
%token <Region.t> True (* "True" *)
|
||||||
%token <Region.t> Type (* "type" *)
|
%token <Region.t> Type (* "type" *)
|
||||||
|
%token <Region.t> Unit (* "Unit" *)
|
||||||
%token <Region.t> Var (* "var" *)
|
%token <Region.t> Var (* "var" *)
|
||||||
%token <Region.t> While (* "while" *)
|
%token <Region.t> While (* "while" *)
|
||||||
%token <Region.t> With (* "with" *)
|
%token <Region.t> With (* "with" *)
|
||||||
|
|
||||||
(* Data constructors *)
|
(* Data constructors *)
|
||||||
|
|
||||||
%token <Region.t> C_False (* "False" *)
|
|
||||||
%token <Region.t> C_None (* "None" *)
|
%token <Region.t> C_None (* "None" *)
|
||||||
%token <Region.t> C_Some (* "Some" *)
|
%token <Region.t> C_Some (* "Some" *)
|
||||||
%token <Region.t> C_True (* "True" *)
|
|
||||||
%token <Region.t> C_Unit (* "Unit" *)
|
|
||||||
|
|
||||||
(* Virtual tokens *)
|
(* Virtual tokens *)
|
||||||
|
|
||||||
|
|||||||
@ -161,7 +161,7 @@ function_type:
|
|||||||
|
|
||||||
core_type:
|
core_type:
|
||||||
type_name {
|
type_name {
|
||||||
TAlias $1
|
TVar $1
|
||||||
}
|
}
|
||||||
| type_name type_tuple {
|
| type_name type_tuple {
|
||||||
let region = cover $1.region $2.region
|
let region = cover $1.region $2.region
|
||||||
@ -200,16 +200,16 @@ type_tuple:
|
|||||||
sum_type:
|
sum_type:
|
||||||
option(VBAR) nsepseq(variant,VBAR) {
|
option(VBAR) nsepseq(variant,VBAR) {
|
||||||
let region = nsepseq_to_region (fun x -> x.region) $2
|
let region = nsepseq_to_region (fun x -> x.region) $2
|
||||||
in {region; value = $2} }
|
in {region; value=$2} }
|
||||||
|
|
||||||
variant:
|
variant:
|
||||||
Constr Of cartesian {
|
Constr Of cartesian {
|
||||||
let region = cover $1.region (type_expr_to_region $3)
|
let region = cover $1.region (type_expr_to_region $3)
|
||||||
and value = {constr = $1; args = Some ($2, $3)}
|
and value = {constr = $1; arg = Some ($2, $3)}
|
||||||
in {region; value}
|
in {region; value}
|
||||||
}
|
}
|
||||||
| Constr {
|
| Constr {
|
||||||
{region=$1.region; value= {constr=$1; args=None}} }
|
{region=$1.region; value= {constr=$1; arg=None}} }
|
||||||
|
|
||||||
record_type:
|
record_type:
|
||||||
Record sep_or_term_list(field_decl,SEMI) End {
|
Record sep_or_term_list(field_decl,SEMI) End {
|
||||||
@ -793,7 +793,7 @@ cons_expr:
|
|||||||
and stop = expr_to_region $3 in
|
and stop = expr_to_region $3 in
|
||||||
let region = cover start stop
|
let region = cover start stop
|
||||||
and value = {arg1 = $1; op = $2; arg2 = $3}
|
and value = {arg1 = $1; op = $2; arg2 = $3}
|
||||||
in EList (Cons {region; value})
|
in EList (ECons {region; value})
|
||||||
}
|
}
|
||||||
| add_expr { $1 }
|
| add_expr { $1 }
|
||||||
|
|
||||||
@ -856,13 +856,13 @@ unary_expr:
|
|||||||
core_expr:
|
core_expr:
|
||||||
Int { EArith (Int $1) }
|
Int { EArith (Int $1) }
|
||||||
| Nat { EArith (Nat $1) }
|
| Nat { EArith (Nat $1) }
|
||||||
| Mutez { EArith (Mutez $1) }
|
| Mutez { EArith (Mutez $1) }
|
||||||
| var { EVar $1 }
|
| var { EVar $1 }
|
||||||
| String { EString (String $1) }
|
| String { EString (String $1) }
|
||||||
| Bytes { EBytes $1 }
|
| Bytes { EBytes $1 }
|
||||||
| C_False { ELogic (BoolExpr (False $1)) }
|
| False { ELogic (BoolExpr (False $1)) }
|
||||||
| C_True { ELogic (BoolExpr (True $1)) }
|
| True { ELogic (BoolExpr (True $1)) }
|
||||||
| C_Unit { EUnit $1 }
|
| Unit { EUnit $1 }
|
||||||
| annot_expr { EAnnot $1 }
|
| annot_expr { EAnnot $1 }
|
||||||
| tuple_expr { ETuple $1 }
|
| tuple_expr { ETuple $1 }
|
||||||
| par(expr) { EPar $1 }
|
| par(expr) { EPar $1 }
|
||||||
@ -927,21 +927,21 @@ selection:
|
|||||||
|
|
||||||
record_expr:
|
record_expr:
|
||||||
Record sep_or_term_list(field_assignment,SEMI) End {
|
Record sep_or_term_list(field_assignment,SEMI) End {
|
||||||
let 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 injection = {
|
and value : field_assign AST.reg ne_injection = {
|
||||||
opening = Kwd $1;
|
opening = Kwd $1;
|
||||||
elements = Some elements;
|
ne_elements;
|
||||||
terminator;
|
terminator;
|
||||||
closing = End $3}
|
closing = End $3}
|
||||||
in {region; value}
|
in {region; value}
|
||||||
}
|
}
|
||||||
| Record LBRACKET sep_or_term_list(field_assignment,SEMI) RBRACKET {
|
| Record LBRACKET sep_or_term_list(field_assignment,SEMI) RBRACKET {
|
||||||
let 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 injection = {
|
and value : field_assign AST.reg ne_injection = {
|
||||||
opening = KwdBracket ($1,$2);
|
opening = KwdBracket ($1,$2);
|
||||||
elements = Some elements;
|
ne_elements;
|
||||||
terminator;
|
terminator;
|
||||||
closing = RBracket $4}
|
closing = RBracket $4}
|
||||||
in {region; value} }
|
in {region; value} }
|
||||||
@ -971,8 +971,8 @@ arguments:
|
|||||||
par(nsepseq(expr,COMMA)) { $1 }
|
par(nsepseq(expr,COMMA)) { $1 }
|
||||||
|
|
||||||
list_expr:
|
list_expr:
|
||||||
injection(List,expr) { List $1 }
|
injection(List,expr) { EListComp $1 }
|
||||||
| Nil { Nil $1 }
|
| Nil { ENil $1 }
|
||||||
|
|
||||||
(* Patterns *)
|
(* Patterns *)
|
||||||
|
|
||||||
@ -980,7 +980,7 @@ pattern:
|
|||||||
core_pattern CONS nsepseq(core_pattern,CONS) {
|
core_pattern CONS nsepseq(core_pattern,CONS) {
|
||||||
let value = Utils.nsepseq_cons $1 $2 $3 in
|
let value = Utils.nsepseq_cons $1 $2 $3 in
|
||||||
let region = nsepseq_to_region pattern_to_region value
|
let region = nsepseq_to_region pattern_to_region value
|
||||||
in PCons {region; value}}
|
in PList (PCons {region; value}) }
|
||||||
| core_pattern { $1 }
|
| core_pattern { $1 }
|
||||||
|
|
||||||
core_pattern:
|
core_pattern:
|
||||||
@ -990,21 +990,14 @@ core_pattern:
|
|||||||
| Nat { PNat $1 }
|
| Nat { PNat $1 }
|
||||||
| Bytes { PBytes $1 }
|
| Bytes { PBytes $1 }
|
||||||
| String { PString $1 }
|
| String { PString $1 }
|
||||||
| C_Unit { PUnit $1 }
|
|
||||||
| C_False { PFalse $1 }
|
|
||||||
| C_True { PTrue $1 }
|
|
||||||
| C_None { PNone $1 }
|
|
||||||
| list_pattern { PList $1 }
|
| list_pattern { PList $1 }
|
||||||
| tuple_pattern { PTuple $1 }
|
| tuple_pattern { PTuple $1 }
|
||||||
| constr_pattern { PConstr $1 }
|
| constr_pattern { PConstr $1 }
|
||||||
| C_Some par(core_pattern) {
|
|
||||||
let region = cover $1 $2.region
|
|
||||||
in PSome {region; value = $1,$2}}
|
|
||||||
|
|
||||||
list_pattern:
|
list_pattern:
|
||||||
injection(List,core_pattern) { Sugar $1 }
|
injection(List,core_pattern) { PListComp $1 }
|
||||||
| Nil { PNil $1 }
|
| Nil { PNil $1 }
|
||||||
| par(cons_pattern) { Raw $1 }
|
| par(cons_pattern) { PParCons $1 }
|
||||||
|
|
||||||
cons_pattern:
|
cons_pattern:
|
||||||
core_pattern CONS pattern { $1,$2,$3 }
|
core_pattern CONS pattern { $1,$2,$3 }
|
||||||
@ -1013,10 +1006,17 @@ tuple_pattern:
|
|||||||
par(nsepseq(core_pattern,COMMA)) { $1 }
|
par(nsepseq(core_pattern,COMMA)) { $1 }
|
||||||
|
|
||||||
constr_pattern:
|
constr_pattern:
|
||||||
Constr tuple_pattern {
|
Unit { PUnit $1 }
|
||||||
|
| False { PFalse $1 }
|
||||||
|
| True { PTrue $1 }
|
||||||
|
| C_None { PNone $1 }
|
||||||
|
| C_Some par(core_pattern) {
|
||||||
|
let region = cover $1 $2.region
|
||||||
|
in PSomeApp {region; value = $1,$2}
|
||||||
|
}
|
||||||
|
| Constr tuple_pattern {
|
||||||
let region = cover $1.region $2.region
|
let region = cover $1.region $2.region
|
||||||
in {region; value = $1, Some $2}
|
in PConstrApp {region; value = $1, Some $2}
|
||||||
}
|
}
|
||||||
| Constr {
|
| Constr {
|
||||||
{region=$1.region; value = $1, None}
|
PConstrApp {region=$1.region; value = $1, None} }
|
||||||
}
|
|
||||||
|
|||||||
@ -107,15 +107,15 @@ and print_type_expr buffer = function
|
|||||||
| TApp type_app -> print_type_app buffer type_app
|
| TApp type_app -> print_type_app buffer type_app
|
||||||
| TFun type_fun -> print_type_fun buffer type_fun
|
| TFun type_fun -> print_type_fun buffer type_fun
|
||||||
| TPar par_type -> print_par_type buffer par_type
|
| TPar par_type -> print_par_type buffer par_type
|
||||||
| TAlias type_alias -> print_var buffer type_alias
|
| TVar type_var -> print_var buffer type_var
|
||||||
|
|
||||||
and print_cartesian buffer {value; _} =
|
and print_cartesian buffer {value; _} =
|
||||||
print_nsepseq buffer "*" print_type_expr value
|
print_nsepseq buffer "*" print_type_expr value
|
||||||
|
|
||||||
and print_variant buffer ({value; _}: variant reg) =
|
and print_variant buffer ({value; _}: variant reg) =
|
||||||
let {constr; args} = value in
|
let {constr; arg} = value in
|
||||||
print_constr buffer constr;
|
print_constr buffer constr;
|
||||||
match args with
|
match arg with
|
||||||
None -> ()
|
None -> ()
|
||||||
| Some (kwd_of, t_expr) ->
|
| Some (kwd_of, t_expr) ->
|
||||||
print_token buffer kwd_of "of";
|
print_token buffer kwd_of "of";
|
||||||
@ -538,12 +538,12 @@ and print_string_expr buffer = function
|
|||||||
print_string buffer s
|
print_string buffer s
|
||||||
|
|
||||||
and print_list_expr buffer = function
|
and print_list_expr buffer = function
|
||||||
Cons {value = {arg1; op; arg2}; _} ->
|
ECons {value = {arg1; op; arg2}; _} ->
|
||||||
print_expr buffer arg1;
|
print_expr buffer arg1;
|
||||||
print_token buffer op "#";
|
print_token buffer op "#";
|
||||||
print_expr buffer arg2
|
print_expr buffer arg2
|
||||||
| List e -> print_injection buffer "list" print_expr e
|
| EListComp e -> print_injection buffer "list" print_expr e
|
||||||
| Nil e -> print_nil buffer e
|
| ENil e -> print_nil buffer e
|
||||||
|
|
||||||
and print_constr_expr buffer = function
|
and print_constr_expr buffer = function
|
||||||
SomeApp e -> print_some_app buffer e
|
SomeApp e -> print_some_app buffer e
|
||||||
@ -551,7 +551,7 @@ and print_constr_expr buffer = function
|
|||||||
| ConstrApp e -> print_constr_app buffer e
|
| ConstrApp e -> print_constr_app buffer e
|
||||||
|
|
||||||
and print_record_expr buffer e =
|
and print_record_expr buffer e =
|
||||||
print_injection buffer "record" print_field_assign e
|
print_ne_injection buffer "record" print_field_assign e
|
||||||
|
|
||||||
and print_field_assign buffer {value; _} =
|
and print_field_assign buffer {value; _} =
|
||||||
let {field_name; equal; field_expr} = value in
|
let {field_name; equal; field_expr} = value in
|
||||||
@ -666,7 +666,7 @@ and print_constr_app buffer {value; _} =
|
|||||||
print_constr buffer constr;
|
print_constr buffer constr;
|
||||||
match arguments with
|
match arguments with
|
||||||
None -> ()
|
None -> ()
|
||||||
| Some args -> print_tuple_expr buffer args
|
| Some arg -> print_tuple_expr buffer arg
|
||||||
|
|
||||||
and print_some_app buffer {value; _} =
|
and print_some_app buffer {value; _} =
|
||||||
let c_Some, arguments = value in
|
let c_Some, arguments = value in
|
||||||
@ -680,28 +680,28 @@ and print_par_expr buffer {value; _} =
|
|||||||
print_token buffer rpar ")"
|
print_token buffer rpar ")"
|
||||||
|
|
||||||
and print_pattern buffer = function
|
and print_pattern buffer = function
|
||||||
PCons {value; _} -> print_nsepseq buffer "#" print_pattern value
|
PVar var -> print_var buffer var
|
||||||
| PVar var -> print_var buffer var
|
|
||||||
| PWild wild -> print_token buffer wild "_"
|
| PWild wild -> print_token buffer wild "_"
|
||||||
| PInt i -> print_int buffer i
|
| PInt i -> print_int buffer i
|
||||||
| PNat n -> print_nat buffer n
|
| PNat n -> print_nat buffer n
|
||||||
| PBytes b -> print_bytes buffer b
|
| PBytes b -> print_bytes buffer b
|
||||||
| PString s -> print_string buffer s
|
| PString s -> print_string buffer s
|
||||||
| PUnit region -> print_token buffer region "Unit"
|
|
||||||
| PFalse region -> print_token buffer region "False"
|
|
||||||
| PTrue region -> print_token buffer region "True"
|
|
||||||
| PNone region -> print_token buffer region "None"
|
|
||||||
| PSome psome -> print_psome buffer psome
|
|
||||||
| PList pattern -> print_list_pattern buffer pattern
|
| PList pattern -> print_list_pattern buffer pattern
|
||||||
| PTuple ptuple -> print_ptuple buffer ptuple
|
| PTuple ptuple -> print_ptuple buffer ptuple
|
||||||
| PConstr pattern -> print_constr_pattern buffer pattern
|
| PConstr pattern -> print_constr_pattern buffer pattern
|
||||||
|
|
||||||
and print_constr_pattern buffer {value; _} =
|
and print_constr_pattern buffer = function
|
||||||
let (constr, args) = value in
|
PUnit region -> print_token buffer region "Unit"
|
||||||
print_constr buffer constr;
|
| PFalse region -> print_token buffer region "False"
|
||||||
match args with
|
| PTrue region -> print_token buffer region "True"
|
||||||
None -> ()
|
| PNone region -> print_token buffer region "None"
|
||||||
| Some tuple -> print_ptuple buffer tuple
|
| PSomeApp psome -> print_psome buffer psome
|
||||||
|
| PConstrApp {value; _} ->
|
||||||
|
let constr, arg = value in
|
||||||
|
print_constr buffer constr;
|
||||||
|
match arg with
|
||||||
|
None -> ()
|
||||||
|
| Some tuple -> print_ptuple buffer tuple
|
||||||
|
|
||||||
and print_psome buffer {value; _} =
|
and print_psome buffer {value; _} =
|
||||||
let c_Some, patterns = value in
|
let c_Some, patterns = value in
|
||||||
@ -715,14 +715,16 @@ and print_patterns buffer {value; _} =
|
|||||||
print_token buffer rpar ")"
|
print_token buffer rpar ")"
|
||||||
|
|
||||||
and print_list_pattern buffer = function
|
and print_list_pattern buffer = function
|
||||||
Sugar sugar ->
|
PListComp comp ->
|
||||||
print_injection buffer "list" print_pattern sugar
|
print_injection buffer "list" print_pattern comp
|
||||||
| PNil kwd_nil ->
|
| PNil kwd_nil ->
|
||||||
print_token buffer kwd_nil "nil"
|
print_token buffer kwd_nil "nil"
|
||||||
| Raw raw ->
|
| PParCons cons ->
|
||||||
print_raw buffer raw
|
print_par_cons buffer cons
|
||||||
|
| PCons {value; _} ->
|
||||||
|
print_nsepseq buffer "#" print_pattern value
|
||||||
|
|
||||||
and print_raw buffer {value; _} =
|
and print_par_cons buffer {value; _} =
|
||||||
let {lpar; inside; rpar} = value in
|
let {lpar; inside; rpar} = value in
|
||||||
let head, cons, tail = inside in
|
let head, cons, tail = inside in
|
||||||
print_token buffer lpar "(";
|
print_token buffer lpar "(";
|
||||||
@ -755,17 +757,27 @@ let instruction_to_string = to_string print_instruction
|
|||||||
|
|
||||||
(* Pretty-printing the AST *)
|
(* Pretty-printing the AST *)
|
||||||
|
|
||||||
|
(* The function [mk_pad] updates the current padding, which is
|
||||||
|
comprised of two components: the padding to reach the new node
|
||||||
|
(space before reaching a subtree, then a vertical bar for it) and
|
||||||
|
the padding for the new node itself (Is it the last child of its
|
||||||
|
parent?). *)
|
||||||
let mk_pad len rank pc =
|
let mk_pad len rank pc =
|
||||||
pc ^ (if rank = len-1 then "`-- " else "|-- "),
|
pc ^ (if rank = len-1 then "`-- " else "|-- "),
|
||||||
pc ^ (if rank = len-1 then " " else "| ")
|
pc ^ (if rank = len-1 then " " else "| ")
|
||||||
|
|
||||||
let pp_ident buffer ~pad:(pd,_) name =
|
let pp_ident buffer ~pad:(pd,_) Region.{value=name; region} =
|
||||||
|
let node = sprintf "%s%s (%s)\n" pd name (region#compact `Byte)
|
||||||
|
in Buffer.add_string buffer node
|
||||||
|
|
||||||
|
let pp_node buffer ~pad:(pd,_) name =
|
||||||
let node = sprintf "%s%s\n" pd name
|
let node = sprintf "%s%s\n" pd name
|
||||||
in Buffer.add_string buffer node
|
in Buffer.add_string buffer node
|
||||||
|
|
||||||
let pp_string buffer = pp_ident buffer
|
let pp_string buffer = pp_ident buffer
|
||||||
|
|
||||||
let pp_node buffer = pp_ident buffer
|
let pp_loc_node buffer ~pad name region =
|
||||||
|
pp_ident buffer ~pad Region.{value=name; region}
|
||||||
|
|
||||||
let rec pp_ast buffer ~pad:(_,pc as pad) {decl; _} =
|
let rec pp_ast buffer ~pad:(_,pc as pad) {decl; _} =
|
||||||
let apply len rank =
|
let apply len rank =
|
||||||
@ -776,52 +788,52 @@ let rec pp_ast buffer ~pad:(_,pc as pad) {decl; _} =
|
|||||||
List.iteri (List.length decls |> apply) decls
|
List.iteri (List.length decls |> apply) decls
|
||||||
|
|
||||||
and pp_declaration buffer ~pad:(_,pc as pad) = function
|
and pp_declaration buffer ~pad:(_,pc as pad) = function
|
||||||
TypeDecl {value; _} ->
|
TypeDecl {value; region} ->
|
||||||
pp_node buffer ~pad "TypeDecl";
|
pp_loc_node buffer ~pad "TypeDecl" region;
|
||||||
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.name.value;
|
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.name;
|
||||||
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.type_expr
|
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.type_expr
|
||||||
| ConstDecl {value; _} ->
|
| ConstDecl {value; region} ->
|
||||||
pp_node buffer ~pad "ConstDecl";
|
pp_loc_node buffer ~pad "ConstDecl" region;
|
||||||
pp_const_decl buffer ~pad value
|
pp_const_decl buffer ~pad value
|
||||||
| FunDecl {value; _} ->
|
| FunDecl {value; region} ->
|
||||||
pp_node buffer ~pad "FunDecl";
|
pp_loc_node buffer ~pad "FunDecl" region;
|
||||||
pp_fun_decl buffer ~pad value
|
pp_fun_decl buffer ~pad value
|
||||||
|
|
||||||
and pp_const_decl buffer ~pad:(_,pc) decl =
|
and pp_const_decl buffer ~pad:(_,pc) decl =
|
||||||
pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value;
|
pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name;
|
||||||
pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.const_type;
|
pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.const_type;
|
||||||
pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
|
pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
|
||||||
|
|
||||||
and pp_type_expr buffer ~pad:(_,pc as pad) = function
|
and pp_type_expr buffer ~pad:(_,pc as pad) = function
|
||||||
TProd cartesian ->
|
TProd cartesian ->
|
||||||
pp_node buffer ~pad "TProd";
|
pp_loc_node buffer ~pad "TProd" cartesian.region;
|
||||||
pp_cartesian buffer ~pad cartesian
|
pp_cartesian buffer ~pad cartesian
|
||||||
| TAlias {value; _} ->
|
| TVar v ->
|
||||||
pp_node buffer ~pad "TAlias";
|
pp_node buffer ~pad "TVar";
|
||||||
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
|
pp_ident buffer ~pad:(mk_pad 1 0 pc) v
|
||||||
| TPar {value; _} ->
|
| TPar {value; region} ->
|
||||||
pp_node buffer ~pad "TPar";
|
pp_loc_node buffer ~pad "TPar" region;
|
||||||
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) value.inside
|
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) value.inside
|
||||||
| TApp {value=name,tuple; _} ->
|
| TApp {value=name,tuple; region} ->
|
||||||
pp_node buffer ~pad "TApp";
|
pp_loc_node buffer ~pad "TApp" region;
|
||||||
pp_ident buffer ~pad:(mk_pad 1 0 pc) name.value;
|
pp_ident buffer ~pad:(mk_pad 1 0 pc) name;
|
||||||
pp_type_tuple buffer ~pad:(mk_pad 2 1 pc) tuple
|
pp_type_tuple buffer ~pad:(mk_pad 2 1 pc) tuple
|
||||||
| TFun {value; _} ->
|
| TFun {value; region} ->
|
||||||
pp_node buffer ~pad "TFun";
|
pp_loc_node buffer ~pad "TFun" region;
|
||||||
let apply len rank =
|
let apply len rank =
|
||||||
let pad = mk_pad len rank pc in
|
let pad = mk_pad len rank pc in
|
||||||
pp_type_expr buffer ~pad in
|
pp_type_expr buffer ~pad in
|
||||||
let domain, _, range = value in
|
let domain, _, range = value in
|
||||||
List.iteri (apply 2) [domain; range]
|
List.iteri (apply 2) [domain; range]
|
||||||
| TSum {value; _} ->
|
| TSum {value; region} ->
|
||||||
pp_node buffer ~pad "TSum";
|
pp_loc_node buffer ~pad "TSum" region;
|
||||||
let apply len rank variant =
|
let apply len rank variant =
|
||||||
let pad = mk_pad len rank pc in
|
let pad = mk_pad len rank pc in
|
||||||
pp_variant buffer ~pad variant.value in
|
pp_variant buffer ~pad variant.value in
|
||||||
let variants = Utils.nsepseq_to_list value in
|
let variants = Utils.nsepseq_to_list value in
|
||||||
List.iteri (List.length variants |> apply) variants
|
List.iteri (List.length variants |> apply) variants
|
||||||
| TRecord {value; _} ->
|
| TRecord {value; region} ->
|
||||||
pp_node buffer ~pad "TRecord";
|
pp_loc_node buffer ~pad "TRecord" region;
|
||||||
let apply len rank field_decl =
|
let apply len rank field_decl =
|
||||||
pp_field_decl buffer ~pad:(mk_pad len rank pc)
|
pp_field_decl buffer ~pad:(mk_pad len rank pc)
|
||||||
field_decl.value in
|
field_decl.value in
|
||||||
@ -834,15 +846,15 @@ and pp_cartesian buffer ~pad:(_,pc) {value; _} =
|
|||||||
let components = Utils.nsepseq_to_list value
|
let components = Utils.nsepseq_to_list value
|
||||||
in List.iteri (List.length components |> apply) components
|
in List.iteri (List.length components |> apply) components
|
||||||
|
|
||||||
and pp_variant buffer ~pad:(_,pc as pad) {constr; args} =
|
and pp_variant buffer ~pad:(_,pc as pad) {constr; arg} =
|
||||||
pp_node buffer ~pad constr.value;
|
pp_ident buffer ~pad constr;
|
||||||
match args with
|
match arg with
|
||||||
None -> ()
|
None -> ()
|
||||||
| Some (_,c) ->
|
| Some (_,c) ->
|
||||||
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) c
|
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) c
|
||||||
|
|
||||||
and pp_field_decl buffer ~pad:(_,pc as pad) decl =
|
and pp_field_decl buffer ~pad:(_,pc as pad) decl =
|
||||||
pp_node buffer ~pad decl.field_name.value;
|
pp_ident buffer ~pad decl.field_name;
|
||||||
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) decl.field_type
|
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) decl.field_type
|
||||||
|
|
||||||
and pp_type_tuple buffer ~pad:(_,pc) {value; _} =
|
and pp_type_tuple buffer ~pad:(_,pc) {value; _} =
|
||||||
@ -856,7 +868,7 @@ and pp_fun_decl buffer ~pad:(_,pc) decl =
|
|||||||
if decl.local_decls = [] then 5 else 6 in
|
if decl.local_decls = [] then 5 else 6 in
|
||||||
let () =
|
let () =
|
||||||
let pad = mk_pad fields 0 pc in
|
let pad = mk_pad fields 0 pc in
|
||||||
pp_ident buffer ~pad decl.name.value in
|
pp_ident buffer ~pad decl.name in
|
||||||
let () =
|
let () =
|
||||||
let pad = mk_pad fields 1 pc in
|
let pad = mk_pad fields 1 pc in
|
||||||
pp_node buffer ~pad "<parameters>";
|
pp_node buffer ~pad "<parameters>";
|
||||||
@ -875,8 +887,8 @@ and pp_fun_decl buffer ~pad:(_,pc) decl =
|
|||||||
pp_node buffer ~pad "<block>";
|
pp_node buffer ~pad "<block>";
|
||||||
let statements =
|
let statements =
|
||||||
match decl.block with
|
match decl.block with
|
||||||
| Some block -> block.value.statements
|
Some block -> block.value.statements
|
||||||
| None -> Instr (Skip Region.ghost), [] in
|
| None -> Instr (Skip Region.ghost), [] in
|
||||||
pp_statements buffer ~pad statements in
|
pp_statements buffer ~pad statements in
|
||||||
let () =
|
let () =
|
||||||
let _, pc as pad = mk_pad fields (fields - 1) pc in
|
let _, pc as pad = mk_pad fields (fields - 1) pc in
|
||||||
@ -892,13 +904,13 @@ and pp_parameters buffer ~pad:(_,pc) {value; _} =
|
|||||||
in List.iteri (apply arity) params
|
in List.iteri (apply arity) params
|
||||||
|
|
||||||
and pp_param_decl buffer ~pad:(_,pc as pad) = function
|
and pp_param_decl buffer ~pad:(_,pc as pad) = function
|
||||||
ParamConst {value; _} ->
|
ParamConst {value; region} ->
|
||||||
pp_node buffer ~pad "ParamConst";
|
pp_loc_node buffer ~pad "ParamConst" region;
|
||||||
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var.value;
|
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var;
|
||||||
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.param_type
|
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.param_type
|
||||||
| ParamVar {value; _} ->
|
| ParamVar {value; region} ->
|
||||||
pp_node buffer ~pad "ParamVar";
|
pp_loc_node buffer ~pad "ParamVar" region;
|
||||||
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var.value;
|
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var;
|
||||||
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.param_type
|
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.param_type
|
||||||
|
|
||||||
and pp_statements buffer ~pad:(_,pc) statements =
|
and pp_statements buffer ~pad:(_,pc) statements =
|
||||||
@ -917,37 +929,37 @@ and pp_statement buffer ~pad:(_,pc as pad) = function
|
|||||||
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data_decl
|
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data_decl
|
||||||
|
|
||||||
and pp_instruction buffer ~pad:(_,pc as pad) = function
|
and pp_instruction buffer ~pad:(_,pc as pad) = function
|
||||||
Cond {value; _} ->
|
Cond {value; region} ->
|
||||||
pp_node buffer ~pad "Cond";
|
pp_loc_node buffer ~pad "Cond" region;
|
||||||
pp_conditional buffer ~pad value
|
pp_conditional buffer ~pad value
|
||||||
| CaseInstr {value; _} ->
|
| CaseInstr {value; region} ->
|
||||||
pp_node buffer ~pad "CaseInstr";
|
pp_loc_node buffer ~pad "CaseInstr" region;
|
||||||
pp_case pp_if_clause buffer ~pad value
|
pp_case pp_if_clause buffer ~pad value
|
||||||
| Assign {value; _} ->
|
| Assign {value; region} ->
|
||||||
pp_node buffer ~pad "Assign";
|
pp_loc_node buffer ~pad "Assign" region;
|
||||||
pp_assignment buffer ~pad value
|
pp_assignment buffer ~pad value
|
||||||
| Loop loop ->
|
| Loop loop ->
|
||||||
pp_node buffer ~pad "Loop";
|
pp_node buffer ~pad "Loop";
|
||||||
pp_loop buffer ~pad:(mk_pad 1 0 pc) loop
|
pp_loop buffer ~pad:(mk_pad 1 0 pc) loop
|
||||||
| ProcCall {value; _} ->
|
| ProcCall {value; region} ->
|
||||||
pp_node buffer ~pad "ProcCall";
|
pp_loc_node buffer ~pad "ProcCall" region;
|
||||||
pp_fun_call buffer ~pad value
|
pp_fun_call buffer ~pad value
|
||||||
| Skip _ ->
|
| Skip region ->
|
||||||
pp_node buffer ~pad "Skip"
|
pp_loc_node buffer ~pad "Skip" region
|
||||||
| RecordPatch {value; _} ->
|
| RecordPatch {value; region} ->
|
||||||
pp_node buffer ~pad "RecordPatch";
|
pp_loc_node buffer ~pad "RecordPatch" region;
|
||||||
pp_record_patch buffer ~pad value
|
pp_record_patch buffer ~pad value
|
||||||
| MapPatch {value; _} ->
|
| MapPatch {value; region} ->
|
||||||
pp_node buffer ~pad "MapPatch";
|
pp_loc_node buffer ~pad "MapPatch" region;
|
||||||
pp_map_patch buffer ~pad value
|
pp_map_patch buffer ~pad value
|
||||||
| SetPatch {value; _} ->
|
| SetPatch {value; region} ->
|
||||||
pp_node buffer ~pad "SetPatch";
|
pp_loc_node buffer ~pad "SetPatch" region;
|
||||||
pp_set_patch buffer ~pad value
|
pp_set_patch buffer ~pad value
|
||||||
| MapRemove {value; _} ->
|
| MapRemove {value; region} ->
|
||||||
pp_node buffer ~pad "MapRemove";
|
pp_loc_node buffer ~pad "MapRemove" region;
|
||||||
pp_map_remove buffer ~pad value
|
pp_map_remove buffer ~pad value
|
||||||
| SetRemove {value; _} ->
|
| SetRemove {value; region} ->
|
||||||
pp_node buffer ~pad "SetRemove";
|
pp_loc_node buffer ~pad "SetRemove" region;
|
||||||
pp_set_remove buffer ~pad value
|
pp_set_remove buffer ~pad value
|
||||||
|
|
||||||
and pp_cond_expr buffer ~pad:(_,pc) (cond: cond_expr) =
|
and pp_cond_expr buffer ~pad:(_,pc) (cond: cond_expr) =
|
||||||
@ -989,13 +1001,12 @@ and pp_if_clause buffer ~pad:(_,pc as pad) = function
|
|||||||
pp_clause_block buffer ~pad:(mk_pad 1 0 pc) block
|
pp_clause_block buffer ~pad:(mk_pad 1 0 pc) block
|
||||||
|
|
||||||
and pp_clause_block buffer ~pad = function
|
and pp_clause_block buffer ~pad = function
|
||||||
LongBlock {value; _} ->
|
LongBlock {value; region} ->
|
||||||
pp_node buffer ~pad "LongBlock";
|
pp_loc_node buffer ~pad "LongBlock" region;
|
||||||
pp_statements buffer ~pad value.statements
|
pp_statements buffer ~pad value.statements
|
||||||
| ShortBlock {value; _} ->
|
| ShortBlock {value; region} ->
|
||||||
pp_node buffer ~pad "ShortBlock";
|
pp_loc_node buffer ~pad "ShortBlock" region;
|
||||||
let statements = fst value.inside in
|
pp_statements buffer ~pad (fst value.inside)
|
||||||
pp_statements buffer ~pad statements
|
|
||||||
|
|
||||||
and pp_case :
|
and pp_case :
|
||||||
'a.(Buffer.t -> pad:(string*string) -> 'a -> unit)
|
'a.(Buffer.t -> pad:(string*string) -> 'a -> unit)
|
||||||
@ -1018,77 +1029,81 @@ and pp_case_clause :
|
|||||||
printer buffer ~pad:(mk_pad 2 1 pc) clause.rhs
|
printer buffer ~pad:(mk_pad 2 1 pc) clause.rhs
|
||||||
|
|
||||||
and pp_pattern buffer ~pad:(_,pc as pad) = function
|
and pp_pattern buffer ~pad:(_,pc as pad) = function
|
||||||
PNone _ ->
|
PWild region ->
|
||||||
pp_node buffer ~pad "PNone"
|
pp_loc_node buffer ~pad "PWild" region
|
||||||
| PSome {value=_,{value=par; _}; _} ->
|
| PConstr pattern ->
|
||||||
pp_node buffer ~pad "PSome";
|
|
||||||
pp_pattern buffer ~pad:(mk_pad 1 0 pc) par.inside
|
|
||||||
| PWild _ ->
|
|
||||||
pp_node buffer ~pad "PWild"
|
|
||||||
| PConstr {value; _} ->
|
|
||||||
pp_node buffer ~pad "PConstr";
|
pp_node buffer ~pad "PConstr";
|
||||||
pp_constr_pattern buffer ~pad:(mk_pad 1 0 pc) value
|
pp_constr_pattern buffer ~pad:(mk_pad 1 0 pc) pattern
|
||||||
| PCons {value; _} ->
|
| PVar v ->
|
||||||
|
pp_node buffer ~pad "PVar";
|
||||||
|
pp_ident buffer ~pad:(mk_pad 1 0 pc) v
|
||||||
|
| PInt n ->
|
||||||
|
pp_node buffer ~pad "PInt";
|
||||||
|
pp_int buffer ~pad n
|
||||||
|
| PNat n ->
|
||||||
|
pp_node buffer ~pad "PNat";
|
||||||
|
pp_int buffer ~pad n
|
||||||
|
| PBytes b ->
|
||||||
|
pp_node buffer ~pad "PBytes";
|
||||||
|
pp_bytes buffer ~pad b
|
||||||
|
| PString s ->
|
||||||
|
pp_node buffer ~pad "PString";
|
||||||
|
pp_ident buffer ~pad:(mk_pad 1 0 pc) s
|
||||||
|
| PList plist ->
|
||||||
|
pp_node buffer ~pad "PList";
|
||||||
|
pp_list_pattern buffer ~pad:(mk_pad 1 0 pc) plist
|
||||||
|
| PTuple {value; region} ->
|
||||||
|
pp_loc_node buffer ~pad "PTuple" region;
|
||||||
|
pp_tuple_pattern buffer ~pad:(mk_pad 1 0 pc) value
|
||||||
|
|
||||||
|
and pp_bytes buffer ~pad:(_,pc) {value=lexeme,hex; region} =
|
||||||
|
pp_loc_node buffer ~pad:(mk_pad 2 0 pc) lexeme region;
|
||||||
|
pp_node buffer ~pad:(mk_pad 2 1 pc) (Hex.to_string hex)
|
||||||
|
|
||||||
|
and pp_int buffer ~pad:(_,pc) {value=lexeme,z; region} =
|
||||||
|
pp_loc_node buffer ~pad:(mk_pad 2 0 pc) lexeme region;
|
||||||
|
pp_node buffer ~pad:(mk_pad 2 1 pc) (Z.to_string z)
|
||||||
|
|
||||||
|
and pp_constr_pattern buffer ~pad:(_,pc as pad) = function
|
||||||
|
PNone region ->
|
||||||
|
pp_loc_node buffer ~pad "PNone" region
|
||||||
|
| PSomeApp {value=_,{value=par; _}; region} ->
|
||||||
|
pp_loc_node buffer ~pad "PSomeApp" region;
|
||||||
|
pp_pattern buffer ~pad:(mk_pad 1 0 pc) par.inside
|
||||||
|
| PUnit region ->
|
||||||
|
pp_loc_node buffer ~pad "PUnit" region
|
||||||
|
| PFalse region ->
|
||||||
|
pp_loc_node buffer ~pad "PFalse" region
|
||||||
|
| PTrue region ->
|
||||||
|
pp_loc_node buffer ~pad "PTrue" region
|
||||||
|
| PConstrApp {value; region} ->
|
||||||
|
pp_loc_node buffer ~pad "PConstrApp" region;
|
||||||
|
pp_constr_app_pattern buffer ~pad:(mk_pad 1 0 pc) value
|
||||||
|
|
||||||
|
and pp_constr_app_pattern buffer ~pad (constr, pat_opt) =
|
||||||
|
pp_ident buffer ~pad constr;
|
||||||
|
match pat_opt with
|
||||||
|
None -> ()
|
||||||
|
| Some {value; _} -> pp_tuple_pattern buffer ~pad value
|
||||||
|
|
||||||
|
and pp_list_pattern buffer ~pad:(_,pc as pad) = function
|
||||||
|
PListComp {value; region} ->
|
||||||
|
pp_loc_node buffer ~pad "PListComp" region;
|
||||||
|
pp_injection pp_pattern buffer ~pad:(mk_pad 1 0 pc) value
|
||||||
|
| PNil region ->
|
||||||
|
pp_loc_node buffer ~pad "PNil" region
|
||||||
|
| PParCons {value; region} ->
|
||||||
|
pp_loc_node buffer ~pad "PParCons" region;
|
||||||
|
pp_bin_cons buffer ~pad:(mk_pad 1 0 pc) value.inside
|
||||||
|
| PCons {value; region} ->
|
||||||
let patterns = Utils.nsepseq_to_list value in
|
let patterns = Utils.nsepseq_to_list value in
|
||||||
let length = List.length patterns in
|
let length = List.length patterns in
|
||||||
let apply len rank =
|
let apply len rank =
|
||||||
pp_pattern buffer ~pad:(mk_pad len rank pc) in
|
pp_pattern buffer ~pad:(mk_pad len rank pc) in
|
||||||
pp_node buffer ~pad "PCons";
|
pp_loc_node buffer ~pad "PCons" region;
|
||||||
List.iteri (apply length) patterns
|
List.iteri (apply length) patterns
|
||||||
| PVar {value; _} ->
|
|
||||||
pp_node buffer ~pad "PVar";
|
|
||||||
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
|
|
||||||
| PInt {value; _} ->
|
|
||||||
pp_node buffer ~pad "PInt";
|
|
||||||
pp_int buffer ~pad value
|
|
||||||
| PNat {value; _} ->
|
|
||||||
pp_node buffer ~pad "PNat";
|
|
||||||
pp_int buffer ~pad value
|
|
||||||
| PBytes {value; _} ->
|
|
||||||
pp_node buffer ~pad "PBytes";
|
|
||||||
pp_bytes buffer ~pad value
|
|
||||||
| PString {value; _} ->
|
|
||||||
pp_node buffer ~pad "PString";
|
|
||||||
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
|
|
||||||
| PUnit _ ->
|
|
||||||
pp_node buffer ~pad "PUnit"
|
|
||||||
| PFalse _ ->
|
|
||||||
pp_node buffer ~pad "PFalse"
|
|
||||||
| PTrue _ ->
|
|
||||||
pp_node buffer ~pad "PTrue"
|
|
||||||
| PList plist ->
|
|
||||||
pp_node buffer ~pad "PList";
|
|
||||||
pp_plist buffer ~pad:(mk_pad 1 0 pc) plist
|
|
||||||
| PTuple {value; _} ->
|
|
||||||
pp_node buffer ~pad "PTuple";
|
|
||||||
pp_tuple_pattern buffer ~pad:(mk_pad 1 0 pc) value
|
|
||||||
|
|
||||||
and pp_bytes buffer ~pad:(_,pc) (lexeme, hex) =
|
and pp_bin_cons buffer ~pad:(_,pc) (head, _, tail) =
|
||||||
pp_string buffer ~pad:(mk_pad 2 0 pc) lexeme;
|
|
||||||
pp_string buffer ~pad:(mk_pad 2 1 pc) (Hex.to_string hex)
|
|
||||||
|
|
||||||
and pp_int buffer ~pad:(_,pc) (lexeme, z) =
|
|
||||||
pp_string buffer ~pad:(mk_pad 2 0 pc) lexeme;
|
|
||||||
pp_string buffer ~pad:(mk_pad 2 1 pc) (Z.to_string z)
|
|
||||||
|
|
||||||
and pp_constr_pattern buffer ~pad = function
|
|
||||||
{value; _}, None ->
|
|
||||||
pp_ident buffer ~pad value
|
|
||||||
| {value=id; _}, Some {value=ptuple; _} ->
|
|
||||||
pp_ident buffer ~pad id;
|
|
||||||
pp_tuple_pattern buffer ~pad ptuple
|
|
||||||
|
|
||||||
and pp_plist buffer ~pad:(_,pc as pad) = function
|
|
||||||
Sugar {value; _} ->
|
|
||||||
pp_node buffer ~pad "Sugar";
|
|
||||||
pp_injection pp_pattern buffer ~pad:(mk_pad 1 0 pc) value
|
|
||||||
| PNil _ ->
|
|
||||||
pp_node buffer ~pad "PNil"
|
|
||||||
| Raw {value; _} ->
|
|
||||||
pp_node buffer ~pad "Raw";
|
|
||||||
pp_raw buffer ~pad:(mk_pad 1 0 pc) value.inside
|
|
||||||
|
|
||||||
and pp_raw buffer ~pad:(_,pc) (head, _, tail) =
|
|
||||||
pp_pattern buffer ~pad:(mk_pad 2 0 pc) head;
|
pp_pattern buffer ~pad:(mk_pad 2 0 pc) head;
|
||||||
pp_pattern buffer ~pad:(mk_pad 2 1 pc) tail
|
pp_pattern buffer ~pad:(mk_pad 2 1 pc) tail
|
||||||
|
|
||||||
@ -1118,23 +1133,23 @@ and pp_tuple_pattern buffer ~pad:(_,pc) tuple =
|
|||||||
in List.iteri (apply length) patterns
|
in List.iteri (apply length) patterns
|
||||||
|
|
||||||
and pp_assignment buffer ~pad:(_,pc) asgn =
|
and pp_assignment buffer ~pad:(_,pc) asgn =
|
||||||
pp_lhs buffer ~pad:(mk_pad 2 0 pc) asgn.lhs;
|
pp_lhs buffer ~pad:(mk_pad 2 0 pc) asgn.lhs;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 1 pc) asgn.rhs
|
pp_expr buffer ~pad:(mk_pad 2 1 pc) asgn.rhs
|
||||||
|
|
||||||
and pp_lhs buffer ~pad:(_,pc as pad) = function
|
and pp_lhs buffer ~pad:(_,pc as pad) = function
|
||||||
Path path ->
|
Path path ->
|
||||||
pp_node buffer ~pad "Path";
|
pp_node buffer ~pad "Path";
|
||||||
pp_path buffer ~pad:(mk_pad 1 0 pc) path
|
pp_path buffer ~pad:(mk_pad 1 0 pc) path
|
||||||
| MapPath {value; _} ->
|
| MapPath {value; region} ->
|
||||||
pp_node buffer ~pad "MapPath";
|
pp_loc_node buffer ~pad "MapPath" region;
|
||||||
pp_map_lookup buffer ~pad value
|
pp_map_lookup buffer ~pad value
|
||||||
|
|
||||||
and pp_path buffer ~pad:(_,pc as pad) = function
|
and pp_path buffer ~pad:(_,pc as pad) = function
|
||||||
Name {value; _} ->
|
Name name ->
|
||||||
pp_node buffer ~pad "Name";
|
pp_node buffer ~pad "Name";
|
||||||
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
|
pp_ident buffer ~pad:(mk_pad 1 0 pc) name
|
||||||
| Path {value; _} ->
|
| Path {value; region} ->
|
||||||
pp_node buffer ~pad "Path";
|
pp_loc_node buffer ~pad "Path" region;
|
||||||
pp_projection buffer ~pad value
|
pp_projection buffer ~pad value
|
||||||
|
|
||||||
and pp_projection buffer ~pad:(_,pc) proj =
|
and pp_projection buffer ~pad:(_,pc) proj =
|
||||||
@ -1142,16 +1157,16 @@ and pp_projection buffer ~pad:(_,pc) proj =
|
|||||||
let len = List.length selections in
|
let len = List.length selections in
|
||||||
let apply len rank =
|
let apply len rank =
|
||||||
pp_selection buffer ~pad:(mk_pad len rank pc) in
|
pp_selection buffer ~pad:(mk_pad len rank pc) in
|
||||||
pp_ident buffer ~pad:(mk_pad (1+len) 0 pc) proj.struct_name.value;
|
pp_ident buffer ~pad:(mk_pad (1+len) 0 pc) proj.struct_name;
|
||||||
List.iteri (apply len) selections
|
List.iteri (apply len) selections
|
||||||
|
|
||||||
and pp_selection buffer ~pad:(_,pc as pad) = function
|
and pp_selection buffer ~pad:(_,pc as pad) = function
|
||||||
FieldName {value; _} ->
|
FieldName name ->
|
||||||
pp_node buffer ~pad "FieldName";
|
pp_node buffer ~pad "FieldName";
|
||||||
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
|
pp_ident buffer ~pad:(mk_pad 1 0 pc) name
|
||||||
| Component {value; _} ->
|
| Component comp ->
|
||||||
pp_node buffer ~pad "Component";
|
pp_node buffer ~pad "Component";
|
||||||
pp_int buffer ~pad value
|
pp_int buffer ~pad comp
|
||||||
|
|
||||||
and pp_map_lookup buffer ~pad:(_,pc) lookup =
|
and pp_map_lookup buffer ~pad:(_,pc) lookup =
|
||||||
pp_path buffer ~pad:(mk_pad 2 0 pc) lookup.path;
|
pp_path buffer ~pad:(mk_pad 2 0 pc) lookup.path;
|
||||||
@ -1175,11 +1190,11 @@ and pp_loop buffer ~pad:(_,pc as pad) = function
|
|||||||
pp_for_loop buffer ~pad:(mk_pad 1 0 pc) for_loop
|
pp_for_loop buffer ~pad:(mk_pad 1 0 pc) for_loop
|
||||||
|
|
||||||
and pp_for_loop buffer ~pad = function
|
and pp_for_loop buffer ~pad = function
|
||||||
ForInt {value; _} ->
|
ForInt {value; region} ->
|
||||||
pp_node buffer ~pad "ForInt";
|
pp_loc_node buffer ~pad "ForInt" region;
|
||||||
pp_for_int buffer ~pad value
|
pp_for_int buffer ~pad value
|
||||||
| ForCollect {value; _} ->
|
| ForCollect {value; region} ->
|
||||||
pp_node buffer ~pad "ForCollect";
|
pp_loc_node buffer ~pad "ForCollect" region;
|
||||||
pp_for_collect buffer ~pad value
|
pp_for_collect buffer ~pad value
|
||||||
|
|
||||||
and pp_for_int buffer ~pad:(_,pc) for_int =
|
and pp_for_int buffer ~pad:(_,pc) for_int =
|
||||||
@ -1200,7 +1215,7 @@ and pp_for_int buffer ~pad:(_,pc) for_int =
|
|||||||
|
|
||||||
and pp_var_assign buffer ~pad:(_,pc) asgn =
|
and pp_var_assign buffer ~pad:(_,pc) asgn =
|
||||||
let pad = mk_pad 2 0 pc in
|
let pad = mk_pad 2 0 pc in
|
||||||
pp_ident buffer ~pad asgn.name.value;
|
pp_ident buffer ~pad asgn.name;
|
||||||
let pad = mk_pad 2 1 pc in
|
let pad = mk_pad 2 1 pc in
|
||||||
pp_expr buffer ~pad asgn.expr
|
pp_expr buffer ~pad asgn.expr
|
||||||
|
|
||||||
@ -1209,7 +1224,7 @@ and pp_for_collect buffer ~pad:(_,pc) collect =
|
|||||||
let pad = mk_pad 4 0 pc in
|
let pad = mk_pad 4 0 pc in
|
||||||
match collect.bind_to with
|
match collect.bind_to with
|
||||||
None ->
|
None ->
|
||||||
pp_ident buffer ~pad collect.var.value
|
pp_ident buffer ~pad collect.var
|
||||||
| Some (_, var) ->
|
| Some (_, var) ->
|
||||||
pp_var_binding buffer ~pad (collect.var, var) in
|
pp_var_binding buffer ~pad (collect.var, var) in
|
||||||
let () =
|
let () =
|
||||||
@ -1229,22 +1244,22 @@ and pp_for_collect buffer ~pad:(_,pc) collect =
|
|||||||
in ()
|
in ()
|
||||||
|
|
||||||
and pp_collection buffer ~pad = function
|
and pp_collection buffer ~pad = function
|
||||||
Map _ -> pp_string buffer ~pad "map"
|
Map region -> pp_loc_node buffer ~pad "map" region
|
||||||
| Set _ -> pp_string buffer ~pad "set"
|
| Set region -> pp_loc_node buffer ~pad "set" region
|
||||||
| List _ -> pp_string buffer ~pad "list"
|
| List region -> pp_loc_node buffer ~pad "list" region
|
||||||
|
|
||||||
and pp_var_binding buffer ~pad:(_,pc as pad) (source, image) =
|
and pp_var_binding buffer ~pad:(_,pc as pad) (source, image) =
|
||||||
pp_node buffer ~pad "<binding>";
|
pp_node buffer ~pad "<binding>";
|
||||||
pp_ident buffer ~pad:(mk_pad 2 0 pc) source.value;
|
pp_ident buffer ~pad:(mk_pad 2 0 pc) source;
|
||||||
pp_ident buffer ~pad:(mk_pad 2 1 pc) image.value
|
pp_ident buffer ~pad:(mk_pad 2 1 pc) image
|
||||||
|
|
||||||
and pp_fun_call buffer ~pad:(_,pc) (name, args) =
|
and pp_fun_call buffer ~pad:(_,pc) (name, args) =
|
||||||
let args = Utils.nsepseq_to_list args.value.inside in
|
let args = Utils.nsepseq_to_list args.value.inside in
|
||||||
let arity = List.length args in
|
let arity = List.length args in
|
||||||
let apply len rank =
|
let apply len rank =
|
||||||
pp_expr buffer ~pad:(mk_pad len rank pc)
|
pp_expr buffer ~pad:(mk_pad len rank pc)
|
||||||
in pp_ident buffer ~pad:(mk_pad (1+arity) 0 pc) name.value;
|
in pp_ident buffer ~pad:(mk_pad (1+arity) 0 pc) name;
|
||||||
List.iteri (apply arity) args
|
List.iteri (apply arity) args
|
||||||
|
|
||||||
and pp_record_patch buffer ~pad:(_,pc as pad) patch =
|
and pp_record_patch buffer ~pad:(_,pc as pad) patch =
|
||||||
pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path;
|
pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path;
|
||||||
@ -1253,7 +1268,7 @@ and pp_record_patch buffer ~pad:(_,pc as pad) patch =
|
|||||||
|
|
||||||
and pp_field_assign buffer ~pad:(_,pc as pad) {value; _} =
|
and pp_field_assign buffer ~pad:(_,pc as pad) {value; _} =
|
||||||
pp_node buffer ~pad "<field assignment>";
|
pp_node buffer ~pad "<field assignment>";
|
||||||
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.field_name.value;
|
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.field_name;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 1 pc) value.field_expr
|
pp_expr buffer ~pad:(mk_pad 2 1 pc) value.field_expr
|
||||||
|
|
||||||
and pp_map_patch buffer ~pad:(_,pc as pad) patch =
|
and pp_map_patch buffer ~pad:(_,pc as pad) patch =
|
||||||
@ -1285,35 +1300,35 @@ and pp_local_decls buffer ~pad:(_,pc) decls =
|
|||||||
in List.iteri (List.length decls |> apply) decls
|
in List.iteri (List.length decls |> apply) decls
|
||||||
|
|
||||||
and pp_local_decl buffer ~pad:(_,pc as pad) = function
|
and pp_local_decl buffer ~pad:(_,pc as pad) = function
|
||||||
LocalFun {value; _} ->
|
LocalFun {value; region} ->
|
||||||
pp_node buffer ~pad "LocalFun";
|
pp_loc_node buffer ~pad "LocalFun" region;
|
||||||
pp_fun_decl buffer ~pad value
|
pp_fun_decl buffer ~pad value
|
||||||
| LocalData data ->
|
| LocalData data ->
|
||||||
pp_node buffer ~pad "LocalData";
|
pp_node buffer ~pad "LocalData";
|
||||||
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data
|
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data
|
||||||
|
|
||||||
and pp_data_decl buffer ~pad = function
|
and pp_data_decl buffer ~pad = function
|
||||||
LocalConst {value; _} ->
|
LocalConst {value; region} ->
|
||||||
pp_node buffer ~pad "LocalConst";
|
pp_loc_node buffer ~pad "LocalConst" region;
|
||||||
pp_const_decl buffer ~pad value
|
pp_const_decl buffer ~pad value
|
||||||
| LocalVar {value; _} ->
|
| LocalVar {value; region} ->
|
||||||
pp_node buffer ~pad "LocalVar";
|
pp_loc_node buffer ~pad "LocalVar" region;
|
||||||
pp_var_decl buffer ~pad value
|
pp_var_decl buffer ~pad value
|
||||||
|
|
||||||
and pp_var_decl buffer ~pad:(_,pc) decl =
|
and pp_var_decl buffer ~pad:(_,pc) decl =
|
||||||
pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value;
|
pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name;
|
||||||
pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.var_type;
|
pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.var_type;
|
||||||
pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
|
pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
|
||||||
|
|
||||||
and pp_expr buffer ~pad:(_,pc as pad) = function
|
and pp_expr buffer ~pad:(_,pc as pad) = function
|
||||||
ECase {value; _} ->
|
ECase {value; region} ->
|
||||||
pp_node buffer ~pad "ECase";
|
pp_loc_node buffer ~pad "ECase" region;
|
||||||
pp_case pp_expr buffer ~pad value
|
pp_case pp_expr buffer ~pad value
|
||||||
| ECond {value; _} ->
|
| ECond {value; region} ->
|
||||||
pp_node buffer ~pad "ECond";
|
pp_loc_node buffer ~pad "ECond" region;
|
||||||
pp_cond_expr buffer ~pad value
|
pp_cond_expr buffer ~pad value
|
||||||
| EAnnot {value; _} ->
|
| EAnnot {value; region} ->
|
||||||
pp_node buffer ~pad "EAnnot";
|
pp_loc_node buffer ~pad "EAnnot" region;
|
||||||
pp_annotated buffer ~pad value
|
pp_annotated buffer ~pad value
|
||||||
| ELogic e_logic ->
|
| ELogic e_logic ->
|
||||||
pp_node buffer ~pad "ELogic";
|
pp_node buffer ~pad "ELogic";
|
||||||
@ -1333,137 +1348,137 @@ and pp_expr buffer ~pad:(_,pc as pad) = function
|
|||||||
| EConstr e_constr ->
|
| EConstr e_constr ->
|
||||||
pp_node buffer ~pad "EConstr";
|
pp_node buffer ~pad "EConstr";
|
||||||
pp_constr_expr buffer ~pad:(mk_pad 1 0 pc) e_constr
|
pp_constr_expr buffer ~pad:(mk_pad 1 0 pc) e_constr
|
||||||
| ERecord {value; _} ->
|
| ERecord {value; region} ->
|
||||||
pp_node buffer ~pad "ERecord";
|
pp_loc_node buffer ~pad "ERecord" region;
|
||||||
pp_injection pp_field_assign buffer ~pad value
|
pp_ne_injection pp_field_assign buffer ~pad value
|
||||||
| EProj {value; _} ->
|
| EProj {value; region} ->
|
||||||
pp_node buffer ~pad "EProj";
|
pp_loc_node buffer ~pad "EProj" region;
|
||||||
pp_projection buffer ~pad value
|
pp_projection buffer ~pad value
|
||||||
| EMap e_map ->
|
| EMap e_map ->
|
||||||
pp_node buffer ~pad "EMap";
|
pp_node buffer ~pad "EMap";
|
||||||
pp_map_expr buffer ~pad:(mk_pad 1 0 pc) e_map
|
pp_map_expr buffer ~pad:(mk_pad 1 0 pc) e_map
|
||||||
| EVar {value; _} ->
|
| EVar v ->
|
||||||
pp_node buffer ~pad "EVar";
|
pp_node buffer ~pad "EVar";
|
||||||
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
|
pp_ident buffer ~pad:(mk_pad 1 0 pc) v
|
||||||
| ECall {value; _} ->
|
| ECall {value; region} ->
|
||||||
pp_node buffer ~pad "ECall";
|
pp_loc_node buffer ~pad "ECall" region;
|
||||||
pp_fun_call buffer ~pad value
|
pp_fun_call buffer ~pad value
|
||||||
| EBytes {value; _} ->
|
| EBytes b ->
|
||||||
pp_node buffer ~pad "EBytes";
|
pp_node buffer ~pad "EBytes";
|
||||||
pp_bytes buffer ~pad value
|
pp_bytes buffer ~pad b
|
||||||
| EUnit _ ->
|
| EUnit region ->
|
||||||
pp_node buffer ~pad "EUnit"
|
pp_loc_node buffer ~pad "EUnit" region
|
||||||
| ETuple e_tuple ->
|
| ETuple e_tuple ->
|
||||||
pp_node buffer ~pad "ETuple";
|
pp_node buffer ~pad "ETuple";
|
||||||
pp_tuple_expr buffer ~pad e_tuple
|
pp_tuple_expr buffer ~pad e_tuple
|
||||||
| EPar {value; _} ->
|
| EPar {value; region} ->
|
||||||
pp_node buffer ~pad "EPar";
|
pp_loc_node buffer ~pad "EPar" region;
|
||||||
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.inside
|
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.inside
|
||||||
|
|
||||||
and pp_list_expr buffer ~pad:(_,pc as pad) = function
|
and pp_list_expr buffer ~pad:(_,pc as pad) = function
|
||||||
Cons {value; _} ->
|
ECons {value; region} ->
|
||||||
pp_node buffer ~pad "Cons";
|
pp_loc_node buffer ~pad "ECons" region;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1;
|
pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2
|
pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2
|
||||||
| List {value; _} ->
|
| ENil region ->
|
||||||
pp_node buffer ~pad "List";
|
pp_loc_node buffer ~pad "ENil" region
|
||||||
pp_injection pp_expr buffer ~pad value
|
| EListComp {value; region} ->
|
||||||
| Nil _ ->
|
pp_loc_node buffer ~pad "EListComp" region;
|
||||||
pp_node buffer ~pad "Nil"
|
if value.elements = None then
|
||||||
|
pp_node buffer ~pad:(mk_pad 1 0 pc) "[]"
|
||||||
|
else
|
||||||
|
pp_injection pp_expr buffer ~pad value
|
||||||
|
|
||||||
and pp_arith_expr buffer ~pad:(_,pc as pad) = function
|
and pp_arith_expr buffer ~pad:(_,pc as pad) = function
|
||||||
Add {value; _} ->
|
Add {value; region} ->
|
||||||
pp_bin_op "Add" buffer ~pad value
|
pp_bin_op "Add" region buffer ~pad value
|
||||||
| Sub {value; _} ->
|
| Sub {value; region} ->
|
||||||
pp_bin_op "Sub" buffer ~pad value
|
pp_bin_op "Sub" region buffer ~pad value
|
||||||
| Mult {value; _} ->
|
| Mult {value; region} ->
|
||||||
pp_bin_op "Mult" buffer ~pad value
|
pp_bin_op "Mult" region buffer ~pad value
|
||||||
| Div {value; _} ->
|
| Div {value; region} ->
|
||||||
pp_bin_op "Div" buffer ~pad value
|
pp_bin_op "Div" region buffer ~pad value
|
||||||
| Mod {value; _} ->
|
| Mod {value; region} ->
|
||||||
pp_bin_op "Mod" buffer ~pad value
|
pp_bin_op "Mod" region buffer ~pad value
|
||||||
| Neg {value; _} ->
|
| Neg {value; region} ->
|
||||||
pp_node buffer ~pad "Neg";
|
pp_loc_node buffer ~pad "Neg" region;
|
||||||
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg;
|
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg;
|
||||||
| Int {value; _} ->
|
| Int i ->
|
||||||
pp_node buffer ~pad "Int";
|
pp_node buffer ~pad "Int";
|
||||||
pp_int buffer ~pad value
|
pp_int buffer ~pad i
|
||||||
| Nat {value; _} ->
|
| Nat n ->
|
||||||
pp_node buffer ~pad "Nat";
|
pp_node buffer ~pad "Nat";
|
||||||
pp_int buffer ~pad value
|
pp_int buffer ~pad n
|
||||||
| Mutez {value; _} ->
|
| Mutez m ->
|
||||||
pp_node buffer ~pad "Mutez";
|
pp_node buffer ~pad "Mutez";
|
||||||
pp_int buffer ~pad value
|
pp_int buffer ~pad m
|
||||||
|
|
||||||
and pp_set_expr buffer ~pad:(_,pc as pad) = function
|
and pp_set_expr buffer ~pad:(_,pc as pad) = function
|
||||||
SetInj {value; _} ->
|
SetInj {value; region} ->
|
||||||
pp_node buffer ~pad "SetInj";
|
pp_loc_node buffer ~pad "SetInj" region;
|
||||||
pp_injection pp_expr buffer ~pad value
|
pp_injection pp_expr buffer ~pad value
|
||||||
| SetMem {value; _} ->
|
| SetMem {value; region} ->
|
||||||
pp_node buffer ~pad "SetMem";
|
pp_loc_node buffer ~pad "SetMem" region;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 0 pc) value.set;
|
pp_expr buffer ~pad:(mk_pad 2 0 pc) value.set;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 1 pc) value.element
|
pp_expr buffer ~pad:(mk_pad 2 1 pc) value.element
|
||||||
|
|
||||||
and pp_e_logic buffer ~pad = function
|
and pp_e_logic buffer ~pad:(_, pc as pad) = function
|
||||||
BoolExpr e ->
|
BoolExpr e ->
|
||||||
pp_node buffer ~pad "BoolExpr";
|
pp_node buffer ~pad "BoolExpr";
|
||||||
pp_bool_expr buffer ~pad e
|
pp_bool_expr buffer ~pad:(mk_pad 1 0 pc) e
|
||||||
| CompExpr e ->
|
| CompExpr e ->
|
||||||
pp_node buffer ~pad "CompExpr";
|
pp_node buffer ~pad "CompExpr";
|
||||||
pp_comp_expr buffer ~pad e
|
pp_comp_expr buffer ~pad:(mk_pad 1 0 pc) e
|
||||||
|
|
||||||
and pp_bool_expr buffer ~pad:(_,pc as pad) = function
|
and pp_bool_expr buffer ~pad:(_,pc as pad) = function
|
||||||
Or {value; _} ->
|
Or {value; region} ->
|
||||||
pp_bin_op "Or" buffer ~pad value
|
pp_bin_op "Or" region buffer ~pad value
|
||||||
| And {value; _} ->
|
| And {value; region} ->
|
||||||
pp_bin_op "And" buffer ~pad value
|
pp_bin_op "And" region buffer ~pad value
|
||||||
| Not {value; _} ->
|
| Not {value; region} ->
|
||||||
let _, pc as pad = mk_pad 1 0 pc in
|
pp_loc_node buffer ~pad "Not" region;
|
||||||
pp_node buffer ~pad "Not";
|
|
||||||
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg
|
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg
|
||||||
| False _ ->
|
| False region ->
|
||||||
pp_node buffer ~pad:(mk_pad 1 0 pc) "False"
|
pp_loc_node buffer ~pad "False" region
|
||||||
| True _ ->
|
| True region ->
|
||||||
pp_node buffer ~pad:(mk_pad 1 0 pc) "True"
|
pp_loc_node buffer ~pad "True" region
|
||||||
|
|
||||||
and pp_comp_expr buffer ~pad = function
|
and pp_comp_expr buffer ~pad = function
|
||||||
Lt {value; _} ->
|
Lt {value; region} ->
|
||||||
pp_bin_op "Lt" buffer ~pad value
|
pp_bin_op "Lt" region buffer ~pad value
|
||||||
| Leq {value; _} ->
|
| Leq {value; region} ->
|
||||||
pp_bin_op "Leq" buffer ~pad value
|
pp_bin_op "Leq" region buffer ~pad value
|
||||||
| Gt {value; _} ->
|
| Gt {value; region} ->
|
||||||
pp_bin_op "Gt" buffer ~pad value
|
pp_bin_op "Gt" region buffer ~pad value
|
||||||
| Geq {value; _} ->
|
| Geq {value; region} ->
|
||||||
pp_bin_op "Geq" buffer ~pad value
|
pp_bin_op "Geq" region buffer ~pad value
|
||||||
| Equal {value; _} ->
|
| Equal {value; region} ->
|
||||||
pp_bin_op "Equal" buffer ~pad value
|
pp_bin_op "Equal" region buffer ~pad value
|
||||||
| Neq {value; _} ->
|
| Neq {value; region} ->
|
||||||
pp_bin_op "Neq" buffer ~pad value
|
pp_bin_op "Neq" region buffer ~pad value
|
||||||
|
|
||||||
and pp_constr_expr buffer ~pad:(_, pc as pad) = function
|
and pp_constr_expr buffer ~pad:(_, pc as pad) = function
|
||||||
SomeApp {value=some_region,args; _} ->
|
NoneExpr region ->
|
||||||
let constr = {value="Some"; region=some_region} in
|
pp_loc_node buffer ~pad "NoneExpr" region
|
||||||
let app = constr, Some args in
|
| SomeApp {value=_,args; region} ->
|
||||||
pp_node buffer ~pad "SomeApp";
|
pp_loc_node buffer ~pad "SomeApp" region;
|
||||||
pp_constr_app buffer ~pad app
|
pp_tuple_expr buffer ~pad args
|
||||||
| NoneExpr _ ->
|
| ConstrApp {value; region} ->
|
||||||
pp_node buffer ~pad "NoneExpr"
|
pp_loc_node buffer ~pad "ConstrApp" region;
|
||||||
| ConstrApp {value; _} ->
|
|
||||||
pp_node buffer ~pad "ConstrApp";
|
|
||||||
pp_constr_app buffer ~pad:(mk_pad 1 0 pc) value
|
pp_constr_app buffer ~pad:(mk_pad 1 0 pc) value
|
||||||
|
|
||||||
and pp_constr_app buffer ~pad (constr, args_opt) =
|
and pp_constr_app buffer ~pad (constr, args_opt) =
|
||||||
pp_ident buffer ~pad constr.value;
|
pp_ident buffer ~pad constr;
|
||||||
match args_opt with
|
match args_opt with
|
||||||
None -> ()
|
None -> ()
|
||||||
| Some args -> pp_tuple_expr buffer ~pad args
|
| Some args -> pp_tuple_expr buffer ~pad args
|
||||||
|
|
||||||
and pp_map_expr buffer ~pad = function
|
and pp_map_expr buffer ~pad = function
|
||||||
MapLookUp {value; _} ->
|
MapLookUp {value; region} ->
|
||||||
pp_node buffer ~pad "MapLookUp";
|
pp_loc_node buffer ~pad "MapLookUp" region;
|
||||||
pp_map_lookup buffer ~pad value
|
pp_map_lookup buffer ~pad value
|
||||||
| MapInj {value; _} | BigMapInj {value; _} ->
|
| MapInj {value; region} | BigMapInj {value; region} ->
|
||||||
pp_node buffer ~pad "MapInj";
|
pp_loc_node buffer ~pad "MapInj" region;
|
||||||
pp_injection pp_binding buffer ~pad value
|
pp_injection pp_binding buffer ~pad value
|
||||||
|
|
||||||
and pp_tuple_expr buffer ~pad:(_,pc) {value; _} =
|
and pp_tuple_expr buffer ~pad:(_,pc) {value; _} =
|
||||||
@ -1474,20 +1489,20 @@ and pp_tuple_expr buffer ~pad:(_,pc) {value; _} =
|
|||||||
in List.iteri (apply length) exprs
|
in List.iteri (apply length) exprs
|
||||||
|
|
||||||
and pp_string_expr buffer ~pad:(_,pc as pad) = function
|
and pp_string_expr buffer ~pad:(_,pc as pad) = function
|
||||||
Cat {value; _} ->
|
Cat {value; region} ->
|
||||||
pp_node buffer ~pad "Cat";
|
pp_loc_node buffer ~pad "Cat" region;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1;
|
pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2;
|
pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2;
|
||||||
| String {value; _} ->
|
| String s ->
|
||||||
pp_node buffer ~pad "String";
|
pp_node buffer ~pad "String";
|
||||||
pp_string buffer ~pad:(mk_pad 1 0 pc) value
|
pp_string buffer ~pad:(mk_pad 1 0 pc) s
|
||||||
|
|
||||||
and pp_annotated buffer ~pad:(_,pc) (expr, t_expr) =
|
and pp_annotated buffer ~pad:(_,pc) (expr, t_expr) =
|
||||||
pp_expr buffer ~pad:(mk_pad 2 0 pc) expr;
|
pp_expr buffer ~pad:(mk_pad 2 0 pc) expr;
|
||||||
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) t_expr
|
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) t_expr
|
||||||
|
|
||||||
and pp_bin_op node buffer ~pad:(_,pc as pad) op =
|
and pp_bin_op node region buffer ~pad:(_,pc as pad) op =
|
||||||
pp_node buffer ~pad node;
|
pp_loc_node buffer ~pad node region;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 0 pc) op.arg1;
|
pp_expr buffer ~pad:(mk_pad 2 0 pc) op.arg1;
|
||||||
pp_expr buffer ~pad:(mk_pad 2 1 pc) op.arg2
|
pp_expr buffer ~pad:(mk_pad 2 1 pc) op.arg2
|
||||||
|
|
||||||
|
|||||||
@ -13,4 +13,6 @@ val path_to_string : AST.path -> string
|
|||||||
val pattern_to_string : AST.pattern -> string
|
val pattern_to_string : AST.pattern -> string
|
||||||
val instruction_to_string : AST.instruction -> string
|
val instruction_to_string : AST.instruction -> string
|
||||||
|
|
||||||
|
(* Pretty-printing of the AST *)
|
||||||
|
|
||||||
val pp_ast : Buffer.t -> AST.t -> unit
|
val pp_ast : Buffer.t -> AST.t -> unit
|
||||||
|
|||||||
91
src/passes/1-parser/pascaligo/Tests/pp.ligo
Normal file
91
src/passes/1-parser/pascaligo/Tests/pp.ligo
Normal file
@ -0,0 +1,91 @@
|
|||||||
|
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 a : t; b : record c : string end end
|
||||||
|
|
||||||
|
function back (var store : store) : list (operation) * store is
|
||||||
|
var operations : list (operation) := list []
|
||||||
|
begin
|
||||||
|
const a : nat = 0n;
|
||||||
|
x0 := record foo = "1"; bar = 4n end;
|
||||||
|
x1 := nil;
|
||||||
|
x2 := list end;
|
||||||
|
x3 := 3#4# list [5; 6];
|
||||||
|
case foo of
|
||||||
|
10n -> skip
|
||||||
|
end;
|
||||||
|
if s contains x then skip else skip;
|
||||||
|
s := set [3_000mutez; -2; 1n];
|
||||||
|
a := A;
|
||||||
|
b := B (a);
|
||||||
|
c := C (a, B (a));
|
||||||
|
d := None;
|
||||||
|
e := Some (a, B (b));
|
||||||
|
z := z.1.2;
|
||||||
|
x := map [1 -> "1"; 2 -> "2"];
|
||||||
|
y := a.b.c[3];
|
||||||
|
a := "hello " ^ "world" ^ "!";
|
||||||
|
patch store.backers with set [(1); f(2*3)];
|
||||||
|
remove (1,2,3) from set foo.bar;
|
||||||
|
remove 3 from map foo.bar;
|
||||||
|
patch store.backers with map [sender -> amount];
|
||||||
|
if now > store.deadline and (not True) then
|
||||||
|
begin
|
||||||
|
f (x,1);
|
||||||
|
for k -> d : int * string in map m block { skip };
|
||||||
|
for x : int in set s block { skip };
|
||||||
|
while i < 10n
|
||||||
|
begin
|
||||||
|
acc := 2 - (if toggle then f(x) else Unit);
|
||||||
|
end;
|
||||||
|
for i := 1n to 10n
|
||||||
|
begin
|
||||||
|
acc := acc + i;
|
||||||
|
end;
|
||||||
|
failwith ("Deadline passed");
|
||||||
|
end
|
||||||
|
else
|
||||||
|
case store.backers[sender] of [
|
||||||
|
None -> store.0.backers[sender] := amount
|
||||||
|
| Some (_) -> skip
|
||||||
|
| B (x, C (y,z)) -> skip
|
||||||
|
| False#True#Unit#0xAA#"hi"#4#nil -> skip
|
||||||
|
]
|
||||||
|
end with (operations, store)
|
||||||
|
|
||||||
|
function claim (var store : store) : list (operation) * store is
|
||||||
|
var operations : list (operation) := nil
|
||||||
|
begin
|
||||||
|
if now <= store.deadline then
|
||||||
|
failwith ("Too soon.")
|
||||||
|
else
|
||||||
|
case store.backers[sender] of
|
||||||
|
None ->
|
||||||
|
failwith ("Not a backer.")
|
||||||
|
| Some (amount) ->
|
||||||
|
if balance >= store.goal or store.funded then
|
||||||
|
failwith ("Goal reached: no refund.")
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
operations.0.foo := list [transaction (unit, sender, amount)];
|
||||||
|
remove sender from map store.backers
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end with (operations, store)
|
||||||
|
|
||||||
|
function withdraw (var store : store) : list (operation) * store is
|
||||||
|
var operations : list (operation) := list end
|
||||||
|
begin
|
||||||
|
if sender = owner then
|
||||||
|
if now >= store.deadline then
|
||||||
|
if balance >= store.goal then {
|
||||||
|
// store.funded := True;
|
||||||
|
patch store with record funded = True; a = b end;
|
||||||
|
operations := list [Transfer (owner, balance)];
|
||||||
|
};
|
||||||
|
else failwith ("Below target.")
|
||||||
|
else failwith ("Too soon.");
|
||||||
|
else skip
|
||||||
|
end with case (foo: bar) of
|
||||||
|
nil -> (operations, (store : store))
|
||||||
|
| _ -> (operations, store)
|
||||||
|
end
|
||||||
@ -11,7 +11,7 @@
|
|||||||
(modules AST pascaligo Parser ParserLog LexToken)
|
(modules AST pascaligo Parser ParserLog LexToken)
|
||||||
(libraries
|
(libraries
|
||||||
parser_shared
|
parser_shared
|
||||||
hex
|
hex
|
||||||
simple-utils
|
simple-utils
|
||||||
tezos-utils
|
tezos-utils
|
||||||
)
|
)
|
||||||
@ -20,12 +20,12 @@
|
|||||||
|
|
||||||
(executable
|
(executable
|
||||||
(name LexerMain)
|
(name LexerMain)
|
||||||
(libraries
|
(libraries
|
||||||
hex
|
hex
|
||||||
simple-utils
|
simple-utils
|
||||||
tezos-utils
|
tezos-utils
|
||||||
parser_pascaligo)
|
parser_pascaligo)
|
||||||
(modules
|
(modules
|
||||||
LexerMain
|
LexerMain
|
||||||
)
|
)
|
||||||
(flags (:standard -open Parser_shared -open Parser_pascaligo))
|
(flags (:standard -open Parser_shared -open Parser_pascaligo))
|
||||||
@ -33,9 +33,9 @@
|
|||||||
|
|
||||||
(executable
|
(executable
|
||||||
(name ParserMain)
|
(name ParserMain)
|
||||||
(libraries
|
(libraries
|
||||||
parser_pascaligo)
|
parser_pascaligo)
|
||||||
(modules
|
(modules
|
||||||
ParserMain
|
ParserMain
|
||||||
)
|
)
|
||||||
(flags (:standard -open Simple_utils -open Parser_shared -open Parser_pascaligo))
|
(flags (:standard -open Simple_utils -open Parser_shared -open Parser_pascaligo))
|
||||||
|
|||||||
@ -57,17 +57,6 @@ module Errors = struct
|
|||||||
] in
|
] in
|
||||||
error ~data title message
|
error ~data title message
|
||||||
|
|
||||||
let unsupported_arith_op expr =
|
|
||||||
let title () = "arithmetic expressions" in
|
|
||||||
let message () =
|
|
||||||
Format.asprintf "this arithmetic operator is not supported yet" in
|
|
||||||
let expr_loc = Raw.expr_to_region expr in
|
|
||||||
let data = [
|
|
||||||
("expr_loc",
|
|
||||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ expr_loc)
|
|
||||||
] in
|
|
||||||
error ~data title message
|
|
||||||
|
|
||||||
let unsupported_non_var_pattern p =
|
let unsupported_non_var_pattern p =
|
||||||
let title () = "pattern is not a variable" in
|
let title () = "pattern is not a variable" in
|
||||||
let message () =
|
let message () =
|
||||||
@ -175,15 +164,14 @@ let return_let_in ?loc binder rhs = ok @@ fun expr'_opt ->
|
|||||||
| Some expr' -> ok @@ e_let_in ?loc binder rhs expr'
|
| Some expr' -> ok @@ e_let_in ?loc binder rhs expr'
|
||||||
|
|
||||||
let return_statement expr = ok @@ fun expr'_opt ->
|
let return_statement expr = ok @@ fun expr'_opt ->
|
||||||
let expr = expr in
|
|
||||||
match expr'_opt with
|
match expr'_opt with
|
||||||
| None -> ok @@ expr
|
| None -> ok @@ expr
|
||||||
| Some expr' -> ok @@ e_sequence expr expr'
|
| Some expr' -> ok @@ e_sequence expr expr'
|
||||||
|
|
||||||
let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
|
let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
|
||||||
match t with
|
match t with
|
||||||
| TPar x -> simpl_type_expression x.value.inside
|
TPar x -> simpl_type_expression x.value.inside
|
||||||
| TAlias v -> (
|
| TVar v -> (
|
||||||
match List.assoc_opt v.value type_constants with
|
match List.assoc_opt v.value type_constants with
|
||||||
| Some s -> ok @@ T_constant (s , [])
|
| Some s -> ok @@ T_constant (s , [])
|
||||||
| None -> ok @@ T_variable v.value
|
| None -> ok @@ T_variable v.value
|
||||||
@ -222,12 +210,10 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
|
|||||||
| TSum s ->
|
| TSum s ->
|
||||||
let aux (v:Raw.variant Raw.reg) =
|
let aux (v:Raw.variant Raw.reg) =
|
||||||
let args =
|
let args =
|
||||||
match v.value.args with
|
match v.value.arg with
|
||||||
None -> []
|
None -> []
|
||||||
| Some (_, t_expr) ->
|
| Some (_, TProd product) -> npseq_to_list product.value
|
||||||
match t_expr with
|
| Some (_, t_expr) -> [t_expr] in
|
||||||
TProd product -> npseq_to_list product.value
|
|
||||||
| _ -> [t_expr] in
|
|
||||||
let%bind te = simpl_list_type_expression @@ args in
|
let%bind te = simpl_list_type_expression @@ args in
|
||||||
ok (v.value.constr.value, te)
|
ok (v.value.constr.value, te)
|
||||||
in
|
in
|
||||||
@ -303,7 +289,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
|
|||||||
let%bind fields = bind_list
|
let%bind fields = bind_list
|
||||||
@@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = simpl_expression v in ok (k.value, v))
|
@@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = simpl_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_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
|
||||||
@@ pseq_to_list r.value.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)
|
||||||
| EProj p -> simpl_projection p
|
| EProj p -> simpl_projection p
|
||||||
@ -460,19 +446,17 @@ and simpl_logic_expression (t:Raw.logic_expr) : expression result =
|
|||||||
and simpl_list_expression (t:Raw.list_expr) : expression result =
|
and simpl_list_expression (t:Raw.list_expr) : expression result =
|
||||||
let return x = ok x in
|
let return x = ok x in
|
||||||
match t with
|
match t with
|
||||||
| Cons c ->
|
ECons c ->
|
||||||
simpl_binop "CONS" c
|
simpl_binop "CONS" c
|
||||||
| List lst -> (
|
| EListComp lst ->
|
||||||
let (lst , loc) = r_split lst in
|
let (lst , loc) = r_split lst in
|
||||||
let%bind lst' =
|
let%bind lst' =
|
||||||
bind_map_list simpl_expression @@
|
bind_map_list simpl_expression @@
|
||||||
pseq_to_list lst.elements in
|
pseq_to_list lst.elements in
|
||||||
return @@ e_list ~loc lst'
|
return @@ e_list ~loc lst'
|
||||||
)
|
| ENil reg ->
|
||||||
| Nil reg -> (
|
|
||||||
let loc = Location.lift reg in
|
let loc = Location.lift reg in
|
||||||
return @@ e_list ~loc []
|
return @@ e_list ~loc []
|
||||||
)
|
|
||||||
|
|
||||||
and simpl_set_expression (t:Raw.set_expr) : expression result =
|
and simpl_set_expression (t:Raw.set_expr) : expression result =
|
||||||
match t with
|
match t with
|
||||||
@ -668,13 +652,13 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
|
|||||||
let%bind body = simpl_block l.block.value in
|
let%bind body = simpl_block l.block.value in
|
||||||
let%bind body = body None in
|
let%bind body = body None in
|
||||||
return_statement @@ e_loop cond body
|
return_statement @@ e_loop cond body
|
||||||
| Loop (For (ForInt fi)) ->
|
| Loop (For (ForInt fi)) ->
|
||||||
let%bind loop = simpl_for_int fi.value in
|
let%bind loop = simpl_for_int fi.value in
|
||||||
let%bind loop = loop None in
|
let%bind loop = loop None in
|
||||||
return_statement @@ loop
|
return_statement @@ loop
|
||||||
| Loop (For (ForCollect fc)) ->
|
| Loop (For (ForCollect fc)) ->
|
||||||
let%bind loop = simpl_for_collect fc.value in
|
let%bind loop = simpl_for_collect fc.value in
|
||||||
let%bind loop = loop None in
|
let%bind loop = loop None in
|
||||||
return_statement @@ loop
|
return_statement @@ loop
|
||||||
| Cond c -> (
|
| Cond c -> (
|
||||||
let (c , loc) = r_split c in
|
let (c , loc) = r_split c in
|
||||||
@ -878,7 +862,7 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
|
|||||||
ok (List.hd t') in
|
ok (List.hd t') in
|
||||||
let get_toplevel (t : Raw.pattern) =
|
let get_toplevel (t : Raw.pattern) =
|
||||||
match t with
|
match t with
|
||||||
| PCons x -> (
|
| PList PCons x -> (
|
||||||
let (x' , lst) = x.value in
|
let (x' , lst) = x.value in
|
||||||
match lst with
|
match lst with
|
||||||
| [] -> ok x'
|
| [] -> ok x'
|
||||||
@ -887,8 +871,8 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
|
|||||||
| pattern -> ok pattern in
|
| pattern -> ok pattern in
|
||||||
let get_constr (t: Raw.pattern) =
|
let get_constr (t: Raw.pattern) =
|
||||||
match t with
|
match t with
|
||||||
| PConstr v -> (
|
| PConstr (PConstrApp v) -> (
|
||||||
let (const , pat_opt) = v.value in
|
let const, pat_opt = v.value in
|
||||||
let%bind pat =
|
let%bind pat =
|
||||||
trace_option (unsupported_cst_constr t) @@
|
trace_option (unsupported_cst_constr t) @@
|
||||||
pat_opt in
|
pat_opt in
|
||||||
@ -896,12 +880,6 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
|
|||||||
let%bind var = get_var single_pat in
|
let%bind var = get_var single_pat in
|
||||||
ok (const.value , var)
|
ok (const.value , var)
|
||||||
)
|
)
|
||||||
(*
|
|
||||||
| PConstr {value = constr, Some tuple; _} ->
|
|
||||||
let%bind var = get_single (PTuple tuple) >>? get_var in
|
|
||||||
ok (constr.value, var)
|
|
||||||
| PConstr {value = constr, None; _} ->
|
|
||||||
*)
|
|
||||||
| _ -> fail @@ only_constructors t in
|
| _ -> fail @@ only_constructors t in
|
||||||
let%bind patterns =
|
let%bind patterns =
|
||||||
let aux (x , y) =
|
let aux (x , y) =
|
||||||
@ -909,19 +887,19 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
|
|||||||
ok (x' , y)
|
ok (x' , y)
|
||||||
in bind_map_list aux t in
|
in bind_map_list aux t in
|
||||||
match patterns with
|
match patterns with
|
||||||
| [(PFalse _ , f) ; (PTrue _ , t)]
|
| [(PConstr PFalse _ , f) ; (PConstr PTrue _ , t)]
|
||||||
| [(PTrue _ , t) ; (PFalse _ , f)] ->
|
| [(PConstr PTrue _ , t) ; (PConstr PFalse _ , f)] ->
|
||||||
ok @@ Match_bool {match_true = t ; match_false = f}
|
ok @@ Match_bool {match_true = t ; match_false = f}
|
||||||
| [(PSome v , some) ; (PNone _ , none)]
|
| [(PConstr PSomeApp v , some) ; (PConstr PNone _ , none)]
|
||||||
| [(PNone _ , none) ; (PSome v , some)] -> (
|
| [(PConstr PNone _ , none) ; (PConstr PSomeApp v , some)] -> (
|
||||||
let (_, v) = v.value in
|
let (_, v) = v.value in
|
||||||
let%bind v = match v.value.inside with
|
let%bind v = match v.value.inside with
|
||||||
| PVar v -> ok v.value
|
| PVar v -> ok v.value
|
||||||
| p -> fail @@ unsupported_deep_Some_patterns p in
|
| p -> fail @@ unsupported_deep_Some_patterns p in
|
||||||
ok @@ Match_option {match_none = none ; match_some = (v, some) }
|
ok @@ Match_option {match_none = none ; match_some = (v, some) }
|
||||||
)
|
)
|
||||||
| [(PCons c , cons) ; (PList (PNil _) , nil)]
|
| [(PList PCons c, cons) ; (PList (PNil _), nil)]
|
||||||
| [(PList (PNil _) , nil) ; (PCons c, cons)] ->
|
| [(PList (PNil _), nil) ; (PList PCons c, cons)] ->
|
||||||
let%bind (a, b) =
|
let%bind (a, b) =
|
||||||
match c.value with
|
match c.value with
|
||||||
| a, [(_, b)] ->
|
| a, [(_, b)] ->
|
||||||
@ -1002,11 +980,11 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
|
|||||||
are implemented using a MAP_FOLD, LIST_FOLD or SET_FOLD:
|
are implemented using a MAP_FOLD, LIST_FOLD or SET_FOLD:
|
||||||
|
|
||||||
``` pseudo Ast_simplified
|
``` pseudo Ast_simplified
|
||||||
let #COMPILER#folded_record = list_fold( mylist ,
|
let #COMPILER#folded_record = list_fold( mylist ,
|
||||||
record st = st; acc = acc; end;
|
record st = st; acc = acc; end;
|
||||||
lamby = fun arguments -> (
|
lamby = fun arguments -> (
|
||||||
let #COMPILER#acc = arguments.0 in
|
let #COMPILER#acc = arguments.0 in
|
||||||
let #COMPILER#elt = arguments.1 in
|
let #COMPILER#elt = arguments.1 in
|
||||||
#COMPILER#acc.myint := #COMPILER#acc.myint + #COMPILER#elt ;
|
#COMPILER#acc.myint := #COMPILER#acc.myint + #COMPILER#elt ;
|
||||||
#COMPILER#acc.myst := #COMPILER#acc.myst ^ "to" ;
|
#COMPILER#acc.myst := #COMPILER#acc.myst ^ "to" ;
|
||||||
#COMPILER#acc
|
#COMPILER#acc
|
||||||
@ -1017,7 +995,7 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
|
|||||||
myint := #COMPILER#folded_record.myint ;
|
myint := #COMPILER#folded_record.myint ;
|
||||||
}
|
}
|
||||||
```
|
```
|
||||||
|
|
||||||
We are performing the following steps:
|
We are performing the following steps:
|
||||||
1) Simplifying the for body using ̀simpl_block`
|
1) Simplifying the for body using ̀simpl_block`
|
||||||
|
|
||||||
@ -1032,10 +1010,10 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
|
|||||||
- free variable of name X as rhs ==> accessor `#COMPILER#acc.X`
|
- free variable of name X as rhs ==> accessor `#COMPILER#acc.X`
|
||||||
- free variable of name X as lhs ==> accessor `#COMPILER#acc.X`
|
- free variable of name X as lhs ==> accessor `#COMPILER#acc.X`
|
||||||
And, in the case of a map:
|
And, in the case of a map:
|
||||||
- references to the iterated key ==> variable `#COMPILER#elt_key`
|
- references to the iterated key ==> variable `#COMPILER#elt_key`
|
||||||
- references to the iterated value ==> variable `#COMPILER#elt_value`
|
- references to the iterated value ==> variable `#COMPILER#elt_value`
|
||||||
in the case of a set/list:
|
in the case of a set/list:
|
||||||
- references to the iterated value ==> variable `#COMPILER#elt`
|
- references to the iterated value ==> variable `#COMPILER#elt`
|
||||||
|
|
||||||
5) Append the return value to the body
|
5) Append the return value to the body
|
||||||
|
|
||||||
@ -1045,18 +1023,18 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
|
|||||||
tuple holding:
|
tuple holding:
|
||||||
* In the case of `list` or ̀set`:
|
* In the case of `list` or ̀set`:
|
||||||
( folding record , current list/set element ) as
|
( folding record , current list/set element ) as
|
||||||
( #COMPILER#acc , #COMPILER#elt )
|
( #COMPILER#acc , #COMPILER#elt )
|
||||||
* In the case of `map`:
|
* In the case of `map`:
|
||||||
( folding record , current map key , current map value ) as
|
( folding record , current map key , current map value ) as
|
||||||
( #COMPILER#acc , #COMPILER#elt_key , #COMPILER#elt_value )
|
( #COMPILER#acc , #COMPILER#elt_key , #COMPILER#elt_value )
|
||||||
|
|
||||||
7) Build the lambda using the final body of (6)
|
7) Build the lambda using the final body of (6)
|
||||||
|
|
||||||
8) Build a sequence of assignments for all the captured variables
|
8) Build a sequence of assignments for all the captured variables
|
||||||
to their new value, namely an access to the folded record
|
to their new value, namely an access to the folded record
|
||||||
(#COMPILER#folded_record)
|
(#COMPILER#folded_record)
|
||||||
|
|
||||||
9) Attach the sequence of 8 to the ̀let .. in` declaration
|
9) Attach the sequence of 8 to the ̀let .. in` declaration
|
||||||
of #COMPILER#folded_record
|
of #COMPILER#folded_record
|
||||||
|
|
||||||
**)
|
**)
|
||||||
@ -1095,7 +1073,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
|
|||||||
if (List.mem name captured_name_list) then
|
if (List.mem name captured_name_list) then
|
||||||
(* replace references to fold accumulator as lhs *)
|
(* replace references to fold accumulator as lhs *)
|
||||||
ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name]
|
ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name]
|
||||||
else match fc.collection with
|
else match fc.collection with
|
||||||
(* loop on map *)
|
(* loop on map *)
|
||||||
| Map _ ->
|
| Map _ ->
|
||||||
let k' = e_variable "#COMPILER#collec_elt_k" in
|
let k' = e_variable "#COMPILER#collec_elt_k" in
|
||||||
@ -1127,7 +1105,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
|
|||||||
(* STEP 6 *)
|
(* STEP 6 *)
|
||||||
let for_body =
|
let for_body =
|
||||||
let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in
|
let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in
|
||||||
( match fc.collection with
|
( match fc.collection with
|
||||||
| Map _ ->
|
| Map _ ->
|
||||||
(* let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in
|
(* let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in
|
||||||
let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in
|
let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in
|
||||||
@ -1158,8 +1136,8 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
|
|||||||
let access = e_accessor (e_variable "#COMPILER#folded_record")
|
let access = e_accessor (e_variable "#COMPILER#folded_record")
|
||||||
[Access_record captured_varname] in
|
[Access_record captured_varname] in
|
||||||
let assign = e_assign captured_varname [] access in
|
let assign = e_assign captured_varname [] access in
|
||||||
match prev with
|
match prev with
|
||||||
| None -> Some assign
|
| None -> Some assign
|
||||||
| Some p -> Some (e_sequence p assign) in
|
| Some p -> Some (e_sequence p assign) in
|
||||||
let reassign_sequence = List.fold_left assign_back None captured_name_list in
|
let reassign_sequence = List.fold_left assign_back None captured_name_list in
|
||||||
(* STEP 9 *)
|
(* STEP 9 *)
|
||||||
@ -1170,4 +1148,4 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
|
|||||||
return_statement @@ final_sequence
|
return_statement @@ final_sequence
|
||||||
|
|
||||||
let simpl_program : Raw.ast -> program result = fun t ->
|
let simpl_program : Raw.ast -> program result = fun t ->
|
||||||
bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl
|
bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl
|
||||||
|
|||||||
@ -9,7 +9,6 @@ module SMap = Map.String
|
|||||||
module Errors :
|
module Errors :
|
||||||
sig
|
sig
|
||||||
val bad_bytes : Location.t -> string -> unit -> error
|
val bad_bytes : Location.t -> string -> unit -> error
|
||||||
val unsupported_arith_op : Raw.expr -> unit -> error
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
24
vendors/ligo-utils/simple-utils/region.ml
vendored
24
vendors/ligo-utils/simple-utils/region.ml
vendored
@ -90,24 +90,18 @@ let make ~(start: Pos.t) ~(stop: Pos.t) =
|
|||||||
info start_offset stop#line horizontal stop_offset
|
info start_offset stop#line horizontal stop_offset
|
||||||
|
|
||||||
method compact ?(file=true) ?(offsets=true) mode =
|
method compact ?(file=true) ?(offsets=true) mode =
|
||||||
let start_line = start#line
|
let prefix = if file then start#file ^ ":" else ""
|
||||||
and stop_line = stop#line in
|
and start_str = start#anonymous ~offsets mode
|
||||||
let start_str = start#anonymous ~offsets mode
|
|
||||||
and stop_str = stop#anonymous ~offsets mode in
|
and stop_str = stop#anonymous ~offsets mode in
|
||||||
if start#file = stop#file then
|
if start#file = stop#file then
|
||||||
if file then
|
if start#line = stop#line then
|
||||||
sprintf "%s:%s-%s" start#file
|
sprintf "%s%s-%i" prefix start_str
|
||||||
start_str
|
(if offsets then stop#offset mode
|
||||||
(if start_line = stop_line
|
else stop#column mode)
|
||||||
then stop#column mode |> string_of_int
|
|
||||||
else stop_str)
|
|
||||||
else
|
else
|
||||||
sprintf "%s-%s"
|
sprintf "%s%s-%s" prefix start_str stop_str
|
||||||
start_str
|
else sprintf "%s:%s-%s:%s"
|
||||||
(if start_line = stop_line
|
start#file start_str stop#file stop_str
|
||||||
then stop#column mode |> string_of_int
|
|
||||||
else stop_str)
|
|
||||||
else sprintf "%s:%s-%s:%s" start#file start_str stop#file stop_str
|
|
||||||
end
|
end
|
||||||
|
|
||||||
(* Special regions *)
|
(* Special regions *)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user