balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'rinderknecht-dev' into 'dev'

Browse Source 
Refactoring of PascaLIGO's front-end

See merge request ligolang/ligo!176
This commit is contained in:
Christian Rinderknecht 2019-11-06 17:17:02 +00:00
commit 759978393a
15 changed files with 661 additions and 615 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/passes/1-parser/ligodity/ParserLog.ml
View File

@ -878,13 +878,13 @@ and pp_arith_expr buffer ~pad:(_,pc as pad) = function
pp_node buffer ~pad "Mutez";
pp_int buffer ~pad m
and pp_e_logic buffer ~pad = function
and pp_e_logic buffer ~pad:(_,pc as pad) = function
BoolExpr e ->
pp_node buffer ~pad "BoolExpr";
pp_bool_expr buffer ~pad e
pp_bool_expr buffer ~pad:(mk_pad 1 0 pc) e
| CompExpr e ->
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
Or {value; region} ->
@ -892,13 +892,12 @@ and pp_bool_expr buffer ~pad:(_,pc as pad) = function
| And {value; region} ->
pp_bin_op "And" region buffer ~pad value
| Not {value; _} ->
let _, pc as pad = mk_pad 1 0 pc in
pp_node buffer ~pad "Not";
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg
| False region ->
pp_loc_node buffer ~pad:(mk_pad 1 0 pc) "False" region
pp_loc_node buffer ~pad "False" 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
Lt {value; region} ->

98
src/passes/1-parser/pascaligo/AST.ml
View File

