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

Merge commit '45d18f7'

Browse Source
This commit is contained in:
Your Name 2019-03-05 11:15:02 +01:00
commit 61575e13ea
11 changed files with 373 additions and 279 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

136
AST.ml
View File

@ -37,6 +37,7 @@ let sepseq_to_region to_region = function
type kwd_begin = Region.t
type kwd_const = Region.t
type kwd_down = Region.t
type kwd_fail = Region.t
type kwd_if = Region.t
type kwd_in = Region.t
type kwd_is = Region.t
@ -138,6 +139,7 @@ type 'a braces = (lbrace * 'a * rbrace) reg
type t = {
types : type_decl list;
constants : const_decl reg list;
parameter : parameter_decl;
storage : storage_decl;
operations : operations_decl;
@ -186,47 +188,61 @@ and lambda_decl =
and fun_decl = {
kwd_function : kwd_function;
var : variable;
name : variable;
param : parameters;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
body : block reg;
local_decls : local_decl list;
block : block reg;
kwd_with : kwd_with;
return : expr
}
and proc_decl = {
kwd_procedure : kwd_procedure;
var : variable;
name : variable;
param : parameters;
kwd_is : kwd_is;
body : block reg
local_decls : local_decl list;
block : block reg
}
and parameters = (param_decl, semi) nsepseq par
and param_decl = (var_kind * variable * colon * type_expr) reg
and param_const = (kwd_const * variable * colon * type_expr) reg
and var_kind =
Mutable of kwd_var
| Const of kwd_const
and param_var = (kwd_var * variable * colon * type_expr) reg
and param_decl =
ParamConst of param_const
| ParamVar of param_var
and block = {
decls : value_decls;
opening : kwd_begin;
instr : instructions;
close : kwd_end
}
and value_decls = (var_decl reg, semi) sepseq reg
and local_decl =
LocalLam of lambda_decl
| LocalConst of const_decl reg
| LocalVar of var_decl reg
and var_decl = {
kind : var_kind;
var : variable;
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
vtype : type_expr;
setter : Region.t; (* "=" or ":=" *)
equal : equal;
init : expr
}
and var_decl = {
kwd_var : kwd_var;
name : variable;
colon : colon;
vtype : type_expr;
asgnmnt : asgnmnt;
init : expr
}
@ -243,6 +259,7 @@ and single_instr =
| Loop of loop
| ProcCall of fun_call
| Null of kwd_null
| Fail of (kwd_fail * expr) reg
and conditional = {
kwd_if : kwd_if;
@ -429,10 +446,6 @@ let expr_to_region = function
| MapLookUp {region; _}
| ParExpr {region; _} -> region
let var_kind_to_region = function
Mutable region
| Const region -> region
let instr_to_region = function
Single Cond {region;_}
| Single Match {region; _}
@ -442,6 +455,7 @@ let instr_to_region = function
| Single Loop For ForCollect {region; _}
| Single ProcCall {region; _}
| Single Null region
| Single Fail {region; _}
| Block {region; _} -> region
let core_pattern_to_region = function
@ -459,6 +473,12 @@ let core_pattern_to_region = function
| PList Raw {region; _}
| PTuple {region; _} -> region
let local_decl_to_region = function
LocalLam FunDecl {region; _}
| LocalLam ProcDecl {region; _}
| LocalConst {region; _}
| LocalVar {region; _} -> region
(* Printing the tokens with their source regions *)
type xyz = {
@ -470,6 +490,7 @@ type xyz = {
case : case -> unit;
cases : cases -> unit;
conditional : conditional -> unit;
const_decl : const_decl reg -> unit;
constr : constr -> unit;
constr_app : constr_app -> unit;
core_pattern : core_pattern -> unit;
@ -477,6 +498,7 @@ type xyz = {
empty_list : empty_list -> unit;
empty_set : empty_set -> unit;
expr : expr -> unit;
fail : (kwd_fail * expr) -> unit;
field_decl : field_decl -> unit;
field_decls : field_decls -> unit;
for_collect : for_collect reg -> unit;
@ -501,6 +523,8 @@ type xyz = {
param_decl : param_decl -> unit;
parameter_decl : (region * variable * region * type_expr) reg -> unit;
parameters : parameters -> unit;
param_const : param_const -> unit;
param_var : param_var -> unit;
pattern : pattern -> unit;
patterns : core_pattern par -> unit;
proc_decl : proc_decl reg -> unit;
@ -525,10 +549,10 @@ type xyz = {
type_decl : (region * variable * region * type_expr) reg -> unit;
type_expr : type_expr -> unit;
type_tuple : type_tuple -> unit;
value_decls : value_decls -> unit;
local_decl : local_decl -> unit;
local_decls : local_decl list -> unit;
var : variable -> unit;
var_decl : var_decl reg -> unit;
var_kind : var_kind -> unit;
variant : variant -> unit;
while_loop : while_loop -> unit
}
@ -664,21 +688,23 @@ and print_lambda_decl (visitor : xyz) = function
and print_fun_decl (visitor : xyz) {value=node; _} =
visitor.token node.kwd_function "function";
visitor.var node.var;
visitor.var node.name;
visitor.parameters node.param;
visitor.token node.colon ":";
visitor.type_expr node.ret_type;
visitor.token node.kwd_is "is";
visitor.block node.body;
visitor.local_decls node.local_decls;
visitor.block node.block;
visitor.token node.kwd_with "with";
visitor.expr node.return
and print_proc_decl (visitor : xyz) {value=node; _} =
visitor.token node.kwd_procedure "procedure";
visitor.var node.var;
visitor.var node.name;
visitor.parameters node.param;
visitor.token node.kwd_is "is";
visitor.block node.body
visitor.local_decls node.local_decls;
visitor.block node.block
and print_parameters (visitor : xyz) {value=node; _} =
let lpar, sequence, rpar = node in
@ -686,36 +712,51 @@ and print_parameters (visitor : xyz) {value=node; _} =
visitor.nsepseq ";" visitor.param_decl sequence;
visitor.token rpar ")"
and print_param_decl (visitor : xyz) {value=node; _} =
let var_kind, variable, colon, type_expr = node in
visitor.var_kind var_kind;
and print_param_decl (visitor : xyz) = function
ParamConst param_const -> visitor.param_const param_const
| ParamVar param_var -> visitor.param_var param_var
and print_param_const (visitor : xyz) {value=node; _} =
let kwd_const, variable, colon, type_expr = node in
visitor.token kwd_const "const";
visitor.var variable;
visitor.token colon ":";
visitor.type_expr type_expr
and print_var_kind (visitor : xyz) = function
Mutable kwd_var -> visitor.token kwd_var "var"
| Const kwd_const -> visitor.token kwd_const "const"
and print_param_var (visitor : xyz) {value=node; _} =
let kwd_var, variable, colon, type_expr = node in
visitor.token kwd_var "var";
visitor.var variable;
visitor.token colon ":";
visitor.type_expr type_expr
and print_block (visitor : xyz) {value=node; _} =
visitor.value_decls node.decls;
visitor.token node.opening "begin";
visitor.instructions node.instr;
visitor.token node.close "end"
and print_value_decls (visitor : xyz) {value=sequence; _} =
visitor.sepseq ";" visitor.var_decl sequence
and print_local_decls (visitor : xyz) sequence =
List.iter visitor.local_decl sequence
and print_var_decl (visitor : xyz) {value=node; _} =
let setter =
match node.kind with
Mutable _ -> ":="
| Const _ -> "=" in
visitor.var_kind node.kind;
visitor.var node.var;
and print_local_decl (visitor : xyz) = function
LocalLam decl -> visitor.lambda_decl decl
| LocalConst decl -> visitor.const_decl decl
| LocalVar decl -> visitor.var_decl decl
and print_const_decl (visitor : xyz) {value=node; _} =
visitor.token node.kwd_const "const";
visitor.var node.name;
visitor.token node.colon ":";
visitor.type_expr node.vtype;
visitor.token node.setter setter;
visitor.token node.equal "=";
visitor.expr node.init
and print_var_decl (visitor : xyz) {value=node; _} =
visitor.token node.kwd_var "var";
visitor.var node.name;
visitor.token node.colon ":";
visitor.type_expr node.vtype;
visitor.token node.asgnmnt ":=";
visitor.expr node.init
and print_instructions (visitor : xyz) {value=sequence; _} =
@ -732,6 +773,11 @@ and print_single_instr (visitor : xyz) = function
| Loop loop -> visitor.loop loop
| ProcCall fun_call -> visitor.fun_call fun_call
| Null kwd_null -> visitor.token kwd_null "null"
| Fail {value; _} -> visitor.fail value
and print_fail (visitor : xyz) (kwd_fail, expr) =
visitor.token kwd_fail "fail";
visitor.expr expr
and print_conditional (visitor : xyz) node =
visitor.token node.kwd_if "if";
@ -999,6 +1045,11 @@ let rec visitor () : xyz = {
bytes = print_bytes (visitor ());
int = print_int (visitor ());
local_decl = print_local_decl (visitor ());
fail = print_fail (visitor ());
param_var = print_param_var (visitor ());
param_const = print_param_const (visitor ());
const_decl = print_const_decl (visitor ());
parameter_decl = print_parameter_decl (visitor ());
storage_decl = print_storage_decl (visitor ());
operations_decl = print_operations_decl (visitor ());
@ -1018,9 +1069,8 @@ let rec visitor () : xyz = {
proc_decl = print_proc_decl (visitor ());
parameters = print_parameters (visitor ());
param_decl = print_param_decl (visitor ());
var_kind = print_var_kind (visitor ());
block = print_block (visitor ());
value_decls = print_value_decls (visitor ());
local_decls = print_local_decls (visitor ());
var_decl = print_var_decl (visitor ());
instructions = print_instructions (visitor ());
instruction = print_instruction (visitor ());

48
AST.mli
View File

@ -26,6 +26,7 @@ val sepseq_to_region : ('a -> Region.t) -> ('a,'sep) sepseq -> Region.t
type kwd_begin = Region.t
type kwd_const = Region.t
type kwd_down = Region.t
type kwd_fail = Region.t
type kwd_if = Region.t
type kwd_in = Region.t
type kwd_is = Region.t
@ -127,6 +128,7 @@ type 'a braces = (lbrace * 'a * rbrace) reg
type t = {
types : type_decl list;
constants : const_decl reg list;
parameter : parameter_decl;
storage : storage_decl;
operations : operations_decl;
@ -175,47 +177,58 @@ and lambda_decl =
and fun_decl = {
kwd_function : kwd_function;
var : variable;
name : variable;
param : parameters;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
body : block reg;
local_decls : local_decl list;
block : block reg;
kwd_with : kwd_with;
return : expr
}
and proc_decl = {
kwd_procedure : kwd_procedure;
var : variable;
name : variable;
param : parameters;
kwd_is : kwd_is;
body : block reg
local_decls : local_decl list;
block : block reg
}
and parameters = (param_decl, semi) nsepseq par
and param_decl = (var_kind * variable * colon * type_expr) reg
and var_kind =
Mutable of kwd_var
| Const of kwd_const
and param_decl =
ParamConst of (kwd_const * variable * colon * type_expr) reg
| ParamVar of (kwd_var * variable * colon * type_expr) reg
and block = {
decls : value_decls;
opening : kwd_begin;
instr : instructions;
close : kwd_end
}
and value_decls = (var_decl reg, semi) sepseq reg
and local_decl =
LocalLam of lambda_decl
| LocalConst of const_decl reg
| LocalVar of var_decl reg
and var_decl = {
kind : var_kind;
var : variable;
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
vtype : type_expr;
setter : Region.t; (* "=" or ":=" *)
equal : equal;
init : expr
}
and var_decl = {
kwd_var : kwd_var;
name : variable;
colon : colon;
vtype : type_expr;
asgnmnt : asgnmnt;
init : expr
}
@ -232,6 +245,7 @@ and single_instr =
| Loop of loop
| ProcCall of fun_call
| Null of kwd_null
| Fail of (kwd_fail * expr) reg
and conditional = {
kwd_if : kwd_if;
@ -375,12 +389,12 @@ val type_expr_to_region : type_expr -> Region.t
val expr_to_region : expr -> Region.t
val var_kind_to_region : var_kind -> Region.t
val instr_to_region : instruction -> Region.t
val core_pattern_to_region : core_pattern -> Region.t
val local_decl_to_region : local_decl -> Region.t
(* Printing *)
val print_tokens : t -> unit

14
EvalOpt.ml
View File

@ -20,10 +20,15 @@ let help () =
print_endline " -q, --quiet No output, except errors (default)";
print_endline " --columns Columns for source locations";
print_endline " --bytes Bytes for source locations";
print_endline " -v, --verbose=<stage> cmdline, parser";
print_endline " --verbose=<stages> cmdline, parser";
print_endline " --version Commit hash on stdout";
print_endline " -h, --help This help";
exit 0
(* Version *)
let version () = printf "%s\n" Version.version; exit 0
(* Specifying the command-line options a la GNU *)
let copy = ref false
@ -50,8 +55,9 @@ let specs =
'q', "quiet", set quiet true, None;
noshort, "columns", set columns true, None;
noshort, "bytes", set bytes true, None;
'v', "verbose", None, Some add_verbose;
'h', "help", Some help, None
noshort, "verbose", None, Some add_verbose;
'h', "help", Some help, None;
noshort, "version", Some version, None
]
;;
@ -115,7 +121,7 @@ let input =
then if Sys.file_exists file_path
then Some file_path
else abort "Source file not found."
else abort "Source file lacks the extension .ti."
else abort "Source file lacks the extension .li."
(* Exporting remaining options as non-mutable values *)

55
LexToken.mli
View File

@ -67,33 +67,34 @@ type t =
(* Keywords *)
| Begin of Region.t
| Const of Region.t
| Down of Region.t
| If of Region.t
| In of Region.t
| Is of Region.t
| For of Region.t
| Function of Region.t
| Parameter of Region.t
| Storage of Region.t
| Type of Region.t
| Of of Region.t
| Operations of Region.t
| Var of Region.t
| End of Region.t
| Then of Region.t
| Else of Region.t
| Match of Region.t
| Null of Region.t
| Procedure of Region.t
| Record of Region.t
| Step of Region.t
| To of Region.t
| Mod of Region.t
| Not of Region.t
| While of Region.t
| With of Region.t
| Begin of Region.t (* "begin" *)
| Const of Region.t (* "const" *)
| Down of Region.t (* "down" *)
| Fail of Region.t (* "fail" *)
| If of Region.t (* "if" *)
| In of Region.t (* "in" *)
| Is of Region.t (* "is" *)
| For of Region.t (* "for" *)
| Function of Region.t (* "function" *)
| Parameter of Region.t (* "parameter" *)
| Storage of Region.t (* "storage" *)
| Type of Region.t (* "type" *)
| Of of Region.t (* "of" *)
| Operations of Region.t (* "operations" *)
| Var of Region.t (* "var" *)
| End of Region.t (* "end" *)
| Then of Region.t (* "then" *)
| Else of Region.t (* "else" *)
| Match of Region.t (* "match" *)
| Null of Region.t (* "null" *)
| Procedure of Region.t (* "procedure" *)
| Record of Region.t (* "record" *)
| Step of Region.t (* "step" *)
| To of Region.t (* "to" *)
| Mod of Region.t (* "mod" *)
| Not of Region.t (* "not" *)
| While of Region.t (* "while" *)
| With of Region.t (* "with" *)
(* Data constructors *)

5
LexToken.mll
View File

@ -69,6 +69,7 @@ type t =
| Begin of Region.t
| Const of Region.t
| Down of Region.t
| Fail of Region.t
| If of Region.t
| In of Region.t
| Is of Region.t
@ -187,6 +188,7 @@ let proj_token = function
| Begin region -> region, "Begin"
| Const region -> region, "Const"
| Down region -> region, "Down"
| Fail region -> region, "Fail"
| If region -> region, "If"
| In region -> region, "In"
| Is region -> region, "Is"
@ -270,6 +272,7 @@ let to_lexeme = function
| Begin _ -> "begin"
| Const _ -> "const"
| Down _ -> "down"
| Fail _ -> "fail"
| If _ -> "if"
| In _ -> "in"
| Is _ -> "is"
@ -321,6 +324,7 @@ let keywords = [
(fun reg -> Begin reg);
(fun reg -> Const reg);
(fun reg -> Down reg);
(fun reg -> Fail reg);
(fun reg -> If reg);
(fun reg -> In reg);
(fun reg -> Is reg);
@ -544,6 +548,7 @@ let is_kwd = function
| Begin _
| Const _
| Down _
| Fail _
| If _
| In _
| Is _

20
Lexer.mll
View File

@ -166,14 +166,15 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
(* When scanning structured constructs, like strings and comments,
we need to keep the region of the opening symbol (like double
quote, "#" or "/*") in order to report any error more
quote, "#" or "(*") in order to report any error more
precisely. Since ocamllex is byte-oriented, we need to store
the parsed bytes are characters in an accumulator [acc] and
the parsed bytes as characters in an accumulator [acc] and
also its length [len], so, we are done, it is easy to build the
string making up the structured construct with [mk_str] (see
above).
The resulting data structure is called a _thread_.
(Note for Emacs: "*)".)
*)
type thread = {
@ -350,7 +351,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
Hint: Add or remove a digit.\n"
| Unterminated_comment ->
"Unterminated comment.\n\
Hint: Close with \"*/\".\n"
Hint: Close with \"*)\".\n"
| Orphan_minus ->
"Orphan minus sign.\n\
Hint: Remove the trailing space.\n"
@ -476,8 +477,8 @@ and scan state = parse
let thread = {opening; len=1; acc=['"']} in
scan_string thread state lexbuf |> mk_string |> enqueue }
| "/*" { let opening, _, state = sync state lexbuf in
let thread = {opening; len=2; acc=['*';'/']} in
| "(*" { let opening, _, state = sync state lexbuf in
let thread = {opening; len=2; acc=['*';'(']} in
let state = scan_block thread state lexbuf |> push_block
in scan state lexbuf }
@ -535,14 +536,15 @@ and scan_string thread state = parse
(* Finishing a block comment
(Note for Emacs: ("(*")
The lexing of block comments must take care of embedded block
comments that may occur within, as well as strings, so no substring
"*/" may inadvertantly close the block. This is the purpose of the
first case of the scanner [scan_block].
"*)" may inadvertently close the block. This is the purpose
of the first case of the scanner [scan_block].
*)
and scan_block thread state = parse
'"' | "/*" { let opening = thread.opening in
'"' | "(*" { let opening = thread.opening in
let opening', lexeme, state = sync state lexbuf in
let thread = push_string lexeme thread in
let thread = {thread with opening=opening'} in
@ -551,7 +553,7 @@ and scan_block thread state = parse
let thread, state = next thread state lexbuf in
let thread = {thread with opening}
in scan_block thread state lexbuf }
| "*/" { let _, lexeme, state = sync state lexbuf
| "*)" { let _, lexeme, state = sync state lexbuf
in push_string lexeme thread, state }
| nl as nl { let () = Lexing.new_line lexbuf
and state = {state with pos = state.pos#new_line nl}

121
ParToken.mly
View File

@ -13,72 +13,73 @@
(* Symbols *)
%token <Region.t> SEMI
%token <Region.t> COMMA
%token <Region.t> LPAR
%token <Region.t> RPAR
%token <Region.t> LBRACE
%token <Region.t> RBRACE
%token <Region.t> LBRACKET
%token <Region.t> RBRACKET
%token <Region.t> CONS
%token <Region.t> VBAR
%token <Region.t> ARROW
%token <Region.t> ASGNMNT
%token <Region.t> EQUAL
%token <Region.t> COLON
%token <Region.t> OR
%token <Region.t> AND
%token <Region.t> LT
%token <Region.t> LEQ
%token <Region.t> GT
%token <Region.t> GEQ
%token <Region.t> NEQ
%token <Region.t> PLUS
%token <Region.t> MINUS
%token <Region.t> SLASH
%token <Region.t> TIMES
%token <Region.t> DOT
%token <Region.t> WILD
%token <Region.t> CAT
%token <Region.t> SEMI (* ";" *)
%token <Region.t> COMMA (* "," *)
%token <Region.t> LPAR (* "(" *)
%token <Region.t> RPAR (* ")" *)
%token <Region.t> LBRACE (* "{" *)
%token <Region.t> RBRACE (* "}" *)
%token <Region.t> LBRACKET (* "[" *)
%token <Region.t> RBRACKET (* "]" *)
%token <Region.t> CONS (* "<:" *)
%token <Region.t> VBAR (* "|" *)
%token <Region.t> ARROW (* "->" *)
%token <Region.t> ASGNMNT (* ":=" *)
%token <Region.t> EQUAL (* "=" *)
%token <Region.t> COLON (* ":" *)
%token <Region.t> OR (* "||" *)
%token <Region.t> AND (* "&&" *)
%token <Region.t> LT (* "<" *)
%token <Region.t> LEQ (* "<=" *)
%token <Region.t> GT (* ">" *)
%token <Region.t> GEQ (* ">=" *)
%token <Region.t> NEQ (* "=/=" *)
%token <Region.t> PLUS (* "+" *)
%token <Region.t> MINUS (* "-" *)
%token <Region.t> SLASH (* "/" *)
%token <Region.t> TIMES (* "*" *)
%token <Region.t> DOT (* "." *)
%token <Region.t> WILD (* "_" *)
%token <Region.t> CAT (* "^" *)
(* Keywords *)
%token <Region.t> Begin
%token <Region.t> Const
%token <Region.t> Down
%token <Region.t> If
%token <Region.t> In
%token <Region.t> Is
%token <Region.t> For
%token <Region.t> Function
%token <Region.t> Parameter
%token <Region.t> Storage
%token <Region.t> Type
%token <Region.t> Of
%token <Region.t> Operations
%token <Region.t> Var
%token <Region.t> End
%token <Region.t> Then
%token <Region.t> Else
%token <Region.t> Match
%token <Region.t> Null
%token <Region.t> Procedure
%token <Region.t> Record
%token <Region.t> Step
%token <Region.t> To
%token <Region.t> Mod
%token <Region.t> Not
%token <Region.t> While
%token <Region.t> With
%token <Region.t> Begin (* "begin" *)
%token <Region.t> Const (* "const" *)
%token <Region.t> Down (* "down" *)
%token <Region.t> Fail (* "fail" *)
%token <Region.t> If (* "if" *)
%token <Region.t> In (* "in" *)
%token <Region.t> Is (* "is" *)
%token <Region.t> For (* "for" *)
%token <Region.t> Function (* "function" *)
%token <Region.t> Parameter (* "parameter" *)
%token <Region.t> Storage (* "storage" *)
%token <Region.t> Type (* "type" *)
%token <Region.t> Of (* "of" *)
%token <Region.t> Operations (* "operations" *)
%token <Region.t> Var (* "var" *)
%token <Region.t> End (* "end" *)
%token <Region.t> Then (* "then" *)
%token <Region.t> Else (* "else" *)
%token <Region.t> Match (* "match" *)
%token <Region.t> Null (* "null" *)
%token <Region.t> Procedure (* "procedure" *)
%token <Region.t> Record (* "record" *)
%token <Region.t> Step (* "step" *)
%token <Region.t> To (* "to" *)
%token <Region.t> Mod (* "mod" *)
%token <Region.t> Not (* "not" *)
%token <Region.t> While (* "while" *)
%token <Region.t> With (* "with" *)
(* Data constructors *)
%token <Region.t> C_False
%token <Region.t> C_None
%token <Region.t> C_Some
%token <Region.t> C_True
%token <Region.t> C_Unit
%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 *)

118
Parser.mly
View File

@ -7,6 +7,8 @@ open AST
(* END HEADER *)
%}
(* See [ParToken.mly] for the definition of tokens. *)
(* Entry points *)
%start program
@ -86,6 +88,7 @@ sepseq(X,Sep):
program:
seq(type_decl)
seq(const_decl)
parameter_decl
storage_decl
operations_decl
@ -94,12 +97,13 @@ program:
EOF {
{
types = $1;
parameter = $2;
storage = $3;
operations = $4;
lambdas = $5;
block = $6;
eof = $7;
constants = $2;
parameter = $3;
storage = $4;
operations = $5;
lambdas = $6;
block = $7;
eof = $8;
}
}
@ -173,7 +177,8 @@ variant:
record_type:
Record
nsepseq(field_decl,SEMI)
End {
End
{
let region = cover $1 $3
in {region; value = $1,$2,$3}
}
@ -193,35 +198,40 @@ lambda_decl:
fun_decl:
Function fun_name parameters COLON type_expr Is
seq(local_decl)
block
With expr {
let region = cover $1 (expr_to_region $9) in
let region = cover $1 (expr_to_region $10) in
let value =
{
kwd_function = $1;
var = $2;
name = $2;
param = $3;
colon = $4;
ret_type = $5;
kwd_is = $6;
body = $7;
kwd_with = $8;
return = $9;
local_decls = $7;
block = $8;
kwd_with = $9;
return = $10;
}
in {region; value}
}
proc_decl:
Procedure fun_name parameters Is
block {
let region = cover $1 $5.region in
seq(local_decl)
block
{
let region = cover $1 $6.region in
let value =
{
kwd_procedure = $1;
var = $2;
name = $2;
param = $3;
kwd_is = $4;
body = $5;
local_decls = $5;
block = $6;
}
in {region; value}
}
@ -230,62 +240,60 @@ parameters:
par(nsepseq(param_decl,SEMI)) { $1 }
param_decl:
var_kind var COLON type_expr {
let start = var_kind_to_region $1 in
Var var COLON type_expr {
let stop = type_expr_to_region $4 in
let region = cover start stop
in {region; value = $1,$2,$3,$4}
let region = cover $1 stop
in ParamVar {region; value = $1,$2,$3,$4}
}
| Const var COLON type_expr {
let stop = type_expr_to_region $4 in
let region = cover $1 stop
in ParamConst {region; value = $1,$2,$3,$4}
}
var_kind:
Var { Mutable $1 }
| Const { Const $1 }
block:
value_decls
Begin
instructions
End {
let region = cover $1.region $4 in
End
{
let region = cover $1 $3 in
let value =
{
decls = $1;
opening = $2;
instr = $3;
close = $4;
opening = $1;
instr = $2;
close = $3;
}
in {region; value}
}
value_decls:
sepseq(var_decl,SEMI) {
let region = sepseq_to_region (fun x -> x.region) $1
in {region; value=$1}
local_decl:
lambda_decl { LocalLam $1 }
| const_decl { LocalConst $1 }
| var_decl { LocalVar $1 }
const_decl:
Const var COLON type_expr EQUAL expr {
let region = cover $1 (expr_to_region $6) in
let value = {
kwd_const = $1;
name = $2;
colon = $3;
vtype = $4;
equal = $5;
init = $6;
}
in {region; value}
}
var_decl:
Var var COLON type_expr ASGNMNT expr {
let region = cover $1 (expr_to_region $6) in
let value =
{
kind = Mutable $1;
var = $2;
let value = {
kwd_var = $1;
name = $2;
colon = $3;
vtype = $4;
setter = $5;
init = $6;
}
in {region; value}
}
| Const var COLON type_expr EQUAL expr {
let region = cover $1 (expr_to_region $6) in
let value =
{
kind = Const $1;
var = $2;
colon = $3;
vtype = $4;
setter = $5;
asgnmnt = $5;
init = $6;
}
in {region; value}
@ -308,6 +316,10 @@ single_instr:
| loop { Loop $1 }
| proc_call { ProcCall $1 }
| Null { Null $1 }
| Fail expr {
let region = cover $1 (expr_to_region $2)
in Fail {region; value = $1,$2}
}
proc_call:
fun_call { $1 }

14
Tests/a.li
View File

@ -3,18 +3,19 @@ type u is t
type v is record foo: key; bar: mutez; baz: address end
type w is K of v * u
parameter p : v
parameter p : v # Line comment
storage w
operations u
function f (const x : int) : int is
var y : int := 5 - x;
(* Block comment *)
procedure g (const l : list (int)) is
function f (const x : int) : int is
var y : int := 5 - x
const z : int = 6
begin
y := x + y
end with y * 2
procedure g (const l : list (int)) is
begin
match l with
[] -> null
@ -23,5 +24,6 @@ procedure g (const l : list (int)) is
end
begin
g (Unit)
g (Unit) (*;
fail K (3, "foo")*)
end

1
Version.ml Normal file
View File

@ -0,0 +1 @@
let version = "629bb48b8f2d08187324e4ab0e649f4f784bb21b"

30
ligo-parser.opam
View File

@ -1,19 +1,19 @@
opam-version: "2.0"
version: "1.0"
maintainer: "gabriel.alfour@gmail.com"
authors: [ "Galfour" ]
homepage: "https://gitlab.com/gabriel.alfour/ligo-parser"
bug-reports: "https://gitlab.com/gabriel.alfour/ligo-parser/issues"
dev-repo: "git+https://gitlab.com/gabriel.alfour/ligo-parser.git"
license: "MIT"
depends: [
"dune"
"menhir"
"hex" "zarith" "getopt" "uutf"
]
build: [
opam-version : "2.0"
version : "1.0"
maintainer : "gabriel.alfour@gmail.com"
authors : [ "Galfour" ]
homepage : "https://gitlab.com/gabriel.alfour/ligo-parser"
bug-reports : "https://gitlab.com/gabriel.alfour/ligo-parser/issues"
dev-repo : "git+https://gitlab.com/gabriel.alfour/ligo-parser.git"
license : "MIT"
depends : [ "dune" "menhir" "hex" "zarith" "getopt" "uutf" ]
build : [
[ "sh" "-c" "printf 'let version = \"%s\"' \"$(git describe --always --dirty --abbrev=0)\" > Version.ml" ]
[ "dune" "build" "-p" name "-j" jobs ]
]
]
url {
src: "https://gitlab.com/gabriel.alfour/ligo-parser/-/archive/master/ligo-parser.tar.gz"
}