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_begin = Region.t
type kwd_const = Region.t type kwd_const = Region.t
type kwd_down = Region.t type kwd_down = Region.t
type kwd_fail = Region.t
type kwd_if = Region.t type kwd_if = Region.t
type kwd_in = Region.t type kwd_in = Region.t
type kwd_is = Region.t type kwd_is = Region.t
@ -138,6 +139,7 @@ type 'a braces = (lbrace * 'a * rbrace) reg
type t = { type t = {
types : type_decl list; types : type_decl list;
constants : const_decl reg list;
parameter : parameter_decl; parameter : parameter_decl;
storage : storage_decl; storage : storage_decl;
operations : operations_decl; operations : operations_decl;
@ -186,47 +188,61 @@ and lambda_decl =
and fun_decl = { and fun_decl = {
kwd_function : kwd_function; kwd_function : kwd_function;
var : variable; name : variable;
param : parameters; param : parameters;
colon : colon; colon : colon;
ret_type : type_expr; ret_type : type_expr;
kwd_is : kwd_is; kwd_is : kwd_is;
body : block reg; local_decls : local_decl list;
block : block reg;
kwd_with : kwd_with; kwd_with : kwd_with;
return : expr return : expr
} }
and proc_decl = { and proc_decl = {
kwd_procedure : kwd_procedure; kwd_procedure : kwd_procedure;
var : variable; name : variable;
param : parameters; param : parameters;
kwd_is : kwd_is; kwd_is : kwd_is;
body : block reg local_decls : local_decl list;
block : block reg
} }
and parameters = (param_decl, semi) nsepseq par 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 = and param_var = (kwd_var * variable * colon * type_expr) reg
Mutable of kwd_var
| Const of kwd_const and param_decl =
ParamConst of param_const
| ParamVar of param_var
and block = { and block = {
decls : value_decls;
opening : kwd_begin; opening : kwd_begin;
instr : instructions; instr : instructions;
close : kwd_end 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 = { and const_decl = {
kind : var_kind; kwd_const : kwd_const;
var : variable; name : variable;
colon : colon; colon : colon;
vtype : type_expr; 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 init : expr
} }
@ -243,6 +259,7 @@ and single_instr =
| Loop of loop | Loop of loop
| ProcCall of fun_call | ProcCall of fun_call
| Null of kwd_null | Null of kwd_null
| Fail of (kwd_fail * expr) reg
and conditional = { and conditional = {
kwd_if : kwd_if; kwd_if : kwd_if;
@ -429,10 +446,6 @@ let expr_to_region = function
| MapLookUp {region; _} | MapLookUp {region; _}
| ParExpr {region; _} -> region | ParExpr {region; _} -> region
let var_kind_to_region = function
Mutable region
| Const region -> region
let instr_to_region = function let instr_to_region = function
Single Cond {region;_} Single Cond {region;_}
| Single Match {region; _} | Single Match {region; _}
@ -442,6 +455,7 @@ let instr_to_region = function
| Single Loop For ForCollect {region; _} | Single Loop For ForCollect {region; _}
| Single ProcCall {region; _} | Single ProcCall {region; _}
| Single Null region | Single Null region
| Single Fail {region; _}
| Block {region; _} -> region | Block {region; _} -> region
let core_pattern_to_region = function let core_pattern_to_region = function
@ -459,6 +473,12 @@ let core_pattern_to_region = function
| PList Raw {region; _} | PList Raw {region; _}
| PTuple {region; _} -> 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 *) (* Printing the tokens with their source regions *)
type xyz = { type xyz = {
@ -470,6 +490,7 @@ type xyz = {
case : case -> unit; case : case -> unit;
cases : cases -> unit; cases : cases -> unit;
conditional : conditional -> unit; conditional : conditional -> unit;
const_decl : const_decl reg -> unit;
constr : constr -> unit; constr : constr -> unit;
constr_app : constr_app -> unit; constr_app : constr_app -> unit;
core_pattern : core_pattern -> unit; core_pattern : core_pattern -> unit;
@ -477,6 +498,7 @@ type xyz = {
empty_list : empty_list -> unit; empty_list : empty_list -> unit;
empty_set : empty_set -> unit; empty_set : empty_set -> unit;
expr : expr -> unit; expr : expr -> unit;
fail : (kwd_fail * expr) -> unit;
field_decl : field_decl -> unit; field_decl : field_decl -> unit;
field_decls : field_decls -> unit; field_decls : field_decls -> unit;
for_collect : for_collect reg -> unit; for_collect : for_collect reg -> unit;
@ -501,6 +523,8 @@ type xyz = {
param_decl : param_decl -> unit; param_decl : param_decl -> unit;
parameter_decl : (region * variable * region * type_expr) reg -> unit; parameter_decl : (region * variable * region * type_expr) reg -> unit;
parameters : parameters -> unit; parameters : parameters -> unit;
param_const : param_const -> unit;
param_var : param_var -> unit;
pattern : pattern -> unit; pattern : pattern -> unit;
patterns : core_pattern par -> unit; patterns : core_pattern par -> unit;
proc_decl : proc_decl reg -> unit; proc_decl : proc_decl reg -> unit;
@ -525,10 +549,10 @@ type xyz = {
type_decl : (region * variable * region * type_expr) reg -> unit; type_decl : (region * variable * region * type_expr) reg -> unit;
type_expr : type_expr -> unit; type_expr : type_expr -> unit;
type_tuple : type_tuple -> 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 : variable -> unit;
var_decl : var_decl reg -> unit; var_decl : var_decl reg -> unit;
var_kind : var_kind -> unit;
variant : variant -> unit; variant : variant -> unit;
while_loop : while_loop -> 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; _} = and print_fun_decl (visitor : xyz) {value=node; _} =
visitor.token node.kwd_function "function"; visitor.token node.kwd_function "function";
visitor.var node.var; visitor.var node.name;
visitor.parameters node.param; visitor.parameters node.param;
visitor.token node.colon ":"; visitor.token node.colon ":";
visitor.type_expr node.ret_type; visitor.type_expr node.ret_type;
visitor.token node.kwd_is "is"; 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.token node.kwd_with "with";
visitor.expr node.return visitor.expr node.return
and print_proc_decl (visitor : xyz) {value=node; _} = and print_proc_decl (visitor : xyz) {value=node; _} =
visitor.token node.kwd_procedure "procedure"; visitor.token node.kwd_procedure "procedure";
visitor.var node.var; visitor.var node.name;
visitor.parameters node.param; visitor.parameters node.param;
visitor.token node.kwd_is "is"; 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; _} = and print_parameters (visitor : xyz) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
@ -686,36 +712,51 @@ and print_parameters (visitor : xyz) {value=node; _} =
visitor.nsepseq ";" visitor.param_decl sequence; visitor.nsepseq ";" visitor.param_decl sequence;
visitor.token rpar ")" visitor.token rpar ")"
and print_param_decl (visitor : xyz) {value=node; _} = and print_param_decl (visitor : xyz) = function
let var_kind, variable, colon, type_expr = node in ParamConst param_const -> visitor.param_const param_const
visitor.var_kind var_kind; | 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.var variable;
visitor.token colon ":"; visitor.token colon ":";
visitor.type_expr type_expr visitor.type_expr type_expr
and print_var_kind (visitor : xyz) = function and print_param_var (visitor : xyz) {value=node; _} =
Mutable kwd_var -> visitor.token kwd_var "var" let kwd_var, variable, colon, type_expr = node in
| Const kwd_const -> visitor.token kwd_const "const" visitor.token kwd_var "var";
visitor.var variable;
visitor.token colon ":";
visitor.type_expr type_expr
and print_block (visitor : xyz) {value=node; _} = and print_block (visitor : xyz) {value=node; _} =
visitor.value_decls node.decls;
visitor.token node.opening "begin"; visitor.token node.opening "begin";
visitor.instructions node.instr; visitor.instructions node.instr;
visitor.token node.close "end" visitor.token node.close "end"
and print_value_decls (visitor : xyz) {value=sequence; _} = and print_local_decls (visitor : xyz) sequence =
visitor.sepseq ";" visitor.var_decl sequence List.iter visitor.local_decl sequence
and print_var_decl (visitor : xyz) {value=node; _} = and print_local_decl (visitor : xyz) = function
let setter = LocalLam decl -> visitor.lambda_decl decl
match node.kind with | LocalConst decl -> visitor.const_decl decl
Mutable _ -> ":=" | LocalVar decl -> visitor.var_decl decl
| Const _ -> "=" in
visitor.var_kind node.kind; and print_const_decl (visitor : xyz) {value=node; _} =
visitor.var node.var; visitor.token node.kwd_const "const";
visitor.var node.name;
visitor.token node.colon ":"; visitor.token node.colon ":";
visitor.type_expr node.vtype; 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 visitor.expr node.init
and print_instructions (visitor : xyz) {value=sequence; _} = and print_instructions (visitor : xyz) {value=sequence; _} =
@ -732,6 +773,11 @@ and print_single_instr (visitor : xyz) = function
| Loop loop -> visitor.loop loop | Loop loop -> visitor.loop loop
| ProcCall fun_call -> visitor.fun_call fun_call | ProcCall fun_call -> visitor.fun_call fun_call
| Null kwd_null -> visitor.token kwd_null "null" | 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 = and print_conditional (visitor : xyz) node =
visitor.token node.kwd_if "if"; visitor.token node.kwd_if "if";
@ -999,6 +1045,11 @@ let rec visitor () : xyz = {
bytes = print_bytes (visitor ()); bytes = print_bytes (visitor ());
int = print_int (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 ()); parameter_decl = print_parameter_decl (visitor ());
storage_decl = print_storage_decl (visitor ()); storage_decl = print_storage_decl (visitor ());
operations_decl = print_operations_decl (visitor ()); operations_decl = print_operations_decl (visitor ());
@ -1018,9 +1069,8 @@ let rec visitor () : xyz = {
proc_decl = print_proc_decl (visitor ()); proc_decl = print_proc_decl (visitor ());
parameters = print_parameters (visitor ()); parameters = print_parameters (visitor ());
param_decl = print_param_decl (visitor ()); param_decl = print_param_decl (visitor ());
var_kind = print_var_kind (visitor ());
block = print_block (visitor ()); block = print_block (visitor ());
value_decls = print_value_decls (visitor ()); local_decls = print_local_decls (visitor ());
var_decl = print_var_decl (visitor ()); var_decl = print_var_decl (visitor ());
instructions = print_instructions (visitor ()); instructions = print_instructions (visitor ());
instruction = print_instruction (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_begin = Region.t
type kwd_const = Region.t type kwd_const = Region.t
type kwd_down = Region.t type kwd_down = Region.t
type kwd_fail = Region.t
type kwd_if = Region.t type kwd_if = Region.t
type kwd_in = Region.t type kwd_in = Region.t
type kwd_is = Region.t type kwd_is = Region.t
@ -127,6 +128,7 @@ type 'a braces = (lbrace * 'a * rbrace) reg
type t = { type t = {
types : type_decl list; types : type_decl list;
constants : const_decl reg list;
parameter : parameter_decl; parameter : parameter_decl;
storage : storage_decl; storage : storage_decl;
operations : operations_decl; operations : operations_decl;
@ -175,47 +177,58 @@ and lambda_decl =
and fun_decl = { and fun_decl = {
kwd_function : kwd_function; kwd_function : kwd_function;
var : variable; name : variable;
param : parameters; param : parameters;
colon : colon; colon : colon;
ret_type : type_expr; ret_type : type_expr;
kwd_is : kwd_is; kwd_is : kwd_is;
body : block reg; local_decls : local_decl list;
block : block reg;
kwd_with : kwd_with; kwd_with : kwd_with;
return : expr return : expr
} }
and proc_decl = { and proc_decl = {
kwd_procedure : kwd_procedure; kwd_procedure : kwd_procedure;
var : variable; name : variable;
param : parameters; param : parameters;
kwd_is : kwd_is; kwd_is : kwd_is;
body : block reg local_decls : local_decl list;
block : block reg
} }
and parameters = (param_decl, semi) nsepseq par and parameters = (param_decl, semi) nsepseq par
and param_decl = (var_kind * variable * colon * type_expr) reg and param_decl =
ParamConst of (kwd_const * variable * colon * type_expr) reg
and var_kind = | ParamVar of (kwd_var * variable * colon * type_expr) reg
Mutable of kwd_var
| Const of kwd_const
and block = { and block = {
decls : value_decls;
opening : kwd_begin; opening : kwd_begin;
instr : instructions; instr : instructions;
close : kwd_end 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 = { and const_decl = {
kind : var_kind; kwd_const : kwd_const;
var : variable; name : variable;
colon : colon; colon : colon;
vtype : type_expr; 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 init : expr
} }
@ -232,6 +245,7 @@ and single_instr =
| Loop of loop | Loop of loop
| ProcCall of fun_call | ProcCall of fun_call
| Null of kwd_null | Null of kwd_null
| Fail of (kwd_fail * expr) reg
and conditional = { and conditional = {
kwd_if : kwd_if; 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 expr_to_region : expr -> Region.t
val var_kind_to_region : var_kind -> Region.t
val instr_to_region : instruction -> Region.t val instr_to_region : instruction -> Region.t
val core_pattern_to_region : core_pattern -> Region.t val core_pattern_to_region : core_pattern -> Region.t
val local_decl_to_region : local_decl -> Region.t
(* Printing *) (* Printing *)
val print_tokens : t -> unit 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 " -q, --quiet No output, except errors (default)";
print_endline " --columns Columns for source locations"; print_endline " --columns Columns for source locations";
print_endline " --bytes Bytes 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"; print_endline " -h, --help This help";
exit 0 exit 0
(* Version *)
let version () = printf "%s\n" Version.version; exit 0
(* Specifying the command-line options a la GNU *) (* Specifying the command-line options a la GNU *)
let copy = ref false let copy = ref false
@ -50,8 +55,9 @@ let specs =
'q', "quiet", set quiet true, None; 'q', "quiet", set quiet true, None;
noshort, "columns", set columns true, None; noshort, "columns", set columns true, None;
noshort, "bytes", set bytes true, None; noshort, "bytes", set bytes true, None;
'v', "verbose", None, Some add_verbose; noshort, "verbose", None, Some add_verbose;
'h', "help", Some help, None 'h', "help", Some help, None;
noshort, "version", Some version, None
] ]
;; ;;
@ -115,7 +121,7 @@ let input =
then if Sys.file_exists file_path then if Sys.file_exists file_path
then Some file_path then Some file_path
else abort "Source file not found." 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 *) (* Exporting remaining options as non-mutable values *)

55
LexToken.mli
View File

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

5
LexToken.mll
View File

@ -69,6 +69,7 @@ type t =
| Begin of Region.t | Begin of Region.t
| Const of Region.t | Const of Region.t
| Down of Region.t | Down of Region.t
| Fail of Region.t
| If of Region.t | If of Region.t
| In of Region.t | In of Region.t
| Is of Region.t | Is of Region.t
@ -187,6 +188,7 @@ let proj_token = function
| Begin region -> region, "Begin" | Begin region -> region, "Begin"
| Const region -> region, "Const" | Const region -> region, "Const"
| Down region -> region, "Down" | Down region -> region, "Down"
| Fail region -> region, "Fail"
| If region -> region, "If" | If region -> region, "If"
| In region -> region, "In" | In region -> region, "In"
| Is region -> region, "Is" | Is region -> region, "Is"
@ -270,6 +272,7 @@ let to_lexeme = function
| Begin _ -> "begin" | Begin _ -> "begin"
| Const _ -> "const" | Const _ -> "const"
| Down _ -> "down" | Down _ -> "down"
| Fail _ -> "fail"
| If _ -> "if" | If _ -> "if"
| In _ -> "in" | In _ -> "in"
| Is _ -> "is" | Is _ -> "is"
@ -321,6 +324,7 @@ let keywords = [
(fun reg -> Begin reg); (fun reg -> Begin reg);
(fun reg -> Const reg); (fun reg -> Const reg);
(fun reg -> Down reg); (fun reg -> Down reg);
(fun reg -> Fail reg);
(fun reg -> If reg); (fun reg -> If reg);
(fun reg -> In reg); (fun reg -> In reg);
(fun reg -> Is reg); (fun reg -> Is reg);
@ -544,6 +548,7 @@ let is_kwd = function
| Begin _ | Begin _
| Const _ | Const _
| Down _ | Down _
| Fail _
| If _ | If _
| In _ | In _
| Is _ | 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, (* When scanning structured constructs, like strings and comments,
we need to keep the region of the opening symbol (like double 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 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 also its length [len], so, we are done, it is easy to build the
string making up the structured construct with [mk_str] (see string making up the structured construct with [mk_str] (see
above). above).
The resulting data structure is called a _thread_. The resulting data structure is called a _thread_.
(Note for Emacs: "*)".)
*) *)
type thread = { type thread = {
@ -350,7 +351,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
Hint: Add or remove a digit.\n" Hint: Add or remove a digit.\n"
| Unterminated_comment -> | Unterminated_comment ->
"Unterminated comment.\n\ "Unterminated comment.\n\
Hint: Close with \"*/\".\n" Hint: Close with \"*)\".\n"
| Orphan_minus -> | Orphan_minus ->
"Orphan minus sign.\n\ "Orphan minus sign.\n\
Hint: Remove the trailing space.\n" Hint: Remove the trailing space.\n"
@ -476,8 +477,8 @@ and scan state = parse
let thread = {opening; len=1; acc=['"']} in let thread = {opening; len=1; acc=['"']} in
scan_string thread state lexbuf |> mk_string |> enqueue } scan_string thread state lexbuf |> mk_string |> enqueue }
| "/*" { let opening, _, state = sync state lexbuf in | "(*" { let opening, _, state = sync state lexbuf in
let thread = {opening; len=2; acc=['*';'/']} in let thread = {opening; len=2; acc=['*';'(']} in
let state = scan_block thread state lexbuf |> push_block let state = scan_block thread state lexbuf |> push_block
in scan state lexbuf } in scan state lexbuf }
@ -535,14 +536,15 @@ and scan_string thread state = parse
(* Finishing a block comment (* Finishing a block comment
(Note for Emacs: ("(*")
The lexing of block comments must take care of embedded block The lexing of block comments must take care of embedded block
comments that may occur within, as well as strings, so no substring comments that may occur within, as well as strings, so no substring
"*/" may inadvertantly close the block. This is the purpose of the "*)" may inadvertently close the block. This is the purpose
first case of the scanner [scan_block]. of the first case of the scanner [scan_block].
*) *)
and scan_block thread state = parse 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 opening', lexeme, state = sync state lexbuf in
let thread = push_string lexeme thread in let thread = push_string lexeme thread in
let thread = {thread with opening=opening'} 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, state = next thread state lexbuf in
let thread = {thread with opening} let thread = {thread with opening}
in scan_block thread state lexbuf } in scan_block thread state lexbuf }
| "*/" { let _, lexeme, state = sync state lexbuf | "*)" { let _, lexeme, state = sync state lexbuf
in push_string lexeme thread, state } in push_string lexeme thread, state }
| nl as nl { let () = Lexing.new_line lexbuf | nl as nl { let () = Lexing.new_line lexbuf
and state = {state with pos = state.pos#new_line nl} and state = {state with pos = state.pos#new_line nl}

121
ParToken.mly
View File

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

118
Parser.mly
View File

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

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

1
Version.ml Normal file
View File

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

10
ligo-parser.opam
View File

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