@ -191,13 +191,13 @@ and type_expr =
| TApp of (type_name * type_tuple) reg
| TFun of (type_expr * arrow * type_expr) reg
| TPar of type_expr par reg
| TAlias of variable
| TVar of variable
and cartesian = (type_expr, times) nsepseq reg
and variant = {
constr : constr;
args : (kwd_of * type_expr) option
arg : (kwd_of * type_expr) option
}
and field_decl = {
@ -211,17 +211,18 @@ and type_tuple = (type_expr, comma) nsepseq par reg
(* Function and procedure declarations *)
and fun_decl = {
kwd_function : kwd_function;
name : variable;
param : parameters;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
local_decls : local_decl list;
block : block reg option;
kwd_with : kwd_with option;
return : expr;
terminator : semi option }
kwd_function : kwd_function;
name : variable;
param : parameters;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
local_decls : local_decl list;
block : block reg option;
kwd_with : kwd_with option;
return : expr;
terminator : semi option
}
and parameters = (param_decl, semi) nsepseq par reg
@ -456,7 +457,7 @@ and expr =
| EList of list_expr
| ESet of set_expr
| EConstr of constr_expr
| ERecord of record_expr
| ERecord of field_assign reg ne_injection reg
| EProj of projection reg
| EMap of map_expr
| EVar of Lexer.lexeme reg
@ -497,7 +498,7 @@ and closing =
and map_expr =
MapLookUp of map_lookup reg
| MapInj of binding reg injection reg
| BigMapInj of binding reg injection reg
| BigMapInj of binding reg injection reg
and map_lookup = {
path : path;
@ -554,19 +555,15 @@ and string_expr =
| String of Lexer.lexeme reg
and list_expr =
Cons of cons bin_op reg
| List of expr injection reg
| Nil of nil
and nil = kwd_nil
ECons of cons bin_op reg
| EListComp of expr injection reg
| ENil of kwd_nil
and constr_expr =
SomeApp of (c_Some * arguments) reg
| NoneExpr of none_expr
| NoneExpr of c_None
| ConstrApp of (constr * arguments option) reg
and record_expr = field_assign reg injection reg
and field_assign = {
field_name : field_name;
equal : equal;
@ -585,8 +582,6 @@ and selection =
and tuple_expr = (expr, comma) nsepseq par reg
and none_expr = c_None
and fun_call = (fun_name * arguments) reg
and arguments = tuple_expr
@ -594,28 +589,31 @@ and arguments = tuple_expr
(* Patterns *)
and pattern =
PCons of (pattern, cons) nsepseq reg
| PConstr of (constr * tuple_pattern option) reg
PConstr of constr_pattern
| PVar of Lexer.lexeme reg
| PWild of wild
| PInt of (Lexer.lexeme * Z.t) reg
| PNat of (Lexer.lexeme * Z.t) reg
| PBytes of (Lexer.lexeme * Hex.t) 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
| 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 list_pattern =
Sugar of pattern injection reg
| PNil of kwd_nil
| Raw of (pattern * cons * pattern) par reg
PListComp of pattern injection reg
| PNil of kwd_nil
| PParCons of (pattern * cons * pattern) par reg
| PCons of (pattern, cons) nsepseq reg
(* Projecting regions *)
@ -628,7 +626,7 @@ let type_expr_to_region = function
| TApp {region; _}
| TFun {region; _}
| TPar {region; _}
| TAlias {region; _} -> region
| TVar {region; _} -> region
let rec expr_to_region = function
| 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 list_expr_to_region = function
Cons {region; _}
| List {region; _}
| Nil region -> region
ECons {region; _}
| EListComp {region; _}
| ENil region -> region
and constr_expr_to_region = function
NoneExpr region
@ -733,26 +731,26 @@ let clause_block_to_region = function
| ShortBlock {region; _} -> region
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
let pattern_to_region = function
PCons {region; _}
| PVar {region; _}
PVar {region; _}
| PWild region
| PInt {region; _}
| PNat {region; _}
| PBytes {region; _}
| PString {region; _}
| PUnit region
| PFalse region
| PTrue region
| PNone region
| PSome {region; _}
| PList Sugar {region; _}
| PConstr PUnit region
| PConstr PFalse region
| PConstr PTrue region
| PConstr PNone region
| PConstr PSomeApp {region; _}
| PConstr PConstrApp {region; _}
| PList PListComp {region; _}
| PList PNil region
| PList Raw {region; _}
| PConstr {region; _}
| PList PParCons {region; _}
| PList PCons {region; _}
| PTuple {region; _} -> region
let local_decl_to_region = function

43
src/passes/1-parser/pascaligo/AST.mli
View File

@ -182,13 +182,13 @@ and type_expr =
| TApp of (type_name * type_tuple) reg
| TFun of (type_expr * arrow * type_expr) reg
| TPar of type_expr par reg
| TAlias of variable
| TVar of variable
and cartesian = (type_expr, times) nsepseq reg
and variant = {
constr : constr;
args : (kwd_of * type_expr) option
arg : (kwd_of * type_expr) option
}
and field_decl = {
@ -447,7 +447,7 @@ and expr =
| EList of list_expr
| ESet of set_expr
| EConstr of constr_expr
| ERecord of record_expr
| ERecord of field_assign reg ne_injection reg
| EProj of projection reg
| EMap of map_expr
| EVar of Lexer.lexeme reg
@ -545,19 +545,15 @@ and string_expr =
| String of Lexer.lexeme reg
and list_expr =
Cons of cons bin_op reg
| List of expr injection reg
| Nil of nil
and nil = kwd_nil
ECons of cons bin_op reg
| EListComp of expr injection reg
| ENil of kwd_nil
and constr_expr =
SomeApp of (c_Some * arguments) reg
| NoneExpr of none_expr
| NoneExpr of c_None
| ConstrApp of (constr * arguments option) reg
and record_expr = field_assign reg injection reg
and field_assign = {
field_name : field_name;
equal : equal;
@ -576,8 +572,6 @@ and selection =
and tuple_expr = (expr, comma) nsepseq par reg
and none_expr = c_None
and fun_call = (fun_name * arguments) reg
and arguments = tuple_expr
@ -585,28 +579,31 @@ and arguments = tuple_expr
(* Patterns *)
and pattern =
PCons of (pattern, cons) nsepseq reg
| PConstr of (constr * tuple_pattern option) reg
PConstr of constr_pattern
| PVar of Lexer.lexeme reg
| PWild of wild
| PInt of (Lexer.lexeme * Z.t) reg
| PNat of (Lexer.lexeme * Z.t) reg
| PBytes of (Lexer.lexeme * Hex.t) 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
| 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 list_pattern =
Sugar of pattern injection reg
| PNil of kwd_nil
| Raw of (pattern * cons * pattern) par reg
PListComp of pattern injection reg
| PNil of kwd_nil
| PParCons of (pattern * cons * pattern) par reg
| PCons of (pattern, cons) nsepseq reg
(* Projecting regions *)

2
src/passes/1-parser/pascaligo/Doc/pascaligo.md
View File

@ -956,7 +956,7 @@ functions, in the tradition of Pascal. For example,
begin
skip
end with i+1
const item : int = 0
const item : int = 0
begin
var temp : list (int) := nil;
for item in l

79
src/passes/1-parser/pascaligo/LexToken.mli
View File

@ -70,51 +70,50 @@ type t =
(* Keywords *)
| And of Region.t (* "and" *)
| Begin of Region.t (* "begin" *)
| BigMap of Region.t (* "big_map" *)
| Block of Region.t (* "block" *)
| Case of Region.t (* "case" *)
| Const of Region.t (* "const" *)
| Contains of Region.t (* "contains" *)
| Down of Region.t (* "down" *)
| Else of Region.t (* "else" *)
| End of Region.t (* "end" *)
| Fail of Region.t (* "fail" *)
| For of Region.t (* "for" *)
| From of Region.t (* "from" *)
| Function of Region.t (* "function" *)
| If of Region.t (* "if" *)
| In of Region.t (* "in" *)
| Is of Region.t (* "is" *)
| List of Region.t (* "list" *)
| Map of Region.t (* "map" *)
| Mod of Region.t (* "mod" *)
| Nil of Region.t (* "nil" *)
| Not of Region.t (* "not" *)
| Of of Region.t (* "of" *)
| Or of Region.t (* "or" *)
| Patch of Region.t (* "patch" *)
| Procedure of Region.t (* "procedure" *)
| Record of Region.t (* "record" *)
| Remove of Region.t (* "remove" *)
| Set of Region.t (* "set" *)
| Skip of Region.t (* "skip" *)
| Step of Region.t (* "step" *)
| Then of Region.t (* "then" *)
| To of Region.t (* "to" *)
| Type of Region.t (* "type" *)
| Var of Region.t (* "var" *)
| While of Region.t (* "while" *)
| With of Region.t (* "with" *)
| And of Region.t (* "and" *)
| Begin of Region.t (* "begin" *)
| BigMap of Region.t (* "big_map" *)
| Block of Region.t (* "block" *)
| Case of Region.t (* "case" *)
| Const of Region.t (* "const" *)
| Contains of Region.t (* "contains" *)
| Down of Region.t (* "down" *)
| Else of Region.t (* "else" *)
| End of Region.t (* "end" *)
| Fail of Region.t (* "fail" *)
| False of Region.t (* "False" *)
| For of Region.t (* "for" *)
| From of Region.t (* "from" *)
| Function of Region.t (* "function" *)
| If of Region.t (* "if" *)
| In of Region.t (* "in" *)
| Is of Region.t (* "is" *)
| List of Region.t (* "list" *)
| Map of Region.t (* "map" *)
| Mod of Region.t (* "mod" *)
| Nil of Region.t (* "nil" *)
| Not of Region.t (* "not" *)
| Of of Region.t (* "of" *)
| Or of Region.t (* "or" *)
| Patch of Region.t (* "patch" *)
| Record of Region.t (* "record" *)
| Remove of Region.t (* "remove" *)
| Set of Region.t (* "set" *)
| Skip of Region.t (* "skip" *)
| Step of Region.t (* "step" *)
| Then of Region.t (* "then" *)
| To of Region.t (* "to" *)
| True of Region.t (* "True" *)
| Type of Region.t (* "type" *)
| Unit of Region.t (* "Unit" *)
| Var of Region.t (* "var" *)
| While of Region.t (* "while" *)
| With of Region.t (* "with" *)
(* Data constructors *)
| C_False of Region.t (* "False" *)
| C_None of Region.t (* "None" *)
| C_Some of Region.t (* "Some" *)
| C_True of Region.t (* "True" *)
| C_Unit of Region.t (* "Unit" *)
(* Virtual tokens *)

164
src/passes/1-parser/pascaligo/LexToken.mll
View File

@ -68,73 +68,50 @@ type t =
(* Keywords *)
| And of Region.t (* "and" *)
| Begin of Region.t (* "begin" *)
| BigMap of Region.t (* "big_map" *)
| Block of Region.t (* "block" *)
| Case of Region.t (* "case" *)
| Const of Region.t (* "const" *)
| Contains of Region.t (* "contains" *)
| Down of Region.t (* "down" *)
| Else of Region.t (* "else" *)
| End of Region.t (* "end" *)
| Fail of Region.t (* "fail" *)
| For of Region.t (* "for" *)
| From of Region.t (* "from" *)
| Function of Region.t (* "function" *)
| If of Region.t (* "if" *)
| In of Region.t (* "in" *)
| Is of Region.t (* "is" *)
| List of Region.t (* "list" *)
| Map of Region.t (* "map" *)
| Mod of Region.t (* "mod" *)
| Nil of Region.t (* "nil" *)
| Not of Region.t (* "not" *)
| Of of Region.t (* "of" *)
| Or of Region.t (* "or" *)
| Patch of Region.t (* "patch" *)
| Procedure of Region.t (* "procedure" *)
| Record of Region.t (* "record" *)
| Remove of Region.t (* "remove" *)
| Set of Region.t (* "set" *)
| Skip of Region.t (* "skip" *)
| Step of Region.t (* "step" *)
| Then of Region.t (* "then" *)
| To of Region.t (* "to" *)
| Type of Region.t (* "type" *)
| Var of Region.t (* "var" *)
| While of Region.t (* "while" *)
| With of Region.t (* "with" *)
| And of Region.t (* "and" *)
| Begin of Region.t (* "begin" *)
| BigMap of Region.t (* "big_map" *)
| Block of Region.t (* "block" *)
| Case of Region.t (* "case" *)
| Const of Region.t (* "const" *)
| Contains of Region.t (* "contains" *)
| Down of Region.t (* "down" *)
| Else of Region.t (* "else" *)
| End of Region.t (* "end" *)
| Fail of Region.t (* "fail" *)
| False of Region.t (* "False" *)
| For of Region.t (* "for" *)
| From of Region.t (* "from" *)
| Function of Region.t (* "function" *)
| If of Region.t (* "if" *)
| In of Region.t (* "in" *)
| Is of Region.t (* "is" *)
| List of Region.t (* "list" *)
| Map of Region.t (* "map" *)
| Mod of Region.t (* "mod" *)
| Nil of Region.t (* "nil" *)
| Not of Region.t (* "not" *)
| Of of Region.t (* "of" *)
| Or of Region.t (* "or" *)
| Patch of Region.t (* "patch" *)
| Record of Region.t (* "record" *)
| Remove of Region.t (* "remove" *)
| Set of Region.t (* "set" *)
| Skip of Region.t (* "skip" *)
| Step of Region.t (* "step" *)
| Then of Region.t (* "then" *)
| To of Region.t (* "to" *)
| True of Region.t (* "True" *)
| Type of Region.t (* "type" *)
| Unit of Region.t (* "Unit" *)
| 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 *)
| C_False of Region.t (* "False" *)
| C_None of Region.t (* "None" *)
| C_Some of Region.t (* "Some" *)
| C_True of Region.t (* "True" *)
| C_Unit of Region.t (* "Unit" *)
(* Virtual tokens *)
@ -211,6 +188,7 @@ let proj_token = function
| Else region -> region, "Else"
| End region -> region, "End"
| Fail region -> region, "Fail"
| False region -> region, "False"
| For region -> region, "For"
| From region -> region, "From"
| Function region -> region, "Function"
@ -225,7 +203,6 @@ let proj_token = function
| Of region -> region, "Of"
| Or region -> region, "Or"
| Patch region -> region, "Patch"
| Procedure region -> region, "Procedure"
| Record region -> region, "Record"
| Remove region -> region, "Remove"
| Set region -> region, "Set"
@ -233,18 +210,17 @@ let proj_token = function
| Step region -> region, "Step"
| Then region -> region, "Then"
| To region -> region, "To"
| True region -> region, "True"
| Type region -> region, "Type"
| Unit region -> region, "Unit"
| Var region -> region, "Var"
| While region -> region, "While"
| With region -> region, "With"
(* Data *)
| C_False region -> region, "C_False"
| C_None region -> region, "C_None"
| C_Some region -> region, "C_Some"
| C_True region -> region, "C_True"
| C_Unit region -> region, "C_Unit"
(* Virtual tokens *)
@ -304,6 +280,7 @@ let to_lexeme = function
| Else _ -> "else"
| End _ -> "end"
| Fail _ -> "fail"
| False _ -> "False"
| For _ -> "for"
| From _ -> "from"
| Function _ -> "function"
@ -318,7 +295,6 @@ let to_lexeme = function
| Of _ -> "of"
| Or _ -> "or"
| Patch _ -> "patch"
| Procedure _ -> "procedure"
| Record _ -> "record"
| Remove _ -> "remove"
| Set _ -> "set"
@ -326,18 +302,17 @@ let to_lexeme = function
| Step _ -> "step"
| Then _ -> "then"
| To _ -> "to"
| True _ -> "True"
| Type _ -> "type"
| Unit _ -> "Unit"
| Var _ -> "var"
| While _ -> "while"
| With _ -> "with"
(* Data constructors *)
| C_False _ -> "False"
| C_None _ -> "None"
| C_Some _ -> "Some"
| C_True _ -> "True"
| C_Unit _ -> "Unit"
(* Virtual tokens *)
@ -368,6 +343,7 @@ let keywords = [
(fun reg -> From reg);
(fun reg -> Function reg);
(fun reg -> Fail reg);
(fun reg -> False reg);
(fun reg -> If reg);
(fun reg -> In reg);
(fun reg -> Is reg);
@ -376,10 +352,10 @@ let keywords = [
(fun reg -> Mod reg);
(fun reg -> Nil reg);
(fun reg -> Not reg);
(fun reg -> C_None reg);
(fun reg -> Of reg);
(fun reg -> Or reg);
(fun reg -> Patch reg);
(fun reg -> Procedure reg);
(fun reg -> Record reg);
(fun reg -> Remove reg);
(fun reg -> Set reg);
@ -387,7 +363,9 @@ let keywords = [
(fun reg -> Step reg);
(fun reg -> Then reg);
(fun reg -> To reg);
(fun reg -> True reg);
(fun reg -> Type reg);
(fun reg -> Unit reg);
(fun reg -> Var reg);
(fun reg -> While reg);
(fun reg -> With reg)
@ -398,11 +376,11 @@ let reserved =
empty |> add "args"
let constructors = [
(fun reg -> C_False reg);
(fun reg -> C_None reg);
(fun reg -> C_Some reg);
(fun reg -> C_True reg);
(fun reg -> C_Unit reg)
(fun reg -> False reg);
(fun reg -> True reg);
(fun reg -> Unit reg);
(fun reg -> C_None reg);
(fun reg -> C_Some reg)
]
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
let mk_int lexeme region =
let z = Str.(global_replace (regexp "_") "" lexeme)
|> Z.of_string in
if Z.equal z Z.zero && lexeme <> "0"
then Error Non_canonical_zero
else Ok (Int Region.{region; value = lexeme, z})
let z =
Str.(global_replace (regexp "_") "" lexeme) |> Z.of_string
in if Z.equal z Z.zero && lexeme <> "0"
then Error Non_canonical_zero
else Ok (Int Region.{region; value = lexeme,z})
type nat_err =
Invalid_natural
@ -494,7 +472,7 @@ let mk_nat lexeme region =
Z.of_string in
if Z.equal z Z.zero && lexeme <> "0n"
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 =
@ -533,9 +511,9 @@ let mk_sym lexeme region =
| "*" -> Ok (TIMES region)
| "/" -> Ok (SLASH region)
| "<" -> Ok (LT region)
| "<=" -> Ok (LE region)
| "<=" -> Ok (LE region)
| ">" -> Ok (GT region)
| ">=" -> Ok (GE region)
| ">=" -> Ok (GE region)
(* Lexemes specific to PascaLIGO *)
| "=/=" -> Ok (NE region)
@ -545,20 +523,17 @@ let mk_sym lexeme region =
(* Invalid lexemes *)
| _ -> Error Invalid_symbol
(* Identifiers *)
let mk_ident' lexeme region lexicon =
let mk_ident lexeme region =
Lexing.from_string lexeme |> scan_ident region lexicon
let mk_ident lexeme region = mk_ident' lexeme region lexicon
(* Constructors *)
let mk_constr' lexeme region lexicon =
let mk_constr lexeme region =
Lexing.from_string lexeme |> scan_constr region lexicon
let mk_constr lexeme region = mk_constr' lexeme region lexicon
(* Predicates *)
let is_string = function
@ -589,6 +564,7 @@ let is_kwd = function
| Else _
| End _
| Fail _
| False _
| For _
| From _
| Function _
@ -603,7 +579,6 @@ let is_kwd = function
| Of _
| Or _
| Patch _
| Procedure _
| Record _
| Remove _
| Set _
@ -611,7 +586,9 @@ let is_kwd = function
| Step _
| Then _
| To _
| True _
| Type _
| Unit _
| Var _
| While _
| With _ -> true
@ -619,11 +596,8 @@ let is_kwd = function
let is_constr = function
Constr _
| C_False _
| C_None _
| C_Some _
| C_True _
| C_Unit _ -> true
| C_Some _ -> true
| _ -> false
let is_sym = function

6
src/passes/1-parser/pascaligo/ParToken.mly
View File

@ -53,6 +53,7 @@
%token <Region.t> Contains (* "contains" *)
%token <Region.t> Else (* "else" *)
%token <Region.t> End (* "end" *)
%token <Region.t> False (* "False" *)
%token <Region.t> For (* "for" *)
%token <Region.t> Function (* "function" *)
%token <Region.t> From (* "from" *)
@ -73,18 +74,17 @@
%token <Region.t> Skip (* "skip" *)
%token <Region.t> Then (* "then" *)
%token <Region.t> To (* "to" *)
%token <Region.t> True (* "True" *)
%token <Region.t> Type (* "type" *)
%token <Region.t> Unit (* "Unit" *)
%token <Region.t> Var (* "var" *)
%token <Region.t> While (* "while" *)
%token <Region.t> With (* "with" *)
(* Data constructors *)
%token <Region.t> C_False (* "False" *)
%token <Region.t> C_None (* "None" *)
%token <Region.t> C_Some (* "Some" *)
%token <Region.t> C_True (* "True" *)
%token <Region.t> C_Unit (* "Unit" *)
(* Virtual tokens *)

64
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -161,7 +161,7 @@ function_type:
core_type:
type_name {
TAlias $1
TVar $1
}
| type_name type_tuple {
let region = cover $1.region $2.region
@ -200,16 +200,16 @@ type_tuple:
sum_type:
option(VBAR) nsepseq(variant,VBAR) {
let region = nsepseq_to_region (fun x -> x.region) $2
in {region; value = $2} }
in {region; value=$2} }
variant:
Constr Of cartesian {
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}
}
| Constr {
{region=$1.region; value= {constr=$1; args=None}} }
{region=$1.region; value= {constr=$1; arg=None}} }
record_type:
Record sep_or_term_list(field_decl,SEMI) End {
@ -793,7 +793,7 @@ cons_expr:
and stop = expr_to_region $3 in
let region = cover start stop
and value = {arg1 = $1; op = $2; arg2 = $3}
in EList (Cons {region; value})
in EList (ECons {region; value})
}
| add_expr { $1 }
@ -856,13 +856,13 @@ unary_expr:
core_expr:
Int { EArith (Int $1) }
| Nat { EArith (Nat $1) }
| Mutez { EArith (Mutez $1) }
| Mutez { EArith (Mutez $1) }
| var { EVar $1 }
| String { EString (String $1) }
| Bytes { EBytes $1 }
| C_False { ELogic (BoolExpr (False $1)) }
| C_True { ELogic (BoolExpr (True $1)) }
| C_Unit { EUnit $1 }
| False { ELogic (BoolExpr (False $1)) }
| True { ELogic (BoolExpr (True $1)) }
| Unit { EUnit $1 }
| annot_expr { EAnnot $1 }
| tuple_expr { ETuple $1 }
| par(expr) { EPar $1 }
@ -927,21 +927,21 @@ selection:
record_expr:
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
and value : field_assign AST.reg injection = {
and value : field_assign AST.reg ne_injection = {
opening = Kwd $1;
elements = Some elements;
ne_elements;
terminator;
closing = End $3}
in {region; value}
}
| 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
and value : field_assign AST.reg injection = {
and value : field_assign AST.reg ne_injection = {
opening = KwdBracket ($1,$2);
elements = Some elements;
ne_elements;
terminator;
closing = RBracket $4}
in {region; value} }
@ -971,8 +971,8 @@ arguments:
par(nsepseq(expr,COMMA)) { $1 }
list_expr:
injection(List,expr) { List $1 }
| Nil { Nil $1 }
injection(List,expr) { EListComp $1 }
| Nil { ENil $1 }
(* Patterns *)
@ -980,7 +980,7 @@ pattern:
core_pattern CONS nsepseq(core_pattern,CONS) {
let value = Utils.nsepseq_cons $1 $2 $3 in
let region = nsepseq_to_region pattern_to_region value
in PCons {region; value}}
in PList (PCons {region; value}) }
| core_pattern { $1 }
core_pattern:
@ -990,21 +990,14 @@ core_pattern:
| Nat { PNat $1 }
| Bytes { PBytes $1 }
| String { PString $1 }
| C_Unit { PUnit $1 }
| C_False { PFalse $1 }
| C_True { PTrue $1 }
| C_None { PNone $1 }
| list_pattern { PList $1 }
| tuple_pattern { PTuple $1 }
| constr_pattern { PConstr $1 }
| C_Some par(core_pattern) {
let region = cover $1 $2.region
in PSome {region; value = $1,$2}}
list_pattern:
injection(List,core_pattern) { Sugar $1 }
| Nil { PNil $1 }
| par(cons_pattern) { Raw $1 }
injection(List,core_pattern) { PListComp $1 }
| Nil { PNil $1 }
| par(cons_pattern) { PParCons $1 }
cons_pattern:
core_pattern CONS pattern { $1,$2,$3 }
@ -1013,10 +1006,17 @@ tuple_pattern:
par(nsepseq(core_pattern,COMMA)) { $1 }
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
in {region; value = $1, Some $2}
in PConstrApp {region; value = $1, Some $2}
}
| Constr {
{region=$1.region; value = $1, None}
}
PConstrApp {region=$1.region; value = $1, None} }

583
src/passes/1-parser/pascaligo/ParserLog.ml
View File

@ -107,15 +107,15 @@ and print_type_expr buffer = function
| TApp type_app -> print_type_app buffer type_app
| TFun type_fun -> print_type_fun buffer type_fun
| 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; _} =
print_nsepseq buffer "*" print_type_expr value
and print_variant buffer ({value; _}: variant reg) =
let {constr; args} = value in
let {constr; arg} = value in
print_constr buffer constr;
match args with
match arg with
None -> ()
| Some (kwd_of, t_expr) ->
print_token buffer kwd_of "of";
@ -538,12 +538,12 @@ and print_string_expr buffer = function
print_string buffer s
and print_list_expr buffer = function
Cons {value = {arg1; op; arg2}; _} ->
ECons {value = {arg1; op; arg2}; _} ->
print_expr buffer arg1;
print_token buffer op "#";
print_expr buffer arg2
| List e -> print_injection buffer "list" print_expr e
| Nil e -> print_nil buffer e
| EListComp e -> print_injection buffer "list" print_expr e
| ENil e -> print_nil buffer e
and print_constr_expr buffer = function
SomeApp e -> print_some_app buffer e
@ -551,7 +551,7 @@ and print_constr_expr buffer = function
| ConstrApp e -> print_constr_app 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; _} =
let {field_name; equal; field_expr} = value in
@ -666,7 +666,7 @@ and print_constr_app buffer {value; _} =
print_constr buffer constr;
match arguments with
None -> ()
| Some args -> print_tuple_expr buffer args
| Some arg -> print_tuple_expr buffer arg
and print_some_app buffer {value; _} =
let c_Some, arguments = value in
@ -680,28 +680,28 @@ and print_par_expr buffer {value; _} =
print_token buffer rpar ")"
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 "_"
| PInt i -> print_int buffer i
| PNat n -> print_nat buffer n
| PBytes b -> print_bytes buffer b
| 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
| PTuple ptuple -> print_ptuple buffer ptuple
| PConstr pattern -> print_constr_pattern buffer pattern
and print_constr_pattern buffer {value; _} =
let (constr, args) = value in
print_constr buffer constr;
match args with
None -> ()
| Some tuple -> print_ptuple buffer tuple
and print_constr_pattern buffer = function
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"
| 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; _} =
let c_Some, patterns = value in
@ -715,14 +715,16 @@ and print_patterns buffer {value; _} =
print_token buffer rpar ")"
and print_list_pattern buffer = function
Sugar sugar ->
print_injection buffer "list" print_pattern sugar
PListComp comp ->
print_injection buffer "list" print_pattern comp
| PNil kwd_nil ->
print_token buffer kwd_nil "nil"
| Raw raw ->
print_raw buffer raw
| PParCons cons ->
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 head, cons, tail = inside in
print_token buffer lpar "(";
@ -755,17 +757,27 @@ let instruction_to_string = to_string print_instruction
(* 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 =
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
in Buffer.add_string buffer node
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 apply len rank =
@ -776,52 +788,52 @@ let rec pp_ast buffer ~pad:(_,pc as pad) {decl; _} =
List.iteri (List.length decls |> apply) decls
and pp_declaration buffer ~pad:(_,pc as pad) = function
TypeDecl {value; _} ->
pp_node buffer ~pad "TypeDecl";
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.name.value;
TypeDecl {value; region} ->
pp_loc_node buffer ~pad "TypeDecl" region;
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.name;
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.type_expr
| ConstDecl {value; _} ->
pp_node buffer ~pad "ConstDecl";
| ConstDecl {value; region} ->
pp_loc_node buffer ~pad "ConstDecl" region;
pp_const_decl buffer ~pad value
| FunDecl {value; _} ->
pp_node buffer ~pad "FunDecl";
| FunDecl {value; region} ->
pp_loc_node buffer ~pad "FunDecl" region;
pp_fun_decl buffer ~pad value
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_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
and pp_type_expr buffer ~pad:(_,pc as pad) = function
TProd cartesian ->
pp_node buffer ~pad "TProd";
pp_loc_node buffer ~pad "TProd" cartesian.region;
pp_cartesian buffer ~pad cartesian
| TAlias {value; _} ->
pp_node buffer ~pad "TAlias";
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
| TPar {value; _} ->
pp_node buffer ~pad "TPar";
| TVar v ->
pp_node buffer ~pad "TVar";
pp_ident buffer ~pad:(mk_pad 1 0 pc) v
| TPar {value; region} ->
pp_loc_node buffer ~pad "TPar" region;
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) value.inside
| TApp {value=name,tuple; _} ->
pp_node buffer ~pad "TApp";
pp_ident buffer ~pad:(mk_pad 1 0 pc) name.value;
| TApp {value=name,tuple; region} ->
pp_loc_node buffer ~pad "TApp" region;
pp_ident buffer ~pad:(mk_pad 1 0 pc) name;
pp_type_tuple buffer ~pad:(mk_pad 2 1 pc) tuple
| TFun {value; _} ->
pp_node buffer ~pad "TFun";
| TFun {value; region} ->
pp_loc_node buffer ~pad "TFun" region;
let apply len rank =
let pad = mk_pad len rank pc in
pp_type_expr buffer ~pad in
let domain, _, range = value in
List.iteri (apply 2) [domain; range]
| TSum {value; _} ->
pp_node buffer ~pad "TSum";
| TSum {value; region} ->
pp_loc_node buffer ~pad "TSum" region;
let apply len rank variant =
let pad = mk_pad len rank pc in
pp_variant buffer ~pad variant.value in
let variants = Utils.nsepseq_to_list value in
List.iteri (List.length variants |> apply) variants
| TRecord {value; _} ->
pp_node buffer ~pad "TRecord";
| TRecord {value; region} ->
pp_loc_node buffer ~pad "TRecord" region;
let apply len rank field_decl =
pp_field_decl buffer ~pad:(mk_pad len rank pc)
field_decl.value in
@ -834,15 +846,15 @@ and pp_cartesian buffer ~pad:(_,pc) {value; _} =
let components = Utils.nsepseq_to_list value
in List.iteri (List.length components |> apply) components
and pp_variant buffer ~pad:(_,pc as pad) {constr; args} =
pp_node buffer ~pad constr.value;
match args with
and pp_variant buffer ~pad:(_,pc as pad) {constr; arg} =
pp_ident buffer ~pad constr;
match arg with
None -> ()
| Some (_,c) ->
pp_type_expr buffer ~pad:(mk_pad 1 0 pc) c
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
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
let () =
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 pad = mk_pad fields 1 pc in
pp_node buffer ~pad "<parameters>";
@ -875,8 +887,8 @@ and pp_fun_decl buffer ~pad:(_,pc) decl =
pp_node buffer ~pad "<block>";
let statements =
match decl.block with
| Some block -> block.value.statements
| None -> Instr (Skip Region.ghost), [] in
Some block -> block.value.statements
| None -> Instr (Skip Region.ghost), [] in
pp_statements buffer ~pad statements in
let () =
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
and pp_param_decl buffer ~pad:(_,pc as pad) = function
ParamConst {value; _} ->
pp_node buffer ~pad "ParamConst";
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var.value;
ParamConst {value; region} ->
pp_loc_node buffer ~pad "ParamConst" region;
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var;
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.param_type
| ParamVar {value; _} ->
pp_node buffer ~pad "ParamVar";
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var.value;
| ParamVar {value; region} ->
pp_loc_node buffer ~pad "ParamVar" region;
pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var;
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.param_type
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
and pp_instruction buffer ~pad:(_,pc as pad) = function
Cond {value; _} ->
pp_node buffer ~pad "Cond";
Cond {value; region} ->
pp_loc_node buffer ~pad "Cond" region;
pp_conditional buffer ~pad value
| CaseInstr {value; _} ->
pp_node buffer ~pad "CaseInstr";
| CaseInstr {value; region} ->
pp_loc_node buffer ~pad "CaseInstr" region;
pp_case pp_if_clause buffer ~pad value
| Assign {value; _} ->
pp_node buffer ~pad "Assign";
| Assign {value; region} ->
pp_loc_node buffer ~pad "Assign" region;
pp_assignment buffer ~pad value
| Loop loop ->
pp_node buffer ~pad "Loop";
pp_loop buffer ~pad:(mk_pad 1 0 pc) loop
| ProcCall {value; _} ->
pp_node buffer ~pad "ProcCall";
| ProcCall {value; region} ->
pp_loc_node buffer ~pad "ProcCall" region;
pp_fun_call buffer ~pad value
| Skip _ ->
pp_node buffer ~pad "Skip"
| RecordPatch {value; _} ->
pp_node buffer ~pad "RecordPatch";
| Skip region ->
pp_loc_node buffer ~pad "Skip" region
| RecordPatch {value; region} ->
pp_loc_node buffer ~pad "RecordPatch" region;
pp_record_patch buffer ~pad value
| MapPatch {value; _} ->
pp_node buffer ~pad "MapPatch";
| MapPatch {value; region} ->
pp_loc_node buffer ~pad "MapPatch" region;
pp_map_patch buffer ~pad value
| SetPatch {value; _} ->
pp_node buffer ~pad "SetPatch";
| SetPatch {value; region} ->
pp_loc_node buffer ~pad "SetPatch" region;
pp_set_patch buffer ~pad value
| MapRemove {value; _} ->
pp_node buffer ~pad "MapRemove";
| MapRemove {value; region} ->
pp_loc_node buffer ~pad "MapRemove" region;
pp_map_remove buffer ~pad value
| SetRemove {value; _} ->
pp_node buffer ~pad "SetRemove";
| SetRemove {value; region} ->
pp_loc_node buffer ~pad "SetRemove" region;
pp_set_remove buffer ~pad value
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
and pp_clause_block buffer ~pad = function
LongBlock {value; _} ->
pp_node buffer ~pad "LongBlock";
LongBlock {value; region} ->
pp_loc_node buffer ~pad "LongBlock" region;
pp_statements buffer ~pad value.statements
| ShortBlock {value; _} ->
pp_node buffer ~pad "ShortBlock";
let statements = fst value.inside in
pp_statements buffer ~pad statements
| ShortBlock {value; region} ->
pp_loc_node buffer ~pad "ShortBlock" region;
pp_statements buffer ~pad (fst value.inside)
and pp_case :
'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
and pp_pattern buffer ~pad:(_,pc as pad) = function
PNone _ ->
pp_node buffer ~pad "PNone"
| PSome {value=_,{value=par; _}; _} ->
pp_node buffer ~pad "PSome";
pp_pattern buffer ~pad:(mk_pad 1 0 pc) par.inside
| PWild _ ->
pp_node buffer ~pad "PWild"
| PConstr {value; _} ->
PWild region ->
pp_loc_node buffer ~pad "PWild" region
| PConstr pattern ->
pp_node buffer ~pad "PConstr";
pp_constr_pattern buffer ~pad:(mk_pad 1 0 pc) value
| PCons {value; _} ->
pp_constr_pattern buffer ~pad:(mk_pad 1 0 pc) pattern
| 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 length = List.length patterns in
let apply len rank =
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
| 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) =
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) =
and pp_bin_cons buffer ~pad:(_,pc) (head, _, tail) =
pp_pattern buffer ~pad:(mk_pad 2 0 pc) head;
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
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
and pp_lhs buffer ~pad:(_,pc as pad) = function
Path path ->
pp_node buffer ~pad "Path";
pp_path buffer ~pad:(mk_pad 1 0 pc) path
| MapPath {value; _} ->
pp_node buffer ~pad "MapPath";
| MapPath {value; region} ->
pp_loc_node buffer ~pad "MapPath" region;
pp_map_lookup buffer ~pad value
and pp_path buffer ~pad:(_,pc as pad) = function
Name {value; _} ->
Name name ->
pp_node buffer ~pad "Name";
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
| Path {value; _} ->
pp_node buffer ~pad "Path";
pp_ident buffer ~pad:(mk_pad 1 0 pc) name
| Path {value; region} ->
pp_loc_node buffer ~pad "Path" region;
pp_projection buffer ~pad value
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 apply len rank =
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
and pp_selection buffer ~pad:(_,pc as pad) = function
FieldName {value; _} ->
FieldName name ->
pp_node buffer ~pad "FieldName";
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
| Component {value; _} ->
pp_ident buffer ~pad:(mk_pad 1 0 pc) name
| Component comp ->
pp_node buffer ~pad "Component";
pp_int buffer ~pad value
pp_int buffer ~pad comp
and pp_map_lookup buffer ~pad:(_,pc) lookup =
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
and pp_for_loop buffer ~pad = function
ForInt {value; _} ->
pp_node buffer ~pad "ForInt";
ForInt {value; region} ->
pp_loc_node buffer ~pad "ForInt" region;
pp_for_int buffer ~pad value
| ForCollect {value; _} ->
pp_node buffer ~pad "ForCollect";
| ForCollect {value; region} ->
pp_loc_node buffer ~pad "ForCollect" region;
pp_for_collect buffer ~pad value
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 =
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
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
match collect.bind_to with
None ->
pp_ident buffer ~pad collect.var.value
pp_ident buffer ~pad collect.var
| Some (_, var) ->
pp_var_binding buffer ~pad (collect.var, var) in
let () =
@ -1229,22 +1244,22 @@ and pp_for_collect buffer ~pad:(_,pc) collect =
in ()
and pp_collection buffer ~pad = function
Map _ -> pp_string buffer ~pad "map"
| Set _ -> pp_string buffer ~pad "set"
| List _ -> pp_string buffer ~pad "list"
Map region -> pp_loc_node buffer ~pad "map" region
| Set region -> pp_loc_node buffer ~pad "set" region
| List region -> pp_loc_node buffer ~pad "list" region
and pp_var_binding buffer ~pad:(_,pc as pad) (source, image) =
pp_node buffer ~pad "<binding>";
pp_ident buffer ~pad:(mk_pad 2 0 pc) source.value;
pp_ident buffer ~pad:(mk_pad 2 1 pc) image.value
pp_ident buffer ~pad:(mk_pad 2 0 pc) source;
pp_ident buffer ~pad:(mk_pad 2 1 pc) image
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 apply len rank =
pp_expr buffer ~pad:(mk_pad len rank pc)
in pp_ident buffer ~pad:(mk_pad (1+arity) 0 pc) name.value;
List.iteri (apply arity) args
in pp_ident buffer ~pad:(mk_pad (1+arity) 0 pc) name;
List.iteri (apply arity) args
and pp_record_patch buffer ~pad:(_,pc as pad) patch =
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; _} =
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
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
and pp_local_decl buffer ~pad:(_,pc as pad) = function
LocalFun {value; _} ->
pp_node buffer ~pad "LocalFun";
LocalFun {value; region} ->
pp_loc_node buffer ~pad "LocalFun" region;
pp_fun_decl buffer ~pad value
| LocalData data ->
pp_node buffer ~pad "LocalData";
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data
and pp_data_decl buffer ~pad = function
LocalConst {value; _} ->
pp_node buffer ~pad "LocalConst";
LocalConst {value; region} ->
pp_loc_node buffer ~pad "LocalConst" region;
pp_const_decl buffer ~pad value
| LocalVar {value; _} ->
pp_node buffer ~pad "LocalVar";
| LocalVar {value; region} ->
pp_loc_node buffer ~pad "LocalVar" region;
pp_var_decl buffer ~pad value
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_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
and pp_expr buffer ~pad:(_,pc as pad) = function
ECase {value; _} ->
pp_node buffer ~pad "ECase";
ECase {value; region} ->
pp_loc_node buffer ~pad "ECase" region;
pp_case pp_expr buffer ~pad value
| ECond {value; _} ->
pp_node buffer ~pad "ECond";
| ECond {value; region} ->
pp_loc_node buffer ~pad "ECond" region;
pp_cond_expr buffer ~pad value
| EAnnot {value; _} ->
pp_node buffer ~pad "EAnnot";
| EAnnot {value; region} ->
pp_loc_node buffer ~pad "EAnnot" region;
pp_annotated buffer ~pad value
| ELogic e_logic ->
pp_node buffer ~pad "ELogic";
@ -1333,137 +1348,137 @@ and pp_expr buffer ~pad:(_,pc as pad) = function
| EConstr e_constr ->
pp_node buffer ~pad "EConstr";
pp_constr_expr buffer ~pad:(mk_pad 1 0 pc) e_constr
| ERecord {value; _} ->
pp_node buffer ~pad "ERecord";
pp_injection pp_field_assign buffer ~pad value
| EProj {value; _} ->
pp_node buffer ~pad "EProj";
| ERecord {value; region} ->
pp_loc_node buffer ~pad "ERecord" region;
pp_ne_injection pp_field_assign buffer ~pad value
| EProj {value; region} ->
pp_loc_node buffer ~pad "EProj" region;
pp_projection buffer ~pad value
| EMap e_map ->
pp_node buffer ~pad "EMap";
pp_map_expr buffer ~pad:(mk_pad 1 0 pc) e_map
| EVar {value; _} ->
| EVar v ->
pp_node buffer ~pad "EVar";
pp_ident buffer ~pad:(mk_pad 1 0 pc) value
| ECall {value; _} ->
pp_node buffer ~pad "ECall";
pp_ident buffer ~pad:(mk_pad 1 0 pc) v
| ECall {value; region} ->
pp_loc_node buffer ~pad "ECall" region;
pp_fun_call buffer ~pad value
| EBytes {value; _} ->
| EBytes b ->
pp_node buffer ~pad "EBytes";
pp_bytes buffer ~pad value
| EUnit _ ->
pp_node buffer ~pad "EUnit"
pp_bytes buffer ~pad b
| EUnit region ->
pp_loc_node buffer ~pad "EUnit" region
| ETuple e_tuple ->
pp_node buffer ~pad "ETuple";
pp_tuple_expr buffer ~pad e_tuple
| EPar {value; _} ->
pp_node buffer ~pad "EPar";
| EPar {value; region} ->
pp_loc_node buffer ~pad "EPar" region;
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.inside
and pp_list_expr buffer ~pad:(_,pc as pad) = function
Cons {value; _} ->
pp_node buffer ~pad "Cons";
ECons {value; region} ->
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 1 pc) value.arg2
| List {value; _} ->
pp_node buffer ~pad "List";
pp_injection pp_expr buffer ~pad value
| Nil _ ->
pp_node buffer ~pad "Nil"
| ENil region ->
pp_loc_node buffer ~pad "ENil" region
| EListComp {value; region} ->
pp_loc_node buffer ~pad "EListComp" region;
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
Add {value; _} ->
pp_bin_op "Add" buffer ~pad value
| Sub {value; _} ->
pp_bin_op "Sub" buffer ~pad value
| Mult {value; _} ->
pp_bin_op "Mult" buffer ~pad value
| Div {value; _} ->
pp_bin_op "Div" buffer ~pad value
| Mod {value; _} ->
pp_bin_op "Mod" buffer ~pad value
| Neg {value; _} ->
pp_node buffer ~pad "Neg";
Add {value; region} ->
pp_bin_op "Add" region buffer ~pad value
| Sub {value; region} ->
pp_bin_op "Sub" region buffer ~pad value
| Mult {value; region} ->
pp_bin_op "Mult" region buffer ~pad value
| Div {value; region} ->
pp_bin_op "Div" region buffer ~pad value
| Mod {value; region} ->
pp_bin_op "Mod" region buffer ~pad value
| Neg {value; region} ->
pp_loc_node buffer ~pad "Neg" region;
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg;
| Int {value; _} ->
| Int i ->
pp_node buffer ~pad "Int";
pp_int buffer ~pad value
| Nat {value; _} ->
pp_int buffer ~pad i
| Nat n ->
pp_node buffer ~pad "Nat";
pp_int buffer ~pad value
| Mutez {value; _} ->
pp_int buffer ~pad n
| Mutez m ->
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
SetInj {value; _} ->
pp_node buffer ~pad "SetInj";
SetInj {value; region} ->
pp_loc_node buffer ~pad "SetInj" region;
pp_injection pp_expr buffer ~pad value
| SetMem {value; _} ->
pp_node buffer ~pad "SetMem";
| SetMem {value; region} ->
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 1 pc) value.element
and pp_e_logic buffer ~pad = function
and pp_e_logic buffer ~pad:(_, pc as pad) = function
BoolExpr e ->
pp_node buffer ~pad "BoolExpr";
pp_bool_expr buffer ~pad e
pp_bool_expr buffer ~pad:(mk_pad 1 0 pc) e
| CompExpr e ->
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
Or {value; _} ->
pp_bin_op "Or" buffer ~pad value
| And {value; _} ->
pp_bin_op "And" buffer ~pad value
| Not {value; _} ->
let _, pc as pad = mk_pad 1 0 pc in
pp_node buffer ~pad "Not";
Or {value; region} ->
pp_bin_op "Or" region buffer ~pad value
| And {value; region} ->
pp_bin_op "And" region buffer ~pad value
| Not {value; region} ->
pp_loc_node buffer ~pad "Not" region;
pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg
| False _ ->
pp_node buffer ~pad:(mk_pad 1 0 pc) "False"
| True _ ->
pp_node buffer ~pad:(mk_pad 1 0 pc) "True"
| False region ->
pp_loc_node buffer ~pad "False" region
| True region ->
pp_loc_node buffer ~pad "True" region
and pp_comp_expr buffer ~pad = function
Lt {value; _} ->
pp_bin_op "Lt" buffer ~pad value
| Leq {value; _} ->
pp_bin_op "Leq" buffer ~pad value
| Gt {value; _} ->
pp_bin_op "Gt" buffer ~pad value
| Geq {value; _} ->
pp_bin_op "Geq" buffer ~pad value
| Equal {value; _} ->
pp_bin_op "Equal" buffer ~pad value
| Neq {value; _} ->
pp_bin_op "Neq" buffer ~pad value
Lt {value; region} ->
pp_bin_op "Lt" region buffer ~pad value
| Leq {value; region} ->
pp_bin_op "Leq" region buffer ~pad value
| Gt {value; region} ->
pp_bin_op "Gt" region buffer ~pad value
| Geq {value; region} ->
pp_bin_op "Geq" region buffer ~pad value
| Equal {value; region} ->
pp_bin_op "Equal" region buffer ~pad value
| Neq {value; region} ->
pp_bin_op "Neq" region buffer ~pad value
and pp_constr_expr buffer ~pad:(_, pc as pad) = function
SomeApp {value=some_region,args; _} ->
let constr = {value="Some"; region=some_region} in
let app = constr, Some args in
pp_node buffer ~pad "SomeApp";
pp_constr_app buffer ~pad app
| NoneExpr _ ->
pp_node buffer ~pad "NoneExpr"
| ConstrApp {value; _} ->
pp_node buffer ~pad "ConstrApp";
NoneExpr region ->
pp_loc_node buffer ~pad "NoneExpr" region
| SomeApp {value=_,args; region} ->
pp_loc_node buffer ~pad "SomeApp" region;
pp_tuple_expr buffer ~pad args
| ConstrApp {value; region} ->
pp_loc_node buffer ~pad "ConstrApp" region;
pp_constr_app buffer ~pad:(mk_pad 1 0 pc) value
and pp_constr_app buffer ~pad (constr, args_opt) =
pp_ident buffer ~pad constr.value;
pp_ident buffer ~pad constr;
match args_opt with
None -> ()
| Some args -> pp_tuple_expr buffer ~pad args
and pp_map_expr buffer ~pad = function
MapLookUp {value; _} ->
pp_node buffer ~pad "MapLookUp";
MapLookUp {value; region} ->
pp_loc_node buffer ~pad "MapLookUp" region;
pp_map_lookup buffer ~pad value
| MapInj {value; _} | BigMapInj {value; _} ->
pp_node buffer ~pad "MapInj";
| MapInj {value; region} | BigMapInj {value; region} ->
pp_loc_node buffer ~pad "MapInj" region;
pp_injection pp_binding buffer ~pad 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
and pp_string_expr buffer ~pad:(_,pc as pad) = function
Cat {value; _} ->
pp_node buffer ~pad "Cat";
Cat {value; region} ->
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 1 pc) value.arg2;
| String {value; _} ->
| String s ->
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) =
pp_expr buffer ~pad:(mk_pad 2 0 pc) expr;
pp_type_expr buffer ~pad:(mk_pad 2 1 pc) t_expr
and pp_bin_op node buffer ~pad:(_,pc as pad) op =
pp_node buffer ~pad node;
and pp_bin_op node region buffer ~pad:(_,pc as pad) op =
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 1 pc) op.arg2

