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

Small refactoring.

Browse Source
This commit is contained in:
Christian Rinderknecht 2019-03-07 12:24:57 +01:00
parent c0f541a803
commit ee8ff6ce41
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
3 changed files with 501 additions and 506 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

685
AST.ml
View File

@ -1,6 +1,11 @@
[@@@warning "-30"]
(* Abstract Syntax Tree (AST) for Ligo *) (* Abstract Syntax Tree (AST) for Ligo *)
(* To disable warning about multiply-defined record labels. *)
[@@@warning "-30-42"]
(* Utilities *)
open Utils open Utils
(* Regions (* Regions
@ -399,7 +404,7 @@ and list_pattern =
(* Projecting regions *) (* Projecting regions *)
open Region open! Region
let type_expr_to_region = function let type_expr_to_region = function
Prod node -> node.region Prod node -> node.region
@ -481,7 +486,7 @@ let local_decl_to_region = function
(* Printing the tokens with their source regions *) (* Printing the tokens with their source regions *)
type xyz = { type visitor = {
asgnmnt_instr : asgnmnt_instr -> unit; asgnmnt_instr : asgnmnt_instr -> unit;
bind_to : (region * variable) option -> unit; bind_to : (region * variable) option -> unit;
block : block reg -> unit; block : block reg -> unit;
@ -516,7 +521,7 @@ type xyz = {
map_lookup : map_lookup reg -> unit; map_lookup : map_lookup reg -> unit;
match_instr : match_instr -> unit; match_instr : match_instr -> unit;
none_expr : none_expr -> unit; none_expr : none_expr -> unit;
nsepseq : 'a. string -> ('a -> unit) -> 'a * (region * 'a) list -> unit; nsepseq : 'a.string -> ('a -> unit) -> ('a, region) nsepseq -> unit;
operations_decl : (region * type_expr) reg -> unit; operations_decl : (region * type_expr) reg -> unit;
par_expr : expr par -> unit; par_expr : expr par -> unit;
par_type : type_expr par -> unit; par_type : type_expr par -> unit;
@ -532,9 +537,7 @@ type xyz = {
ptuple : (core_pattern, region) nsepseq par -> unit; ptuple : (core_pattern, region) nsepseq par -> unit;
raw : (core_pattern * region * pattern) par -> unit; raw : (core_pattern * region * pattern) par -> unit;
record_type : record_type -> unit; record_type : record_type -> unit;
sepseq : 'a. sepseq : 'a.string -> ('a -> unit) -> ('a, region) sepseq -> unit;
string ->
('a -> unit) -> ('a * (region * 'a) list) option -> unit;
set : (expr, region) nsepseq braces -> unit; set : (expr, region) nsepseq braces -> unit;
single_instr : single_instr -> unit; single_instr : single_instr -> unit;
some_app : (region * arguments) reg -> unit; some_app : (region * arguments) reg -> unit;
@ -562,482 +565,486 @@ let printf = Printf.printf
let compact (region: Region.t) = let compact (region: Region.t) =
region#compact ~offsets:EvalOpt.offsets EvalOpt.mode region#compact ~offsets:EvalOpt.offsets EvalOpt.mode
let rec print_nsepseq : 'a . string -> ('a -> unit) -> ('a * (Region.t * 'a) list) -> unit = fun sep visit (head,tail) -> let print_nsepseq :
string -> ('a -> unit) -> ('a, Region.t) nsepseq -> unit =
fun sep visit (head, tail) ->
let print_aux (sep_reg, item) = let print_aux (sep_reg, item) =
printf "%s: %s\n" (compact sep_reg) sep; printf "%s: %s\n" (compact sep_reg) sep;
visit item visit item
in visit head; List.iter print_aux tail in visit head; List.iter print_aux tail
and print_sepseq : 'a . string -> ('a -> unit) -> ('a * (Region.t * 'a) list) option -> unit = fun sep visit -> function let print_sepseq :
string -> ('a -> unit) -> ('a, Region.t) sepseq -> unit =
fun sep visit -> function
None -> () None -> ()
| Some seq -> print_nsepseq sep visit seq | Some seq -> print_nsepseq sep visit seq
and print_token (_visitor : xyz) region lexeme = and print_token _visitor region lexeme =
printf "%s: %s\n"(compact region) lexeme printf "%s: %s\n"(compact region) lexeme
and print_var (_visitor : xyz) {region; value=lexeme} = and print_var _visitor {region; value=lexeme} =
printf "%s: Ident \"%s\"\n" (compact region) lexeme printf "%s: Ident \"%s\"\n" (compact region) lexeme
and print_constr (_visitor : xyz) {region; value=lexeme} = and print_constr _visitor {region; value=lexeme} =
printf "%s: Constr \"%s\"\n" printf "%s: Constr \"%s\"\n"
(compact region) lexeme (compact region) lexeme
and print_string (_visitor : xyz) {region; value=lexeme} = and print_string _visitor {region; value=lexeme} =
printf "%s: String \"%s\"\n" printf "%s: String \"%s\"\n"
(compact region) lexeme (compact region) lexeme
and print_bytes (_visitor : xyz) {region; value = lexeme, abstract} = and print_bytes _visitor {region; value = lexeme, abstract} =
printf "%s: Bytes (\"%s\", \"0x%s\")\n" printf "%s: Bytes (\"%s\", \"0x%s\")\n"
(compact region) lexeme (compact region) lexeme
(MBytes.to_hex abstract |> Hex.to_string) (MBytes.to_hex abstract |> Hex.to_string)
and print_int (_visitor : xyz) {region; value = lexeme, abstract} = and print_int _visitor {region; value = lexeme, abstract} =
printf "%s: Int (\"%s\", %s)\n" printf "%s: Int (\"%s\", %s)\n"
(compact region) lexeme (compact region) lexeme
(Z.to_string abstract) (Z.to_string abstract)
(* main print function *) (* main print function *)
and print_tokens (visitor : xyz) ast = and print_tokens (v: visitor) ast =
List.iter visitor.type_decl ast.types; List.iter v.type_decl ast.types;
visitor.parameter_decl ast.parameter; v.parameter_decl ast.parameter;
visitor.storage_decl ast.storage; v.storage_decl ast.storage;
visitor.operations_decl ast.operations; v.operations_decl ast.operations;
List.iter visitor.lambda_decl ast.lambdas; List.iter v.lambda_decl ast.lambdas;
visitor.block ast.block; v.block ast.block;
visitor.token ast.eof "EOF" v.token ast.eof "EOF"
and print_parameter_decl (visitor : xyz) {value=node; _} = and print_parameter_decl (v: visitor) {value=node; _} =
let kwd_parameter, variable, colon, type_expr = node in let kwd_parameter, variable, colon, type_expr = node in
visitor.token kwd_parameter "parameter"; v.token kwd_parameter "parameter";
visitor.var variable; v.var variable;
visitor.token colon ":"; v.token colon ":";
visitor.type_expr type_expr v.type_expr type_expr
and print_storage_decl (visitor : xyz) {value=node; _} = and print_storage_decl (v: visitor) {value=node; _} =
let kwd_storage, type_expr = node in let kwd_storage, type_expr = node in
visitor.token kwd_storage "storage"; v.token kwd_storage "storage";
visitor.type_expr type_expr v.type_expr type_expr
and print_operations_decl (visitor : xyz) {value=node; _} = and print_operations_decl (v: visitor) {value=node; _} =
let kwd_operations, type_expr = node in let kwd_operations, type_expr = node in
visitor.token kwd_operations "operations"; v.token kwd_operations "operations";
visitor.type_expr type_expr v.type_expr type_expr
and print_type_decl (visitor : xyz) {value=node; _} = and print_type_decl (v: visitor) {value=node; _} =
let kwd_type, type_name, kwd_is, type_expr = node in let kwd_type, type_name, kwd_is, type_expr = node in
visitor.token kwd_type "type"; v.token kwd_type "type";
visitor.var type_name; v.var type_name;
visitor.token kwd_is "is"; v.token kwd_is "is";
visitor.type_expr type_expr v.type_expr type_expr
and print_type_expr (visitor : xyz) = function and print_type_expr (v: visitor) = function
Prod cartesian -> visitor.cartesian cartesian Prod cartesian -> v.cartesian cartesian
| Sum sum_type -> visitor.sum_type sum_type | Sum sum_type -> v.sum_type sum_type
| Record record_type -> visitor.record_type record_type | Record record_type -> v.record_type record_type
| TypeApp type_app -> visitor.type_app type_app | TypeApp type_app -> v.type_app type_app
| ParType par_type -> visitor.par_type par_type | ParType par_type -> v.par_type par_type
| TAlias type_alias -> visitor.var type_alias | TAlias type_alias -> v.var type_alias
and print_cartesian (visitor : xyz) {value=sequence; _} = and print_cartesian (v: visitor) {value=sequence; _} =
visitor.nsepseq "*" visitor.type_expr sequence v.nsepseq "*" v.type_expr sequence
and print_variant (visitor : xyz) {value=node; _} = and print_variant (v: visitor) {value=node; _} =
let constr, kwd_of, cartesian = node in let constr, kwd_of, cartesian = node in
visitor.constr constr; v.constr constr;
visitor.token kwd_of "of"; v.token kwd_of "of";
visitor.cartesian cartesian v.cartesian cartesian
and print_sum_type (visitor : xyz) {value=sequence; _} = and print_sum_type (v: visitor) {value=sequence; _} =
visitor.nsepseq "|" visitor.variant sequence v.nsepseq "|" v.variant sequence
and print_record_type (visitor : xyz) {value=node; _} = and print_record_type (v: visitor) {value=node; _} =
let kwd_record, field_decls, kwd_end = node in let kwd_record, field_decls, kwd_end = node in
visitor.token kwd_record "record"; v.token kwd_record "record";
visitor.field_decls field_decls; v.field_decls field_decls;
visitor.token kwd_end "end" v.token kwd_end "end"
and print_type_app (visitor : xyz) {value=node; _} = and print_type_app (v: visitor) {value=node; _} =
let type_name, type_tuple = node in let type_name, type_tuple = node in
visitor.var type_name; v.var type_name;
visitor.type_tuple type_tuple v.type_tuple type_tuple
and print_par_type (visitor : xyz) {value=node; _} = and print_par_type (v: visitor) {value=node; _} =
let lpar, type_expr, rpar = node in let lpar, type_expr, rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.type_expr type_expr; v.type_expr type_expr;
visitor.token rpar ")" v.token rpar ")"
and print_field_decls (visitor : xyz) sequence = and print_field_decls (v: visitor) sequence =
visitor.nsepseq ";" visitor.field_decl sequence v.nsepseq ";" v.field_decl sequence
and print_field_decl (visitor : xyz) {value=node; _} = and print_field_decl (v: visitor) {value=node; _} =
let var, colon, type_expr = node in let var, colon, type_expr = node in
visitor.var var; v.var var;
visitor.token colon ":"; v.token colon ":";
visitor.type_expr type_expr v.type_expr type_expr
and print_type_tuple (visitor : xyz) {value=node; _} = and print_type_tuple (v: visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.nsepseq "," visitor.var sequence; v.nsepseq "," v.var sequence;
visitor.token rpar ")" v.token rpar ")"
and print_lambda_decl (visitor : xyz) = function and print_lambda_decl (v: visitor) = function
FunDecl fun_decl -> visitor.fun_decl fun_decl FunDecl fun_decl -> v.fun_decl fun_decl
| ProcDecl proc_decl -> visitor.proc_decl proc_decl | ProcDecl proc_decl -> v.proc_decl proc_decl
and print_fun_decl (visitor : xyz) {value=node; _} = and print_fun_decl (v: visitor) {value=node; _} =
visitor.token node.kwd_function "function"; v.token node.kwd_function "function";
visitor.var node.name; v.var node.name;
visitor.parameters node.param; v.parameters node.param;
visitor.token node.colon ":"; v.token node.colon ":";
visitor.type_expr node.ret_type; v.type_expr node.ret_type;
visitor.token node.kwd_is "is"; v.token node.kwd_is "is";
visitor.local_decls node.local_decls; v.local_decls node.local_decls;
visitor.block node.block; v.block node.block;
visitor.token node.kwd_with "with"; v.token node.kwd_with "with";
visitor.expr node.return v.expr node.return
and print_proc_decl (visitor : xyz) {value=node; _} = and print_proc_decl (v: visitor) {value=node; _} =
visitor.token node.kwd_procedure "procedure"; v.token node.kwd_procedure "procedure";
visitor.var node.name; v.var node.name;
visitor.parameters node.param; v.parameters node.param;
visitor.token node.kwd_is "is"; v.token node.kwd_is "is";
visitor.local_decls node.local_decls; v.local_decls node.local_decls;
visitor.block node.block v.block node.block
and print_parameters (visitor : xyz) {value=node; _} = and print_parameters (v: visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.nsepseq ";" visitor.param_decl sequence; v.nsepseq ";" v.param_decl sequence;
visitor.token rpar ")" v.token rpar ")"
and print_param_decl (visitor : xyz) = function and print_param_decl (v: visitor) = function
ParamConst param_const -> visitor.param_const param_const ParamConst param_const -> v.param_const param_const
| ParamVar param_var -> visitor.param_var param_var | ParamVar param_var -> v.param_var param_var
and print_param_const (visitor : xyz) {value=node; _} = and print_param_const (v: visitor) {value=node; _} =
let kwd_const, variable, colon, type_expr = node in let kwd_const, variable, colon, type_expr = node in
visitor.token kwd_const "const"; v.token kwd_const "const";
visitor.var variable; v.var variable;
visitor.token colon ":"; v.token colon ":";
visitor.type_expr type_expr v.type_expr type_expr
and print_param_var (visitor : xyz) {value=node; _} = and print_param_var (v: visitor) {value=node; _} =
let kwd_var, variable, colon, type_expr = node in let kwd_var, variable, colon, type_expr = node in
visitor.token kwd_var "var"; v.token kwd_var "var";
visitor.var variable; v.var variable;
visitor.token colon ":"; v.token colon ":";
visitor.type_expr type_expr v.type_expr type_expr
and print_block (visitor : xyz) {value=node; _} = and print_block (v: visitor) {value=node; _} =
visitor.token node.opening "begin"; v.token node.opening "begin";
visitor.instructions node.instr; v.instructions node.instr;
visitor.token node.close "end" v.token node.close "end"
and print_local_decls (visitor : xyz) sequence = and print_local_decls (v: visitor) sequence =
List.iter visitor.local_decl sequence List.iter v.local_decl sequence
and print_local_decl (visitor : xyz) = function and print_local_decl (v: visitor) = function
LocalLam decl -> visitor.lambda_decl decl LocalLam decl -> v.lambda_decl decl
| LocalConst decl -> visitor.const_decl decl | LocalConst decl -> v.const_decl decl
| LocalVar decl -> visitor.var_decl decl | LocalVar decl -> v.var_decl decl
and print_const_decl (visitor : xyz) {value=node; _} = and print_const_decl (v: visitor) {value=node; _} =
visitor.token node.kwd_const "const"; v.token node.kwd_const "const";
visitor.var node.name; v.var node.name;
visitor.token node.colon ":"; v.token node.colon ":";
visitor.type_expr node.vtype; v.type_expr node.vtype;
visitor.token node.equal "="; v.token node.equal "=";
visitor.expr node.init v.expr node.init
and print_var_decl (visitor : xyz) {value=node; _} = and print_var_decl (v: visitor) {value=node; _} =
visitor.token node.kwd_var "var"; v.token node.kwd_var "var";
visitor.var node.name; v.var node.name;
visitor.token node.colon ":"; v.token node.colon ":";
visitor.type_expr node.vtype; v.type_expr node.vtype;
visitor.token node.asgnmnt ":="; v.token node.asgnmnt ":=";
visitor.expr node.init v.expr node.init
and print_instructions (visitor : xyz) {value=sequence; _} = and print_instructions (v: visitor) {value=sequence; _} =
visitor.nsepseq ";" visitor.instruction sequence v.nsepseq ";" v.instruction sequence
and print_instruction (visitor : xyz) = function and print_instruction (v: visitor) = function
Single instr -> visitor.single_instr instr Single instr -> v.single_instr instr
| Block block -> visitor.block block | Block block -> v.block block
and print_single_instr (visitor : xyz) = function and print_single_instr (v: visitor) = function
Cond {value; _} -> visitor.conditional value Cond {value; _} -> v.conditional value
| Match {value; _} -> visitor.match_instr value | Match {value; _} -> v.match_instr value
| Asgnmnt instr -> visitor.asgnmnt_instr instr | Asgnmnt instr -> v.asgnmnt_instr instr
| Loop loop -> visitor.loop loop | Loop loop -> v.loop loop
| ProcCall fun_call -> visitor.fun_call fun_call | ProcCall fun_call -> v.fun_call fun_call
| Null kwd_null -> visitor.token kwd_null "null" | Null kwd_null -> v.token kwd_null "null"
| Fail {value; _} -> visitor.fail value | Fail {value; _} -> v.fail value
and print_fail (visitor : xyz) (kwd_fail, expr) = and print_fail (v: visitor) (kwd_fail, expr) =
visitor.token kwd_fail "fail"; v.token kwd_fail "fail";
visitor.expr expr v.expr expr
and print_conditional (visitor : xyz) node = and print_conditional (v: visitor) node =
visitor.token node.kwd_if "if"; v.token node.kwd_if "if";
visitor.expr node.test; v.expr node.test;
visitor.token node.kwd_then "then"; v.token node.kwd_then "then";
visitor.instruction node.ifso; v.instruction node.ifso;
visitor.token node.kwd_else "else"; v.token node.kwd_else "else";
visitor.instruction node.ifnot v.instruction node.ifnot
and print_match_instr (visitor : xyz) node = and print_match_instr (v: visitor) node =
visitor.token node.kwd_match "match"; v.token node.kwd_match "match";
visitor.expr node.expr; v.expr node.expr;
visitor.token node.kwd_with "with"; v.token node.kwd_with "with";
visitor.cases node.cases; v.cases node.cases;
visitor.token node.kwd_end "end" v.token node.kwd_end "end"
and print_cases (visitor : xyz) {value=sequence; _} = and print_cases (v: visitor) {value=sequence; _} =
visitor.nsepseq "|" visitor.case sequence v.nsepseq "|" v.case sequence
and print_case (visitor : xyz) {value=node; _} = and print_case (v: visitor) {value=node; _} =
let pattern, arrow, instruction = node in let pattern, arrow, instruction = node in
visitor.pattern pattern; v.pattern pattern;
visitor.token arrow "->"; v.token arrow "->";
visitor.instruction instruction v.instruction instruction
and print_asgnmnt_instr (visitor : xyz) {value=node; _} = and print_asgnmnt_instr (v: visitor) {value=node; _} =
let variable, asgnmnt, expr = node in let variable, asgnmnt, expr = node in
visitor.var variable; v.var variable;
visitor.token asgnmnt ":="; v.token asgnmnt ":=";
visitor.expr expr v.expr expr
and print_loop (visitor : xyz) = function and print_loop (v: visitor) = function
While while_loop -> visitor.while_loop while_loop While while_loop -> v.while_loop while_loop
| For for_loop -> visitor.for_loop for_loop | For for_loop -> v.for_loop for_loop
and print_while_loop (visitor : xyz) {value=node; _} = and print_while_loop (v: visitor) {value=node; _} =
let kwd_while, expr, block = node in let kwd_while, expr, block = node in
visitor.token kwd_while "while"; v.token kwd_while "while";
visitor.expr expr; v.expr expr;
visitor.block block v.block block
and print_for_loop (visitor : xyz) = function and print_for_loop (v: visitor) = function
ForInt for_int -> visitor.for_int for_int ForInt for_int -> v.for_int for_int
| ForCollect for_collect -> visitor.for_collect for_collect | ForCollect for_collect -> v.for_collect for_collect
and print_for_int (visitor : xyz) ({value=node; _} : for_int reg) = and print_for_int (v: visitor) ({value=node; _} : for_int reg) =
visitor.token node.kwd_for "for"; v.token node.kwd_for "for";
visitor.asgnmnt_instr node.asgnmnt; v.asgnmnt_instr node.asgnmnt;
visitor.down node.down; v.down node.down;
visitor.token node.kwd_to "to"; v.token node.kwd_to "to";
visitor.expr node.bound; v.expr node.bound;
visitor.step node.step; v.step node.step;
visitor.block node.block v.block node.block
and print_down (visitor : xyz) = function and print_down (v: visitor) = function
Some kwd_down -> visitor.token kwd_down "down" Some kwd_down -> v.token kwd_down "down"
| None -> () | None -> ()
and print_step (visitor : xyz) = function and print_step (v: visitor) = function
Some (kwd_step, expr) -> Some (kwd_step, expr) ->
visitor.token kwd_step "step"; v.token kwd_step "step";
visitor.expr expr v.expr expr
| None -> () | None -> ()
and print_for_collect (visitor : xyz) ({value=node; _} : for_collect reg) = and print_for_collect (v: visitor) ({value=node; _} : for_collect reg) =
visitor.token node.kwd_for "for"; v.token node.kwd_for "for";
visitor.var node.var; v.var node.var;
visitor.bind_to node.bind_to; v.bind_to node.bind_to;
visitor.token node.kwd_in "in"; v.token node.kwd_in "in";
visitor.expr node.expr; v.expr node.expr;
visitor.block node.block v.block node.block
and print_bind_to (visitor : xyz) = function and print_bind_to (v: visitor) = function
Some (arrow, variable) -> Some (arrow, variable) ->
visitor.token arrow "->"; v.token arrow "->";
visitor.var variable v.var variable
| None -> () | None -> ()
and print_expr (visitor : xyz) = function and print_expr (v: visitor) = function
Or {value = expr1, bool_or, expr2; _} -> Or {value = expr1, bool_or, expr2; _} ->
visitor.expr expr1; visitor.token bool_or "||"; visitor.expr expr2 v.expr expr1; v.token bool_or "||"; v.expr expr2
| And {value = expr1, bool_and, expr2; _} -> | And {value = expr1, bool_and, expr2; _} ->
visitor.expr expr1; visitor.token bool_and "&&"; visitor.expr expr2 v.expr expr1; v.token bool_and "&&"; v.expr expr2
| Lt {value = expr1, lt, expr2; _} -> | Lt {value = expr1, lt, expr2; _} ->
visitor.expr expr1; visitor.token lt "<"; visitor.expr expr2 v.expr expr1; v.token lt "<"; v.expr expr2
| Leq {value = expr1, leq, expr2; _} -> | Leq {value = expr1, leq, expr2; _} ->
visitor.expr expr1; visitor.token leq "<="; visitor.expr expr2 v.expr expr1; v.token leq "<="; v.expr expr2
| Gt {value = expr1, gt, expr2; _} -> | Gt {value = expr1, gt, expr2; _} ->
visitor.expr expr1; visitor.token gt ">"; visitor.expr expr2 v.expr expr1; v.token gt ">"; v.expr expr2
| Geq {value = expr1, geq, expr2; _} -> | Geq {value = expr1, geq, expr2; _} ->
visitor.expr expr1; visitor.token geq ">="; visitor.expr expr2 v.expr expr1; v.token geq ">="; v.expr expr2
| Equal {value = expr1, equal, expr2; _} -> | Equal {value = expr1, equal, expr2; _} ->
visitor.expr expr1; visitor.token equal "="; visitor.expr expr2 v.expr expr1; v.token equal "="; v.expr expr2
| Neq {value = expr1, neq, expr2; _} -> | Neq {value = expr1, neq, expr2; _} ->
visitor.expr expr1; visitor.token neq "=/="; visitor.expr expr2 v.expr expr1; v.token neq "=/="; v.expr expr2
| Cat {value = expr1, cat, expr2; _} -> | Cat {value = expr1, cat, expr2; _} ->
visitor.expr expr1; visitor.token cat "^"; visitor.expr expr2 v.expr expr1; v.token cat "^"; v.expr expr2
| Cons {value = expr1, cons, expr2; _} -> | Cons {value = expr1, cons, expr2; _} ->
visitor.expr expr1; visitor.token cons "<:"; visitor.expr expr2 v.expr expr1; v.token cons "<:"; v.expr expr2
| Add {value = expr1, add, expr2; _} -> | Add {value = expr1, add, expr2; _} ->
visitor.expr expr1; visitor.token add "+"; visitor.expr expr2 v.expr expr1; v.token add "+"; v.expr expr2
| Sub {value = expr1, sub, expr2; _} -> | Sub {value = expr1, sub, expr2; _} ->
visitor.expr expr1; visitor.token sub "-"; visitor.expr expr2 v.expr expr1; v.token sub "-"; v.expr expr2
| Mult {value = expr1, mult, expr2; _} -> | Mult {value = expr1, mult, expr2; _} ->
visitor.expr expr1; visitor.token mult "*"; visitor.expr expr2 v.expr expr1; v.token mult "*"; v.expr expr2
| Div {value = expr1, div, expr2; _} -> | Div {value = expr1, div, expr2; _} ->
visitor.expr expr1; visitor.token div "/"; visitor.expr expr2 v.expr expr1; v.token div "/"; v.expr expr2
| Mod {value = expr1, kwd_mod, expr2; _} -> | Mod {value = expr1, kwd_mod, expr2; _} ->
visitor.expr expr1; visitor.token kwd_mod "mod"; visitor.expr expr2 v.expr expr1; v.token kwd_mod "mod"; v.expr expr2
| Neg {value = minus, expr; _} -> | Neg {value = minus, expr; _} ->
visitor.token minus "-"; visitor.expr expr v.token minus "-"; v.expr expr
| Not {value = kwd_not, expr; _} -> | Not {value = kwd_not, expr; _} ->
visitor.token kwd_not "not"; visitor.expr expr v.token kwd_not "not"; v.expr expr
| Int i -> visitor.int i | Int i -> v.int i
| Var v -> visitor.var v | Var var -> v.var var
| String s -> visitor.string s | String s -> v.string s
| Bytes b -> visitor.bytes b | Bytes b -> v.bytes b
| False region -> visitor.token region "False" | False region -> v.token region "False"
| True region -> visitor.token region "True" | True region -> v.token region "True"
| Unit region -> visitor.token region "Unit" | Unit region -> v.token region "Unit"
| Tuple tuple -> visitor.tuple tuple | Tuple tuple -> v.tuple tuple
| List list -> visitor.list list | List list -> v.list list
| EmptyList elist -> visitor.empty_list elist | EmptyList elist -> v.empty_list elist
| Set set -> visitor.set set | Set set -> v.set set
| EmptySet eset -> visitor.empty_set eset | EmptySet eset -> v.empty_set eset
| NoneExpr nexpr -> visitor.none_expr nexpr | NoneExpr nexpr -> v.none_expr nexpr
| FunCall fun_call -> visitor.fun_call fun_call | FunCall fun_call -> v.fun_call fun_call
| ConstrApp capp -> visitor.constr_app capp | ConstrApp capp -> v.constr_app capp
| SomeApp sapp -> visitor.some_app sapp | SomeApp sapp -> v.some_app sapp
| MapLookUp lookup -> visitor.map_lookup lookup | MapLookUp lookup -> v.map_lookup lookup
| ParExpr pexpr -> visitor.par_expr pexpr | ParExpr pexpr -> v.par_expr pexpr
and print_tuple (visitor : xyz) {value=node; _} = and print_tuple (v: visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.nsepseq "," visitor.expr sequence; v.nsepseq "," v.expr sequence;
visitor.token rpar ")" v.token rpar ")"
and print_list (visitor : xyz) {value=node; _} = and print_list (v: visitor) {value=node; _} =
let lbra, sequence, rbra = node in let lbra, sequence, rbra = node in
visitor.token lbra "["; v.token lbra "[";
visitor.nsepseq "," visitor.expr sequence; v.nsepseq "," v.expr sequence;
visitor.token rbra "]" v.token rbra "]"
and print_empty_list (visitor : xyz) {value=node; _} = and print_empty_list (v: visitor) {value=node; _} =
let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.token lbracket "["; v.token lbracket "[";
visitor.token rbracket "]"; v.token rbracket "]";
visitor.token colon ":"; v.token colon ":";
visitor.type_expr type_expr; v.type_expr type_expr;
visitor.token rpar ")" v.token rpar ")"
and print_set (visitor : xyz) {value=node; _} = and print_set (v: visitor) {value=node; _} =
let lbrace, sequence, rbrace = node in let lbrace, sequence, rbrace = node in
visitor.token lbrace "{"; v.token lbrace "{";
visitor.nsepseq "," visitor.expr sequence; v.nsepseq "," v.expr sequence;
visitor.token rbrace "}" v.token rbrace "}"
and print_empty_set (visitor : xyz) {value=node; _} = and print_empty_set (v: visitor) {value=node; _} =
let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.token lbrace "{"; v.token lbrace "{";
visitor.token rbrace "}"; v.token rbrace "}";
visitor.token colon ":"; v.token colon ":";
visitor.type_expr type_expr; v.type_expr type_expr;
visitor.token rpar ")" v.token rpar ")"
and print_none_expr (visitor : xyz) {value=node; _} = and print_none_expr (v: visitor) {value=node; _} =
let lpar, (c_None, colon, type_expr), rpar = node in let lpar, (c_None, colon, type_expr), rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.token c_None "None"; v.token c_None "None";
visitor.token colon ":"; v.token colon ":";
visitor.type_expr type_expr; v.type_expr type_expr;
visitor.token rpar ")" v.token rpar ")"
and print_fun_call (visitor : xyz) {value=node; _} = and print_fun_call (v: visitor) {value=node; _} =
let fun_name, arguments = node in let fun_name, arguments = node in
visitor.var fun_name; v.var fun_name;
visitor.tuple arguments v.tuple arguments
and print_constr_app (visitor : xyz) {value=node; _} = and print_constr_app (v: visitor) {value=node; _} =
let constr, arguments = node in let constr, arguments = node in
visitor.constr constr; v.constr constr;
visitor.tuple arguments v.tuple arguments
and print_some_app (visitor : xyz) {value=node; _} = and print_some_app (v: visitor) {value=node; _} =
let c_Some, arguments = node in let c_Some, arguments = node in
visitor.token c_Some "Some"; v.token c_Some "Some";
visitor.tuple arguments v.tuple arguments
and print_map_lookup (visitor : xyz) {value=node; _} = and print_map_lookup (v: visitor) {value=node; _} =
let {value = lbracket, expr, rbracket; _} = node.index in let {value = lbracket, expr, rbracket; _} = node.index in
visitor.var node.map_name; v.var node.map_name;
visitor.token node.selector "."; v.token node.selector ".";
visitor.token lbracket "["; v.token lbracket "[";
visitor.expr expr; v.expr expr;
visitor.token rbracket "]" v.token rbracket "]"
and print_par_expr (visitor : xyz) {value=node; _} = and print_par_expr (v: visitor) {value=node; _} =
let lpar, expr, rpar = node in let lpar, expr, rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.expr expr; v.expr expr;
visitor.token rpar ")" v.token rpar ")"
and print_pattern (visitor : xyz) {value=sequence; _} = and print_pattern (v: visitor) {value=sequence; _} =
visitor.nsepseq "<:" visitor.core_pattern sequence v.nsepseq "<:" v.core_pattern sequence
and print_core_pattern (visitor : xyz) = function and print_core_pattern (v: visitor) = function
PVar var -> visitor.var var PVar var -> v.var var
| PWild wild -> visitor.token wild "_" | PWild wild -> v.token wild "_"
| PInt i -> visitor.int i | PInt i -> v.int i
| PBytes b -> visitor.bytes b | PBytes b -> v.bytes b
| PString s -> visitor.string s | PString s -> v.string s
| PUnit region -> visitor.token region "Unit" | PUnit region -> v.token region "Unit"
| PFalse region -> visitor.token region "False" | PFalse region -> v.token region "False"
| PTrue region -> visitor.token region "True" | PTrue region -> v.token region "True"
| PNone region -> visitor.token region "None" | PNone region -> v.token region "None"
| PSome psome -> visitor.psome psome | PSome psome -> v.psome psome
| PList pattern -> visitor.list_pattern pattern | PList pattern -> v.list_pattern pattern
| PTuple ptuple -> visitor.ptuple ptuple | PTuple ptuple -> v.ptuple ptuple
and print_psome (visitor : xyz) {value=node; _} = and print_psome (v: visitor) {value=node; _} =
let c_Some, patterns = node in let c_Some, patterns = node in
visitor.token c_Some "Some"; v.token c_Some "Some";
visitor.patterns patterns v.patterns patterns
and print_patterns (visitor : xyz) {value=node; _} = and print_patterns (v: visitor) {value=node; _} =
let lpar, core_pattern, rpar = node in let lpar, core_pattern, rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.core_pattern core_pattern; v.core_pattern core_pattern;
visitor.token rpar ")" v.token rpar ")"
and print_list_pattern (visitor : xyz) = function and print_list_pattern (v: visitor) = function
Sugar sugar -> visitor.sugar sugar Sugar sugar -> v.sugar sugar
| Raw raw -> visitor.raw raw | Raw raw -> v.raw raw
and print_sugar (visitor : xyz) {value=node; _} = and print_sugar (v: visitor) {value=node; _} =
let lbracket, sequence, rbracket = node in let lbracket, sequence, rbracket = node in
visitor.token lbracket "["; v.token lbracket "[";
visitor.sepseq "," visitor.core_pattern sequence; v.sepseq "," v.core_pattern sequence;
visitor.token rbracket "]" v.token rbracket "]"
and print_raw (visitor : xyz) {value=node; _} = and print_raw (v: visitor) {value=node; _} =
let lpar, (core_pattern, cons, pattern), rpar = node in let lpar, (core_pattern, cons, pattern), rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.core_pattern core_pattern; v.core_pattern core_pattern;
visitor.token cons "<:"; v.token cons "<:";
visitor.pattern pattern; v.pattern pattern;
visitor.token rpar ")" v.token rpar ")"
and print_ptuple (visitor : xyz) {value=node; _} = and print_ptuple (v: visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
visitor.token lpar "("; v.token lpar "(";
visitor.nsepseq "," visitor.core_pattern sequence; v.nsepseq "," v.core_pattern sequence;
visitor.token rpar ")" v.token rpar ")"
let rec visitor () : xyz = { let rec visitor () : visitor = {
nsepseq = print_nsepseq; (* : 'a . string -> ('a -> unit) -> ('a * (Region.t * 'a) list) -> unit *) nsepseq = print_nsepseq;
sepseq = print_sepseq; (* : 'a . string -> ('a -> unit) -> ('a * (Region.t * 'a) list) option -> unit *) sepseq = print_sepseq;
token = print_token (visitor ()); token = print_token (visitor ());
var = print_var (visitor ()); var = print_var (visitor ());
constr = print_constr (visitor ()); constr = print_constr (visitor ());

2
Parser.mly
View File

@ -1,6 +1,8 @@
%{ %{
(* START HEADER *) (* START HEADER *)
[@@@warning "-42"]
open Region open Region
open AST open AST

28
dune
View File

@ -4,24 +4,14 @@
(menhir (menhir
(merge_into Parser) (merge_into Parser)
(modules ParToken Parser) (modules ParToken Parser)
(flags -la 1 --explain --external-tokens LexToken) (flags -la 1 --explain --external-tokens LexToken))
)
(executables (executables
(names LexerMain ParserMain) (names LexerMain ParserMain)
(public_names ligo-lexer ligo-parser) (public_names ligo-lexer ligo-parser)
(package ligo-parser) (package ligo-parser)
(modules_without_implementation (modules_without_implementation Error)
Error (libraries getopt hex str uutf zarith))
)
(libraries
hex
zarith
getopt
uutf
str
)
)
;; Les deux directives (rule) qui suivent sont pour le dev local. ;; Les deux directives (rule) qui suivent sont pour le dev local.
;; Il suffit de faire "dune build Parser.exe" pour avoir un Parser.exe dans le dossier. ;; Il suffit de faire "dune build Parser.exe" pour avoir un Parser.exe dans le dossier.
@ -30,15 +20,13 @@
(targets Parser.exe) (targets Parser.exe)
(deps ParserMain.exe) (deps ParserMain.exe)
(action (copy ParserMain.exe Parser.exe)) (action (copy ParserMain.exe Parser.exe))
(mode promote-until-clean) (mode promote-until-clean))
)
(rule (rule
(targets Lexer.exe) (targets Lexer.exe)
(deps LexerMain.exe) (deps LexerMain.exe)
(action (copy LexerMain.exe Lexer.exe)) (action (copy LexerMain.exe Lexer.exe))
(mode promote-until-clean) (mode promote-until-clean))
)
(rule (rule
(targets .git_main_dir) (targets .git_main_dir)
@ -60,12 +48,10 @@
(targets Version.gitHEAD) (targets Version.gitHEAD)
(deps .gitHEAD) (deps .gitHEAD)
;; TODO: re-compute .git_main_dir, just in case (since it does not have a dependency on .git) ;; TODO: re-compute .git_main_dir, just in case (since it does not have a dependency on .git)
(action (run "sh" "-c" "if git symbolic-ref HEAD >/dev/null 2>&1; then ln -s \"$(cat .git_main_dir)/$(git symbolic-ref HEAD)\" Version.gitHEAD; else ln -s \"$(cat .git_worktree_dir)/HEAD\" Version.gitHEAD; fi")) (action (run "sh" "-c" "if git symbolic-ref HEAD >/dev/null 2>&1; then ln -s \"$(cat .git_main_dir)/$(git symbolic-ref HEAD)\" Version.gitHEAD; else ln -s \"$(cat .git_worktree_dir)/HEAD\" Version.gitHEAD; fi")))
)
(rule (rule
(targets Version.ml) (targets Version.ml)
(deps Version.gitHEAD) (deps Version.gitHEAD)
(action (run "sh" "-c" "printf 'let version = \"%s\"'\\\\n \"$(cat Version.gitHEAD)\" > Version.ml")) (action (run "sh" "-c" "printf 'let version = \"%s\"'\\\\n \"$(cat Version.gitHEAD)\" > Version.ml"))
(mode promote-until-clean) (mode promote-until-clean))
)