2
src/passes/1-parser/pascaligo/ParserLog.mli
View File

@ -13,4 +13,6 @@ val path_to_string : AST.path -> string
val pattern_to_string : AST.pattern -> string
val instruction_to_string : AST.instruction -> string
(* Pretty-printing of the AST *)
val pp_ast : Buffer.t -> AST.t -> unit

91
src/passes/1-parser/pascaligo/Tests/pp.ligo Normal file
View 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

58
src/passes/2-simplify/pascaligo.ml
View File

@ -57,17 +57,6 @@ module Errors = struct
] in
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 title () = "pattern is not a variable" in
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'
let return_statement expr = ok @@ fun expr'_opt ->
let expr = expr in
match expr'_opt with
| None -> ok @@ expr
| Some expr' -> ok @@ e_sequence expr expr'
let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
match t with
| TPar x -> simpl_type_expression x.value.inside
| TAlias v -> (
TPar x -> simpl_type_expression x.value.inside
| TVar v -> (
match List.assoc_opt v.value type_constants with
| Some s -> ok @@ T_constant (s , [])
| None -> ok @@ T_variable v.value
@ -222,12 +210,10 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
| TSum s ->
let aux (v:Raw.variant Raw.reg) =
let args =
match v.value.args with
match v.value.arg with
None -> []
| Some (_, t_expr) ->
match t_expr with
TProd product -> npseq_to_list product.value
| _ -> [t_expr] in
| Some (_, TProd product) -> npseq_to_list product.value
| Some (_, t_expr) -> [t_expr] in
let%bind te = simpl_list_type_expression @@ args in
ok (v.value.constr.value, te)
in
@ -303,7 +289,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
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 (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
return @@ e_record (List.fold_left aux SMap.empty fields)
| 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 =
let return x = ok x in
match t with
| Cons c ->
ECons c ->
simpl_binop "CONS" c
| List lst -> (
| EListComp lst ->
let (lst , loc) = r_split lst in
let%bind lst' =
bind_map_list simpl_expression @@
pseq_to_list lst.elements in
return @@ e_list ~loc lst'
)
| Nil reg -> (
| ENil reg ->
let loc = Location.lift reg in
return @@ e_list ~loc []
)
and simpl_set_expression (t:Raw.set_expr) : expression result =
match t with
@ -878,7 +862,7 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
ok (List.hd t') in
let get_toplevel (t : Raw.pattern) =
match t with
| PCons x -> (
| PList PCons x -> (
let (x' , lst) = x.value in
match lst with
| [] -> ok x'
@ -887,8 +871,8 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
| pattern -> ok pattern in
let get_constr (t: Raw.pattern) =
match t with
| PConstr v -> (
let (const , pat_opt) = v.value in
| PConstr (PConstrApp v) -> (
let const, pat_opt = v.value in
let%bind pat =
trace_option (unsupported_cst_constr t) @@
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
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
let%bind patterns =
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)
in bind_map_list aux t in
match patterns with
| [(PFalse _ , f) ; (PTrue _ , t)]
| [(PTrue _ , t) ; (PFalse _ , f)] ->
| [(PConstr PFalse _ , f) ; (PConstr PTrue _ , t)]
| [(PConstr PTrue _ , t) ; (PConstr PFalse _ , f)] ->
ok @@ Match_bool {match_true = t ; match_false = f}
| [(PSome v , some) ; (PNone _ , none)]
| [(PNone _ , none) ; (PSome v , some)] -> (
| [(PConstr PSomeApp v , some) ; (PConstr PNone _ , none)]
| [(PConstr PNone _ , none) ; (PConstr PSomeApp v , some)] -> (
let (_, v) = v.value in
let%bind v = match v.value.inside with
| PVar v -> ok v.value
| p -> fail @@ unsupported_deep_Some_patterns p in
ok @@ Match_option {match_none = none ; match_some = (v, some) }
)
| [(PCons c , cons) ; (PList (PNil _) , nil)]
| [(PList (PNil _) , nil) ; (PCons c, cons)] ->
| [(PList PCons c, cons) ; (PList (PNil _), nil)]
| [(PList (PNil _), nil) ; (PList PCons c, cons)] ->
let%bind (a, b) =
match c.value with
| a, [(_, b)] ->

1
src/passes/2-simplify/pascaligo.mli
View File

@ -9,7 +9,6 @@ module SMap = Map.String
module Errors :
sig
val bad_bytes : Location.t -> string -> unit -> error
val unsupported_arith_op : Raw.expr -> unit -> error
end

24
vendors/ligo-utils/simple-utils/region.ml vendored
View File

@ -90,24 +90,18 @@ let make ~(start: Pos.t) ~(stop: Pos.t) =
info start_offset stop#line horizontal stop_offset
method compact ?(file=true) ?(offsets=true) mode =
let start_line = start#line
and stop_line = stop#line in
let start_str = start#anonymous ~offsets mode
let prefix = if file then start#file ^ ":" else ""
and start_str = start#anonymous ~offsets mode
and stop_str = stop#anonymous ~offsets mode in
if start#file = stop#file then
if file then
sprintf "%s:%s-%s" start#file
start_str
(if start_line = stop_line
then stop#column mode |> string_of_int
else stop_str)
if start#line = stop#line then
sprintf "%s%s-%i" prefix start_str
(if offsets then stop#offset mode
else stop#column mode)
else
sprintf "%s-%s"
start_str
(if start_line = stop_line
then stop#column mode |> string_of_int
else stop_str)
else sprintf "%s:%s-%s:%s" start#file start_str stop#file stop_str
sprintf "%s%s-%s" prefix start_str stop_str
else sprintf "%s:%s-%s:%s"
start#file start_str stop#file stop_str
end
(* Special regions *)