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

Refactoring of comments (for [dune build @doc]).

Browse Source 
Refactoring of parsing command-line arguments

  * The type [options] is now abstract and implemented as an
    object type to avoid struggling with scoping and type
    inference when record types share some common field names.

Refactoring of ParserLog for PascaLIGO and CameLIGO

  * The immediate motivation behind that refactoring was to
    remove the use of a couple of global references. A
    consequence is that we have a nicer and more compact code, by
    threading a state. The files [pascaligo/Tests/pp.ligo] and
    [ligodity/Tests/pp.mligo].

  * Another consequence is that the choice of making strings from
    AST nodes depends on the CLI (offsets? mode?). After this
    refactoring, that choice is hardcoded in the simplifiers in a
    few places (TODO), waiting for a general solution that would
    have all CL options flow through the compiler.

  * I removed the use of vendors [x_option.ml], [x_map.ml] and
    [x_list.ml] when handling optional values. (Less dependencies
    this way.)

Refactoring of the ASTs

  * I removed the node [local_decl], which was set to [[]]
    already in a previous commit (which removed local
    declarations as being redundant, as statements could already
    be instructions or declarations).

  * I changed [StrLit] to [String] in the AST of CameLIGO and
    ReasonLIGO.

  * I also changed the type [fun_expr] so now either a block is
    present, and therefore followed by the [with] keyword, or it
    is not. (Before, the presence of a block was not enforced in
    the type with the presence of the keyword.)

Notes

  * [LexerMain.ml] and [ParserMain.ml] for CameLIGO and PascaLIGO
    are almost identical and differ in the same way (language
    name and file extension), which suggests that they should be
    in the [shared] folder and instanciated as a functor in the
    future (TODO).

  * I removed the blank characters at the end of many lines in
    the parser of ReasonLIGO.
This commit is contained in:
Christian Rinderknecht 2019-12-13 12:21:52 +01:00
parent 079e59edff
commit 0226b9f23c
26 changed files with 2215 additions and 2151 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/passes/1-parser/ligodity/AST.ml
View File

@ -268,7 +268,7 @@ and list_expr =
and string_expr = and string_expr =
Cat of cat bin_op reg Cat of cat bin_op reg
| StrLit of string reg | String of string reg
and constr_expr = and constr_expr =
ENone of c_None ENone of c_None
@ -422,7 +422,7 @@ let arith_expr_to_region = function
| Nat {region; _} -> region | Nat {region; _} -> region
let string_expr_to_region = function let string_expr_to_region = function
StrLit {region;_} | Cat {region;_} -> region String {region;_} | Cat {region;_} -> region
let list_expr_to_region = function let list_expr_to_region = function
ECons {region; _} | EListComp {region; _} ECons {region; _} | EListComp {region; _}

2
src/passes/1-parser/ligodity/AST.mli
View File

@ -256,7 +256,7 @@ and list_expr =
and string_expr = and string_expr =
Cat of cat bin_op reg (* e1 ^ e2 *) Cat of cat bin_op reg (* e1 ^ e2 *)
| StrLit of string reg (* "foo" *) | String of string reg (* "foo" *)
and constr_expr = and constr_expr =
ENone of c_None ENone of c_None

41
src/passes/1-parser/ligodity/LexerMain.ml
View File

@ -1,43 +1,40 @@
(* Driver for the lexer of Ligodity *) (** Driver for the LIGO lexer *)
(* Error printing and exception tracing *) let extension = ".mligo"
let options = EvalOpt.read "CameLIGO" extension
(** Error printing and exception tracing
*)
let () = Printexc.record_backtrace true let () = Printexc.record_backtrace true
(* Running the lexer on the source *)
let options = EvalOpt.read "CameLIGO" ".mligo"
open EvalOpt
let external_ text = let external_ text =
Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;; Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;;
(* Path for CPP inclusions (#include) *) (** {1 Preprocessing the input source and opening the input channels} *)
(** Path for CPP inclusions (#include)
*)
let lib_path = let lib_path =
match options.libs with match options#libs with
[] -> "" [] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs "" in List.fold_right mk_I libs ""
(* Preprocessing the input source and opening the input channels *)
let prefix = let prefix =
match options.input with match options#input with
None | Some "-" -> "temp" None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension) | Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp.mligo" let suffix = ".pp" ^ extension
let pp_input = let pp_input =
if Utils.String.Set.mem "cpp" options.verbose if Utils.String.Set.mem "cpp" options#verbose
then prefix ^ suffix then prefix ^ suffix
else let pp_input, pp_out = Filename.open_temp_file prefix suffix else let pp_input, pp_out = Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input in close_out pp_out; pp_input
let cpp_cmd = let cpp_cmd =
match options.input with match options#input with
None | Some "-" -> None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s" Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input lib_path pp_input
@ -46,16 +43,14 @@ let cpp_cmd =
lib_path file pp_input lib_path file pp_input
let () = let () =
if Utils.String.Set.mem "cpp" options.verbose if Utils.String.Set.mem "cpp" options#verbose
then Printf.eprintf "%s\n%!" cpp_cmd; then Printf.eprintf "%s\n%!" cpp_cmd;
if Sys.command cpp_cmd <> 0 then if Sys.command cpp_cmd <> 0 then
external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd)
(* Running the lexer on the input file *) (** {1 Running the lexer on the input file} *)
module Lexer = Lexer.Make (LexToken) module Log = LexerLog.Make (Lexer.Make (LexToken))
module Log = LexerLog.Make (Lexer) let () = Log.trace ~offsets:options#offsets
options#mode (Some pp_input) options#cmd
let () = Log.trace ~offsets:options.offsets
options.mode (Some pp_input) options.cmd

2
src/passes/1-parser/ligodity/Parser.mly
View File

@ -690,7 +690,7 @@ core_expr:
| Nat { EArith (Nat $1) } | Nat { EArith (Nat $1) }
| Ident | module_field { EVar $1 } | Ident | module_field { EVar $1 }
| projection { EProj $1 } | projection { EProj $1 }
| String { EString (StrLit $1) } | String { EString (String $1) }
| unit { EUnit $1 } | unit { EUnit $1 }
| False { ELogic (BoolExpr (False $1)) } | False { ELogic (BoolExpr (False $1)) }
| True { ELogic (BoolExpr (True $1)) } | True { ELogic (BoolExpr (True $1)) }

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

File diff suppressed because it is too large Load Diff

39
src/passes/1-parser/ligodity/ParserLog.mli
View File

@ -1,23 +1,30 @@
(* Printing the AST *) (** Printing the AST *)
val offsets : bool ref (** The type [state] captures the state that is threaded in the
val mode : [`Byte | `Point] ref printing iterators in this module.
*)
type state
(* Printing the tokens reconstructed from the AST. This is very useful val mk_state :
offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
(** {1 Printing tokens from the AST in a buffer}
Printing the tokens reconstructed from the AST. This is very useful
for debugging, as the output of [print_token ast] can be textually for debugging, as the output of [print_token ast] can be textually
compared to that of [Lexer.trace] (see module [LexerMain]). The compared to that of [Lexer.trace] (see module [LexerMain]). *)
optional parameter [undo] is bound to [true] if the caller wants
the AST to be unparsed before printing (those nodes that have been
normalised with function [norm_let] and [norm_fun]). *)
val print_tokens : Buffer.t -> AST.t -> unit val print_tokens : state -> AST.t -> unit
val print_pattern : Buffer.t -> AST.pattern -> unit val print_pattern : state -> AST.pattern -> unit
val print_expr : Buffer.t -> AST.expr -> unit val print_expr : state -> AST.expr -> unit
val tokens_to_string : AST.t -> string val tokens_to_string :
val pattern_to_string : AST.pattern -> string offsets:bool -> mode:[`Point|`Byte] -> AST.t -> string
val expr_to_string : AST.expr -> string val pattern_to_string :
offsets:bool -> mode:[`Point|`Byte] -> AST.pattern -> string
val expr_to_string :
offsets:bool -> mode:[`Point|`Byte] -> AST.expr -> string
(* Pretty-printing of the AST *) (** {1 Pretty-printing of the AST} *)
val pp_ast : Buffer.t -> AST.t -> unit val pp_ast : state -> AST.t -> unit

87
src/passes/1-parser/ligodity/ParserMain.ml
View File

@ -1,27 +1,24 @@
(* Driver for the parser of Ligodity *) (** Driver for the parser of CameLIGO *)
(* Error printing and exception tracing *) let extension = ".mligo"
let options = EvalOpt.read "CameLIGO" extension
(** Error printing and exception tracing
*)
let () = Printexc.record_backtrace true let () = Printexc.record_backtrace true
(* Reading the command-line options *) (** Auxiliary functions
*)
let options = EvalOpt.read "CameLIGO" ".mligo"
open EvalOpt
(* Auxiliary functions *)
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
(* Extracting the input file *) (** Extracting the input file
*)
let file = let file =
match options.input with match options#input with
None | Some "-" -> false None | Some "-" -> false
| Some _ -> true | Some _ -> true
(* Error printing and exception tracing *) (** {1 Error printing and exception tracing} *)
let () = Printexc.record_backtrace true let () = Printexc.record_backtrace true
@ -35,35 +32,35 @@ let error_to_string = function
| _ -> assert false | _ -> assert false
let print_error ?(offsets=true) mode Region.{region; value} ~file = let print_error ?(offsets=true) mode Region.{region; value} ~file =
let msg = error_to_string value in let msg = error_to_string value in
let reg = region#to_string ~file ~offsets mode in let reg = region#to_string ~file ~offsets mode in
Utils.highlight (sprintf "Parse error %s:\n%s%!" reg msg) Utils.highlight (sprintf "Parse error %s:\n%s%!" reg msg)
(* Path for CPP inclusions (#include) *) (** {1 Preprocessing the input source and opening the input channels} *)
(** Path for CPP inclusions (#include)
*)
let lib_path = let lib_path =
match options.libs with match options#libs with
[] -> "" [] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs "" in List.fold_right mk_I libs ""
(* Preprocessing the input source and opening the input channels *)
let prefix = let prefix =
match options.input with match options#input with
None | Some "-" -> "temp" None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension) | Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp.mligo" let suffix = ".pp" ^ extension
let pp_input = let pp_input =
if Utils.String.Set.mem "cpp" options.verbose if Utils.String.Set.mem "cpp" options#verbose
then prefix ^ suffix then prefix ^ suffix
else let pp_input, pp_out = Filename.open_temp_file prefix suffix else let pp_input, pp_out = Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input in close_out pp_out; pp_input
let cpp_cmd = let cpp_cmd =
match options.input with match options#input with
None | Some "-" -> None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s" Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input lib_path pp_input
@ -72,12 +69,12 @@ let cpp_cmd =
lib_path file pp_input lib_path file pp_input
let () = let () =
if Utils.String.Set.mem "cpp" options.verbose if Utils.String.Set.mem "cpp" options#verbose
then Printf.eprintf "%s\n%!" cpp_cmd; then Printf.eprintf "%s\n%!" cpp_cmd;
if Sys.command cpp_cmd <> 0 then if Sys.command cpp_cmd <> 0 then
external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd)
(* Instanciating the lexer *) (** {1 Instanciating the lexer} *)
module Lexer = Lexer.Make (LexToken) module Lexer = Lexer.Make (LexToken)
@ -88,45 +85,49 @@ let Lexer.{read; buffer; get_pos; get_last; close} =
and cout = stdout and cout = stdout
let log = Log.output_token ~offsets:options.offsets let log = Log.output_token ~offsets:options#offsets
options.mode options.cmd cout options#mode options#cmd cout
and close_all () = close (); close_out cout and close_all () = close (); close_out cout
(* Tokeniser *) (** {1 Tokeniser} *)
let tokeniser = read ~log let tokeniser = read ~log
(* Main *) (** {1 Main} *)
let () = let () =
try try
let ast = Parser.contract tokeniser buffer in let ast = Parser.contract tokeniser buffer in
if Utils.String.Set.mem "ast" options.verbose if Utils.String.Set.mem "ast" options#verbose
then let buffer = Buffer.create 131 in then let buffer = Buffer.create 131 in
let state = ParserLog.mk_state
~offsets:options#offsets
~mode:options#mode
~buffer in
begin begin
ParserLog.offsets := options.offsets; ParserLog.pp_ast state ast;
ParserLog.mode := options.mode;
ParserLog.pp_ast buffer ast;
Buffer.output_buffer stdout buffer Buffer.output_buffer stdout buffer
end end
else if Utils.String.Set.mem "ast-tokens" options.verbose else if Utils.String.Set.mem "ast-tokens" options#verbose
then let buffer = Buffer.create 131 in then let buffer = Buffer.create 131 in
let state = ParserLog.mk_state
~offsets:options#offsets
~mode:options#mode
~buffer in
begin begin
ParserLog.offsets := options.offsets; ParserLog.print_tokens state ast;
ParserLog.mode := options.mode;
ParserLog.print_tokens buffer ast;
Buffer.output_buffer stdout buffer Buffer.output_buffer stdout buffer
end end
with with
Lexer.Error err -> Lexer.Error err ->
close_all (); close_all ();
Lexer.print_error ~offsets:options.offsets Lexer.print_error ~offsets:options#offsets
options.mode err ~file options#mode err ~file
| Parser.Error -> | Parser.Error ->
let region = get_last () in let region = get_last () in
let error = Region.{region; value=ParseError} in let error = Region.{region; value=ParseError} in
let () = close_all () in let () = close_all () in
print_error ~offsets:options.offsets print_error ~offsets:options#offsets
options.mode error ~file options#mode error ~file
| Sys_error msg -> Utils.highlight msg | Sys_error msg -> Utils.highlight msg

26
src/passes/1-parser/ligodity/Tests/pp.mligo Normal file
View File

@ -0,0 +1,26 @@
type q = {a: int; b: {c: string}}
type r = int list
type s = (int, address) map
type t = int
type u = {a: int; b: t * char}
type v = int * (string * address)
type w = timestamp * nat -> (string, address) map
type x = A | B of t * int | C of int -> (string -> int)
let x = 4
let y : t = (if true then -3 + f x x else 0) - 1
let f (x: int) y = (x : int)
let z : (t) = y
let w =
match f 3 with
None -> []
| Some (1::[2;3]) -> [4;5]::[]
let n : nat = 0n
let a = A
let b = B a
let c = C (a, B (a))
let d = None
let e = Some (a, B b)
let z = z.1.2
let v = "hello" ^ "world" ^ "!"
let w = Map.literal [(1,"1"); (2,"2")]

1
src/passes/1-parser/pascaligo/.Lexer.ml.tag
View File

@ -1 +0,0 @@
ocamlc: -w -42

3
src/passes/1-parser/pascaligo/.links
View File

@ -4,9 +4,6 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/x_map.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/x_list.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/x_option.ml
../shared/Lexer.mli ../shared/Lexer.mli
../shared/Lexer.mll ../shared/Lexer.mll
../shared/Error.mli ../shared/Error.mli

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

@ -217,10 +217,8 @@ and fun_expr = {
colon : colon; colon : colon;
ret_type : type_expr; ret_type : type_expr;
kwd_is : kwd_is; kwd_is : kwd_is;
local_decls : local_decl list; block_with : (block reg * kwd_with) option;
block : block reg option; return : expr
kwd_with : kwd_with option;
return : expr;
} }
and fun_decl = { and fun_decl = {
@ -269,9 +267,6 @@ and statement =
Instr of instruction Instr of instruction
| Data of data_decl | Data of data_decl
and local_decl =
| LocalData of data_decl
and data_decl = and data_decl =
LocalConst of const_decl reg LocalConst of const_decl reg
| LocalVar of var_decl reg | LocalVar of var_decl reg
@ -757,11 +752,6 @@ let pattern_to_region = function
| PList PCons {region; _} | PList PCons {region; _}
| PTuple {region; _} -> region | PTuple {region; _} -> region
let local_decl_to_region = function
| LocalData LocalFun {region; _}
| LocalData LocalConst {region; _}
| LocalData LocalVar {region; _} -> region
let lhs_to_region : lhs -> Region.t = function let lhs_to_region : lhs -> Region.t = function
Path path -> path_to_region path Path path -> path_to_region path
| MapPath {region; _} -> region | MapPath {region; _} -> region

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

@ -208,10 +208,8 @@ and fun_expr = {
colon : colon; colon : colon;
ret_type : type_expr; ret_type : type_expr;
kwd_is : kwd_is; kwd_is : kwd_is;
local_decls : local_decl list; block_with : (block reg * kwd_with) option;
block : block reg option; return : expr
kwd_with : kwd_with option;
return : expr;
} }
and fun_decl = { and fun_decl = {
@ -260,9 +258,6 @@ and statement =
Instr of instruction Instr of instruction
| Data of data_decl | Data of data_decl
and local_decl =
| LocalData of data_decl
and data_decl = and data_decl =
LocalConst of const_decl reg LocalConst of const_decl reg
| LocalVar of var_decl reg | LocalVar of var_decl reg
@ -615,7 +610,6 @@ val type_expr_to_region : type_expr -> Region.t
val expr_to_region : expr -> Region.t val expr_to_region : expr -> Region.t
val instr_to_region : instruction -> Region.t val instr_to_region : instruction -> Region.t
val pattern_to_region : pattern -> Region.t val pattern_to_region : pattern -> Region.t
val local_decl_to_region : local_decl -> Region.t
val path_to_region : path -> Region.t val path_to_region : path -> Region.t
val lhs_to_region : lhs -> Region.t val lhs_to_region : lhs -> Region.t
val rhs_to_region : rhs -> Region.t val rhs_to_region : rhs -> Region.t

41
src/passes/1-parser/pascaligo/LexerMain.ml
View File

@ -1,43 +1,40 @@
(* Driver for the lexer of PascaLIGO *) (** Driver for the LIGO lexer *)
(* Error printing and exception tracing *) let extension = ".ligo"
let options = EvalOpt.read "PascaLIGO" extension
(** Error printing and exception tracing
*)
let () = Printexc.record_backtrace true let () = Printexc.record_backtrace true
(* Running the lexer on the source *)
let options = EvalOpt.read "PascaLIGO" ".ligo"
open EvalOpt
let external_ text = let external_ text =
Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;; Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;;
(* Path for CPP inclusions (#include) *) (** {1 Preprocessing the input source and opening the input channels} *)
(** Path for CPP inclusions (#include)
*)
let lib_path = let lib_path =
match options.libs with match options#libs with
[] -> "" [] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs "" in List.fold_right mk_I libs ""
(* Preprocessing the input source and opening the input channels *)
let prefix = let prefix =
match options.input with match options#input with
None | Some "-" -> "temp" None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension) | Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp.ligo" let suffix = ".pp" ^ extension
let pp_input = let pp_input =
if Utils.String.Set.mem "cpp" options.verbose if Utils.String.Set.mem "cpp" options#verbose
then prefix ^ suffix then prefix ^ suffix
else let pp_input, pp_out = Filename.open_temp_file prefix suffix else let pp_input, pp_out = Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input in close_out pp_out; pp_input
let cpp_cmd = let cpp_cmd =
match options.input with match options#input with
None | Some "-" -> None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s" Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input lib_path pp_input
@ -46,16 +43,14 @@ let cpp_cmd =
lib_path file pp_input lib_path file pp_input
let () = let () =
if Utils.String.Set.mem "cpp" options.verbose if Utils.String.Set.mem "cpp" options#verbose
then Printf.eprintf "%s\n%!" cpp_cmd; then Printf.eprintf "%s\n%!" cpp_cmd;
if Sys.command cpp_cmd <> 0 then if Sys.command cpp_cmd <> 0 then
external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd)
(* Running the lexer on the input file *) (** {1 Running the lexer on the input file} *)
module Lexer = Lexer.Make (LexToken) module Log = LexerLog.Make (Lexer.Make (LexToken))
module Log = LexerLog.Make (Lexer) let () = Log.trace ~offsets:options#offsets
options#mode (Some pp_input) options#cmd
let () = Log.trace ~offsets:options.offsets
options.mode (Some pp_input) options.cmd

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

@ -252,12 +252,9 @@ fun_expr:
colon = $4; colon = $4;
ret_type = $5; ret_type = $5;
kwd_is = $6; kwd_is = $6;
local_decls = []; block_with = Some ($7, $8);
block = Some $7; return = $9}
kwd_with = Some $8; in {region;value} }
return = $9;
}
in {region;value}}
| Function option(fun_name) parameters COLON type_expr Is | Function option(fun_name) parameters COLON type_expr Is
expr { expr {
let stop = expr_to_region $7 in let stop = expr_to_region $7 in
@ -269,11 +266,8 @@ fun_expr:
colon = $4; colon = $4;
ret_type = $5; ret_type = $5;
kwd_is = $6; kwd_is = $6;
local_decls = []; block_with = None;
block = None; return = $7}
kwd_with = None;
return = $7;
}
in {region;value}} in {region;value}}
@ -288,20 +282,17 @@ fun_decl:
| None -> $1.region in | None -> $1.region in
let region = cover $1.region stop let region = cover $1.region stop
and value = { and value = {
fun_expr = $1; fun_expr = $1;
terminator = $2; terminator = $2}
} in {region; value} }
in {region;value}}
open_fun_decl: open_fun_decl:
fun_expr { fun_expr {
let region = $1.region let region = $1.region
and value = { and value = {
fun_expr = $1; fun_expr = $1;
terminator = None; terminator = None}
} in {region; value} }
in {region;value}}
parameters: parameters:
par(nsepseq(param_decl,SEMI)) { $1 } par(nsepseq(param_decl,SEMI)) { $1 }

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

File diff suppressed because it is too large Load Diff

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

@ -1,18 +1,35 @@
(* Printing the AST *) (** Printing the AST *)
val offsets : bool ref (** The type [state] captures the state that is threaded in the
val mode : [`Byte | `Point] ref printing iterators in this module.
*)
type state
val print_tokens : Buffer.t -> AST.t -> unit val mk_state :
val print_path : Buffer.t -> AST.path -> unit offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
val print_pattern : Buffer.t -> AST.pattern -> unit
val print_instruction : Buffer.t -> AST.instruction -> unit
val tokens_to_string : AST.t -> string (** {1 Printing tokens from the AST in a buffer}
val path_to_string : AST.path -> string
val pattern_to_string : AST.pattern -> string
val instruction_to_string : AST.instruction -> string
(* Pretty-printing of the AST *) Printing the tokens reconstructed from the AST. This is very useful
for debugging, as the output of [print_token ast] can be textually
compared to that of [Lexer.trace] (see module [LexerMain]). *)
val pp_ast : Buffer.t -> AST.t -> unit val print_tokens : state -> AST.t -> unit
val print_path : state -> AST.path -> unit
val print_pattern : state -> AST.pattern -> unit
val print_instruction : state -> AST.instruction -> unit
(** {1 Printing tokens from the AST in a string} *)
val tokens_to_string :
offsets:bool -> mode:[`Point|`Byte] -> AST.t -> string
val path_to_string :
offsets:bool -> mode:[`Point|`Byte] -> AST.path -> string
val pattern_to_string :
offsets:bool -> mode:[`Point|`Byte] -> AST.pattern -> string
val instruction_to_string :
offsets:bool -> mode:[`Point|`Byte] -> AST.instruction -> string
(** {1 Pretty-printing of the AST} *)
val pp_ast : state -> AST.t -> unit

87
src/passes/1-parser/pascaligo/ParserMain.ml
View File

@ -1,27 +1,24 @@
(* Driver for the parser of PascaLIGO *) (** Driver for the parser of PascaLIGO *)
(* Error printing and exception tracing *) let extension = ".ligo"
let options = EvalOpt.read "PascaLIGO" extension
(** Error printing and exception tracing
*)
let () = Printexc.record_backtrace true let () = Printexc.record_backtrace true
(* Reading the command-line options *) (** Auxiliary functions
*)
let options = EvalOpt.read "PascaLIGO" ".ligo"
open EvalOpt
(* Auxiliary functions *)
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
(* Extracting the input file *) (** Extracting the input file
*)
let file = let file =
match options.input with match options#input with
None | Some "-" -> false None | Some "-" -> false
| Some _ -> true | Some _ -> true
(* Error printing and exception tracing *) (** {1 Error printing and exception tracing} *)
let () = Printexc.record_backtrace true let () = Printexc.record_backtrace true
@ -35,35 +32,35 @@ let error_to_string = function
| _ -> assert false | _ -> assert false
let print_error ?(offsets=true) mode Region.{region; value} ~file = let print_error ?(offsets=true) mode Region.{region; value} ~file =
let msg = error_to_string value in let msg = error_to_string value in
let reg = region#to_string ~file ~offsets mode in let reg = region#to_string ~file ~offsets mode in
Utils.highlight (sprintf "Parse error %s:\n%s%!" reg msg) Utils.highlight (sprintf "Parse error %s:\n%s%!" reg msg)
(* Path for CPP inclusions (#include) *) (** {1 Preprocessing the input source and opening the input channels} *)
(** Path for CPP inclusions (#include)
*)
let lib_path = let lib_path =
match options.libs with match options#libs with
[] -> "" [] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs "" in List.fold_right mk_I libs ""
(* Preprocessing the input source and opening the input channels *)
let prefix = let prefix =
match options.input with match options#input with
None | Some "-" -> "temp" None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension) | Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp.ligo" let suffix = ".pp" ^ extension
let pp_input = let pp_input =
if Utils.String.Set.mem "cpp" options.verbose if Utils.String.Set.mem "cpp" options#verbose
then prefix ^ suffix then prefix ^ suffix
else let pp_input, pp_out = Filename.open_temp_file prefix suffix else let pp_input, pp_out = Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input in close_out pp_out; pp_input
let cpp_cmd = let cpp_cmd =
match options.input with match options#input with
None | Some "-" -> None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s" Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input lib_path pp_input
@ -72,12 +69,12 @@ let cpp_cmd =
lib_path file pp_input lib_path file pp_input
let () = let () =
if Utils.String.Set.mem "cpp" options.verbose if Utils.String.Set.mem "cpp" options#verbose
then Printf.eprintf "%s\n%!" cpp_cmd; then Printf.eprintf "%s\n%!" cpp_cmd;
if Sys.command cpp_cmd <> 0 then if Sys.command cpp_cmd <> 0 then
external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd)
(* Instanciating the lexer *) (** {1 Instanciating the lexer} *)
module Lexer = Lexer.Make (LexToken) module Lexer = Lexer.Make (LexToken)
@ -88,45 +85,49 @@ let Lexer.{read; buffer; get_pos; get_last; close} =
and cout = stdout and cout = stdout
let log = Log.output_token ~offsets:options.offsets let log = Log.output_token ~offsets:options#offsets
options.mode options.cmd cout options#mode options#cmd cout
and close_all () = close (); close_out cout and close_all () = close (); close_out cout
(* Tokeniser *) (** {1 Tokeniser} *)
let tokeniser = read ~log let tokeniser = read ~log
(* Main *) (** {1 Main} *)
let () = let () =
try try
let ast = Parser.contract tokeniser buffer in let ast = Parser.contract tokeniser buffer in
if Utils.String.Set.mem "ast" options.verbose if Utils.String.Set.mem "ast" options#verbose
then let buffer = Buffer.create 131 in then let buffer = Buffer.create 131 in
let state = ParserLog.mk_state
~offsets:options#offsets
~mode:options#mode
~buffer in
begin begin
ParserLog.offsets := options.offsets; ParserLog.pp_ast state ast;
ParserLog.mode := options.mode;
ParserLog.pp_ast buffer ast;
Buffer.output_buffer stdout buffer Buffer.output_buffer stdout buffer
end end
else if Utils.String.Set.mem "ast-tokens" options.verbose else if Utils.String.Set.mem "ast-tokens" options#verbose
then let buffer = Buffer.create 131 in then let buffer = Buffer.create 131 in
let state = ParserLog.mk_state
~offsets:options#offsets
~mode:options#mode
~buffer in
begin begin
ParserLog.offsets := options.offsets; ParserLog.print_tokens state ast;
ParserLog.mode := options.mode;
ParserLog.print_tokens buffer ast;
Buffer.output_buffer stdout buffer Buffer.output_buffer stdout buffer
end end
with with
Lexer.Error err -> Lexer.Error err ->
close_all (); close_all ();
Lexer.print_error ~offsets:options.offsets Lexer.print_error ~offsets:options#offsets
options.mode err ~file options#mode err ~file
| Parser.Error -> | Parser.Error ->
let region = get_last () in let region = get_last () in
let error = Region.{region; value=ParseError} in let error = Region.{region; value=ParseError} in
let () = close_all () in let () = close_all () in
print_error ~offsets:options.offsets print_error ~offsets:options#offsets
options.mode error ~file options#mode error ~file
| Sys_error msg -> Utils.highlight msg | Sys_error msg -> Utils.highlight msg

1
src/passes/1-parser/pascaligo/Stubs/Simple_utils.ml
View File

@ -1,3 +1,2 @@
module Region = Region module Region = Region
module Pos = Pos module Pos = Pos
module Option = X_option

10
src/passes/1-parser/pascaligo/Tests/pp.ligo
View File

@ -3,8 +3,8 @@ type u is A | B of t * int | C of int -> (string -> int)
type v is record a : t; b : record c : string end end type v is record a : t; b : record c : string end end
function back (var store : store) : list (operation) * store is function back (var store : store) : list (operation) * store is
var operations : list (operation) := list []
begin begin
var operations : list (operation) := list [];
const a : nat = 0n; const a : nat = 0n;
x0 := record foo = "1"; bar = 4n end; x0 := record foo = "1"; bar = 4n end;
x1 := nil; x1 := nil;
@ -31,8 +31,8 @@ function back (var store : store) : list (operation) * store is
if now > store.deadline and (not True) then if now > store.deadline and (not True) then
begin begin
f (x,1); f (x,1);
for k -> d : int * string in map m block { skip }; for k -> d in map m block { skip };
for x : int in set s block { skip }; for x in set s block { skip };
while i < 10n while i < 10n
begin begin
acc := 2 - (if toggle then f(x) else Unit); acc := 2 - (if toggle then f(x) else Unit);
@ -53,8 +53,8 @@ function back (var store : store) : list (operation) * store is
end with (operations, store) end with (operations, store)
function claim (var store : store) : list (operation) * store is function claim (var store : store) : list (operation) * store is
var operations : list (operation) := nil
begin begin
var operations : list (operation) := nil;
if now <= store.deadline then if now <= store.deadline then
failwith ("Too soon.") failwith ("Too soon.")
else else
@ -73,8 +73,8 @@ function claim (var store : store) : list (operation) * store is
end with (operations, store) end with (operations, store)
function withdraw (var store : store) : list (operation) * store is function withdraw (var store : store) : list (operation) * store is
var operations : list (operation) := list end
begin begin
var operations : list (operation) := list end;
if sender = owner then if sender = owner then
if now >= store.deadline then if now >= store.deadline then
if balance >= store.goal then { if balance >= store.goal then {

346
src/passes/1-parser/reasonligo/Parser.mly
View File

@ -36,11 +36,11 @@ type 'a sequence_or_record =
%nonassoc Ident %nonassoc Ident
%nonassoc COLON (* Solves a shift/reduce problem that happens with record %nonassoc COLON (* Solves a shift/reduce problem that happens with record
and sequences. To elaborate: and sequences. To elaborate:
- sequence_or_record_in can be reduced to - sequence_or_record_in can be reduced to
expr -> Ident, but also to expr -> Ident, but also to
field_assignment -> Ident. field_assignment -> Ident.
*) *)
%% %%
@ -135,7 +135,7 @@ sepseq(item,sep):
(* Non-empty comma-separated values (at least two values) *) (* Non-empty comma-separated values (at least two values) *)
tuple(item): tuple(item):
item COMMA nsepseq(item,COMMA) { item COMMA nsepseq(item,COMMA) {
let h,t = $3 in $1,($2,h)::t let h,t = $3 in $1,($2,h)::t
} }
@ -143,7 +143,7 @@ tuple(item):
list(item): list(item):
LBRACKET sep_or_term_list(item, COMMA) RBRACKET { LBRACKET sep_or_term_list(item, COMMA) RBRACKET {
let elements, terminator = $2 in let elements, terminator = $2 in
{ value = { value =
{ {
compound = Brackets ($1,$3); compound = Brackets ($1,$3);
@ -151,7 +151,7 @@ list(item):
terminator; terminator;
}; };
region = cover $1 $3 region = cover $1 $3
} }
} }
| LBRACKET RBRACKET { | LBRACKET RBRACKET {
let value = { let value = {
@ -161,11 +161,11 @@ list(item):
let region = cover $1 $2 let region = cover $1 $2
in {value; region} in {value; region}
} }
(* Main *) (* Main *)
contract: contract:
declarations EOF { declarations EOF {
{decl = $1; eof=$2} } {decl = $1; eof=$2} }
declarations: declarations:
@ -179,7 +179,7 @@ declaration:
(* Type declarations *) (* Type declarations *)
type_decl: type_decl:
Type type_name EQ type_expr { Type type_name EQ type_expr {
let region = cover $1 (type_expr_to_region $4) in let region = cover $1 (type_expr_to_region $4) in
let value = { let value = {
kwd_type = $1; kwd_type = $1;
@ -200,15 +200,15 @@ cartesian:
let value = Utils.nsepseq_cons $1 $2 $3 in let value = Utils.nsepseq_cons $1 $2 $3 in
let region = nsepseq_to_region type_expr_to_region value let region = nsepseq_to_region type_expr_to_region value
in TProd {region; value} in TProd {region; value}
}
| fun_type { ($1 : type_expr) }
fun_type:
core_type {
$1
} }
| core_type ARROW fun_type { | fun_type { ($1 : type_expr) }
let region = cover (type_expr_to_region $1) (type_expr_to_region $3) in
fun_type:
core_type {
$1
}
| core_type ARROW fun_type {
let region = cover (type_expr_to_region $1) (type_expr_to_region $3) in
TFun {region; value = ($1, $2, $3)} TFun {region; value = ($1, $2, $3)}
} }
@ -219,28 +219,28 @@ core_type:
| module_name DOT type_name { | module_name DOT type_name {
let module_name = $1.value in let module_name = $1.value in
let type_name = $3.value in let type_name = $3.value in
let value = module_name ^ "." ^ type_name in let value = module_name ^ "." ^ type_name in
let region = cover $1.region $3.region let region = cover $1.region $3.region
in in
TVar {region; value} TVar {region; value}
} }
| type_constr LPAR nsepseq(core_type, COMMA) RPAR { | type_constr LPAR nsepseq(core_type, COMMA) RPAR {
let arg_val = $3 in let arg_val = $3 in
let constr = $1 in let constr = $1 in
let start = $1.region in let start = $1.region in
let stop = $4 in let stop = $4 in
let region = cover start stop in let region = cover start stop in
let lpar, rpar = $2, $4 in let lpar, rpar = $2, $4 in
TApp Region.{value = constr, { TApp Region.{value = constr, {
value = { value = {
lpar; lpar;
rpar; rpar;
inside = arg_val inside = arg_val
}; };
region = cover lpar rpar; region = cover lpar rpar;
}; region} }; region}
} }
| par (type_expr) { | par (type_expr) {
TPar $1 TPar $1
} }
@ -248,7 +248,7 @@ type_constr:
type_name { $1 } type_name { $1 }
sum_type: sum_type:
VBAR nsepseq(variant,VBAR) { VBAR nsepseq(variant,VBAR) {
let region = nsepseq_to_region (fun x -> x.region) $2 let region = nsepseq_to_region (fun x -> x.region) $2
in {region; value = $2} in {region; value = $2}
} }
@ -259,11 +259,11 @@ variant:
and value = {constr = $1; arg = Some ($2, $3)} and value = {constr = $1; arg = Some ($2, $3)}
in {region; value} in {region; value}
} }
| Constr { | Constr {
{region=$1.region; value= {constr=$1; arg=None}} } {region=$1.region; value= {constr=$1; arg=None}} }
record_type: record_type:
LBRACE sep_or_term_list(field_decl,COMMA) RBRACE { LBRACE sep_or_term_list(field_decl,COMMA) RBRACE {
let ne_elements, terminator = $2 in let ne_elements, terminator = $2 in
let region = cover $1 $3 let region = cover $1 $3
and value = { and value = {
@ -271,7 +271,7 @@ record_type:
ne_elements; ne_elements;
terminator; terminator;
} }
in {region; value} in {region; value}
} }
type_expr_field: type_expr_field:
@ -282,24 +282,24 @@ type_expr_field:
field_decl: field_decl:
field_name { field_name {
let value = {field_name = $1; colon = Region.ghost; field_type = TVar $1} let value = {field_name = $1; colon = Region.ghost; field_type = TVar $1}
in {region = $1.region; value} in {region = $1.region; value}
} }
| field_name COLON type_expr_field { | field_name COLON type_expr_field {
let stop = type_expr_to_region $3 in let stop = type_expr_to_region $3 in
let region = cover $1.region stop let region = cover $1.region stop
and value = {field_name = $1; colon = $2; field_type = $3} and value = {field_name = $1; colon = $2; field_type = $3}
in {region; value} in {region; value}
} }
(* Top-level non-recursive definitions *) (* Top-level non-recursive definitions *)
let_declaration: let_declaration:
Let let_binding { Let let_binding {
let kwd_let = $1 in let kwd_let = $1 in
let binding, (region: Region.region) = $2 in let binding, (region: Region.region) = $2 in
{value = kwd_let, binding; region} {value = kwd_let, binding; region}
} }
es6_func: es6_func:
ARROW expr { ARROW expr {
$1, $2 $1, $2
@ -313,42 +313,42 @@ let_binding:
let region = cover start stop in let region = cover start stop in
({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region)
} }
| tuple(sub_irrefutable) type_annotation? EQ expr { | tuple(sub_irrefutable) type_annotation? EQ expr {
let h, t = $1 in let h, t = $1 in
let start = pattern_to_region h in let start = pattern_to_region h in
let stop = last (fun (region, _) -> region) t in let stop = last (fun (region, _) -> region) t in
let region = cover start stop in let region = cover start stop in
let pattern = PTuple { value = $1; region } in let pattern = PTuple { value = $1; region } in
let start = region in let start = region in
let stop = expr_to_region $4 in let stop = expr_to_region $4 in
let region = cover start stop in let region = cover start stop in
({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region)
} }
| WILD type_annotation? EQ expr { | WILD type_annotation? EQ expr {
let pattern = PWild $1 in let pattern = PWild $1 in
let start = pattern_to_region pattern in let start = pattern_to_region pattern in
let stop = expr_to_region $4 in let stop = expr_to_region $4 in
let region = cover start stop in let region = cover start stop in
({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region)
} }
| unit type_annotation? EQ expr { | unit type_annotation? EQ expr {
let pattern = PUnit $1 in let pattern = PUnit $1 in
let start = pattern_to_region pattern in let start = pattern_to_region pattern in
let stop = expr_to_region $4 in let stop = expr_to_region $4 in
let region = cover start stop in let region = cover start stop in
({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region)
} }
| record_pattern type_annotation? EQ expr { | record_pattern type_annotation? EQ expr {
let pattern = PRecord $1 in let pattern = PRecord $1 in
let start = pattern_to_region pattern in let start = pattern_to_region pattern in
let stop = expr_to_region $4 in let stop = expr_to_region $4 in
let region = cover start stop in let region = cover start stop in
({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region)
} }
| par(closed_irrefutable) type_annotation? EQ expr { | par(closed_irrefutable) type_annotation? EQ expr {
let pattern = PPar $1 in let pattern = PPar $1 in
let start = pattern_to_region pattern in let start = pattern_to_region pattern in
let stop = expr_to_region $4 in let stop = expr_to_region $4 in
let region = cover start stop in let region = cover start stop in
({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region)
} }
@ -359,11 +359,11 @@ type_annotation:
(* Patterns *) (* Patterns *)
irrefutable: irrefutable:
tuple(sub_irrefutable) { tuple(sub_irrefutable) {
let h, t = $1 in let h, t = $1 in
let start = pattern_to_region h in let start = pattern_to_region h in
let stop = last (fun (region, _) -> region) t in let stop = last (fun (region, _) -> region) t in
let region = cover start stop in let region = cover start stop in
PTuple { value = $1; region } PTuple { value = $1; region }
} }
| sub_irrefutable { $1 } | sub_irrefutable { $1 }
@ -381,14 +381,14 @@ closed_irrefutable:
| typed_pattern { PTyped $1 } | typed_pattern { PTyped $1 }
typed_pattern: typed_pattern:
irrefutable COLON type_expr { irrefutable COLON type_expr {
let start = pattern_to_region $1 in let start = pattern_to_region $1 in
let stop = type_expr_to_region $3 in let stop = type_expr_to_region $3 in
let region = cover start stop in let region = cover start stop in
{ {
value = { value = {
pattern = $1; pattern = $1;
colon = $2; colon = $2;
type_expr = $3 type_expr = $3
}; };
region region
@ -396,18 +396,18 @@ typed_pattern:
} }
pattern: pattern:
LBRACKET sub_pattern COMMA DOTDOTDOT sub_pattern RBRACKET { LBRACKET sub_pattern COMMA DOTDOTDOT sub_pattern RBRACKET {
let start = pattern_to_region $2 in let start = pattern_to_region $2 in
let stop = pattern_to_region $5 in let stop = pattern_to_region $5 in
let region = cover start stop in let region = cover start stop in
let val_ = {value = $2, $3, $5; region} in let val_ = {value = $2, $3, $5; region} in
PList (PCons val_) PList (PCons val_)
} }
| tuple(sub_pattern) { | tuple(sub_pattern) {
let h, t = $1 in let h, t = $1 in
let start = pattern_to_region h in let start = pattern_to_region h in
let stop = last (fun (region, _) -> region) t in let stop = last (fun (region, _) -> region) t in
let region = cover start stop in let region = cover start stop in
PTuple { value = $1; region } PTuple { value = $1; region }
} }
| core_pattern { $1 } | core_pattern { $1 }
@ -425,7 +425,7 @@ core_pattern:
| False { PFalse $1 } | False { PFalse $1 }
| Str { PString $1 } | Str { PString $1 }
| par(ptuple) { PPar $1 } | par(ptuple) { PPar $1 }
| list(sub_pattern) { PList (PListComp $1) } | list(sub_pattern) { PList (PListComp $1) }
| constr_pattern { PConstr $1 } | constr_pattern { PConstr $1 }
| record_pattern { PRecord $1 } | record_pattern { PRecord $1 }
@ -439,7 +439,7 @@ record_pattern:
terminator; terminator;
} }
in in
{region; value} {region; value}
} }
field_pattern: field_pattern:
@ -458,25 +458,25 @@ constr_pattern:
and value = $1, $2 and value = $1, $2
in PSomeApp {value; region} in PSomeApp {value; region}
} }
| Constr { | Constr {
PConstrApp { value = $1, None; region = $1.region } } PConstrApp { value = $1, None; region = $1.region } }
| Constr sub_pattern { | Constr sub_pattern {
let region = cover $1.region (pattern_to_region $2) in let region = cover $1.region (pattern_to_region $2) in
PConstrApp { value = $1, Some $2; region } PConstrApp { value = $1, Some $2; region }
} }
ptuple: ptuple:
tuple(sub_pattern) { tuple(sub_pattern) {
let h, t = $1 in let h, t = $1 in
let start = pattern_to_region h in let start = pattern_to_region h in
let stop = last (fun (region, _) -> region) t in let stop = last (fun (region, _) -> region) t in
let region = cover start stop in let region = cover start stop in
PTuple { value = $1; region } PTuple { value = $1; region }
} }
unit: unit:
LPAR RPAR { LPAR RPAR {
let the_unit = ghost, ghost in let the_unit = ghost, ghost in
let region = cover $1 $2 in let region = cover $1 $2 in
{ value = the_unit; region } { value = the_unit; region }
@ -500,57 +500,57 @@ base_cond:
base_cond__open(base_cond) { $1 } base_cond__open(base_cond) { $1 }
type_expr_simple_args: type_expr_simple_args:
LPAR nsepseq(type_expr_simple, COMMA) RPAR { LPAR nsepseq(type_expr_simple, COMMA) RPAR {
$1, $2, $3 $1, $2, $3
} }
type_expr_simple: type_expr_simple:
core_expr_2 type_expr_simple_args? { core_expr_2 type_expr_simple_args? {
let args = $2 in let args = $2 in
let constr = match $1 with let constr = match $1 with
| EVar i -> i | EVar i -> i
| EProj {value = {struct_name; field_path; _}; region} -> | EProj {value = {struct_name; field_path; _}; region} ->
let path = let path =
(Utils.nsepseq_foldl (Utils.nsepseq_foldl
(fun a e -> (fun a e ->
match e with match e with
| FieldName v -> a ^ "." ^ v.value | FieldName v -> a ^ "." ^ v.value
| Component {value = c, _; _} -> a ^ "." ^ c | Component {value = c, _; _} -> a ^ "." ^ c
) )
struct_name.value struct_name.value
field_path field_path
) )
in in
{value = path; region } {value = path; region }
| EArith (Mutez {value = s, _; region }) | EArith (Mutez {value = s, _; region })
| EArith (Int {value = s, _; region }) | EArith (Int {value = s, _; region })
| EArith (Nat {value = s, _; region }) -> { value = s; region } | EArith (Nat {value = s, _; region }) -> { value = s; region }
| EString (StrLit {value = s; region}) -> { value = s; region } | EString (String {value = s; region}) -> { value = s; region }
| ELogic (BoolExpr (True t)) -> { value = "true"; region = t } | ELogic (BoolExpr (True t)) -> { value = "true"; region = t }
| ELogic (BoolExpr (False f)) -> { value = "false"; region = f } | ELogic (BoolExpr (False f)) -> { value = "false"; region = f }
| _ -> failwith "Not supported" | _ -> failwith "Not supported"
in in
match args with match args with
Some (lpar, args, rpar) -> ( Some (lpar, args, rpar) -> (
let start = expr_to_region $1 in let start = expr_to_region $1 in
let stop = rpar in let stop = rpar in
let region = cover start stop in let region = cover start stop in
TApp { TApp {
value = constr, { value = constr, {
value = { value = {
inside = args; inside = args;
lpar; lpar;
rpar rpar
}; };
region}; region};
region} region}
) )
| None -> TVar constr | None -> TVar constr
} }
| LPAR nsepseq(type_expr_simple, COMMA) RPAR { | LPAR nsepseq(type_expr_simple, COMMA) RPAR {
TProd {value = $2; region = cover $1 $3} TProd {value = $2; region = cover $1 $3}
} }
| LPAR type_expr_simple ARROW type_expr_simple RPAR { | LPAR type_expr_simple ARROW type_expr_simple RPAR {
TFun {value = $2, $3, $4; region = cover $1 $5} TFun {value = $2, $3, $4; region = cover $1 $5}
} }
@ -562,32 +562,32 @@ fun_expr:
let arrow, body = $2 in let arrow, body = $2 in
let kwd_fun = Region.ghost in let kwd_fun = Region.ghost in
let start = expr_to_region $1 in let start = expr_to_region $1 in
let stop = expr_to_region body in let stop = expr_to_region body in
let region = cover start stop in let region = cover start stop in
let rec arg_to_pattern = (function let rec arg_to_pattern = (function
| EVar val_ -> PVar val_ | EVar val_ -> PVar val_
| EAnnot {value = (EVar v, typ); region} -> | EAnnot {value = (EVar v, typ); region} ->
PTyped {value = { PTyped {value = {
pattern = PVar v; pattern = PVar v;
colon = Region.ghost; colon = Region.ghost;
type_expr = typ; type_expr = typ;
} ; region} } ; region}
| EPar {value = {inside; lpar; rpar}; region} -> | EPar {value = {inside; lpar; rpar}; region} ->
PPar {value = {inside = arg_to_pattern inside; lpar; rpar}; region} PPar {value = {inside = arg_to_pattern inside; lpar; rpar}; region}
| EUnit u -> PUnit u | EUnit u -> PUnit u
| _ -> failwith "Not supported" | _ -> failwith "Not supported"
) )
in in
let fun_args_to_pattern = (function let fun_args_to_pattern = (function
| EAnnot {value = (ETuple {value = fun_args; _}, _); _} -> (* ((foo:x, bar) : type) *) | EAnnot {value = (ETuple {value = fun_args; _}, _); _} -> (* ((foo:x, bar) : type) *)
let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in
(arg_to_pattern (fst fun_args), bindings) (arg_to_pattern (fst fun_args), bindings)
| EAnnot {value = (EPar {value = {inside = fun_arg ; _}; _}, _); _} -> (* ((foo:x, bar) : type) *) | EAnnot {value = (EPar {value = {inside = fun_arg ; _}; _}, _); _} -> (* ((foo:x, bar) : type) *)
(arg_to_pattern fun_arg, []) (arg_to_pattern fun_arg, [])
| EPar {value = {inside = fun_arg; _ }; _} -> | EPar {value = {inside = fun_arg; _ }; _} ->
(arg_to_pattern fun_arg, []) (arg_to_pattern fun_arg, [])
| EAnnot e -> (arg_to_pattern (EAnnot e), []) | EAnnot e -> (arg_to_pattern (EAnnot e), [])
| ETuple {value = fun_args; _} -> | ETuple {value = fun_args; _} ->
let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in
(arg_to_pattern (fst fun_args), bindings) (arg_to_pattern (fst fun_args), bindings)
| EUnit e -> | EUnit e ->
@ -624,13 +624,13 @@ if_then(right_expr):
let the_unit = ghost, ghost in let the_unit = ghost, ghost in
let ifnot = EUnit {region=ghost; value=the_unit} in let ifnot = EUnit {region=ghost; value=the_unit} in
let region = cover $1 $5 in let region = cover $1 $5 in
{ {
value = { value = {
kwd_if = $1; kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
ifso = $4; ifso = $4;
kwd_else = Region.ghost; kwd_else = Region.ghost;
ifnot; ifnot;
}; };
region region
@ -640,13 +640,13 @@ if_then(right_expr):
if_then_else(right_expr): if_then_else(right_expr):
If parenthesized_expr LBRACE closed_if SEMI RBRACE Else LBRACE right_expr SEMI RBRACE { If parenthesized_expr LBRACE closed_if SEMI RBRACE Else LBRACE right_expr SEMI RBRACE {
let region = cover $1 $11 in let region = cover $1 $11 in
{ {
value = { value = {
kwd_if = $1; kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
ifso = $4; ifso = $4;
kwd_else = $6; kwd_else = $6;
ifnot = $9 ifnot = $9
}; };
region region
@ -671,20 +671,20 @@ switch_expr(right_expr):
let stop = $5 in let stop = $5 in
let region = cover start stop in let region = cover start stop in
{ value = { { value = {
kwd_match = $1; kwd_match = $1;
expr = $2; expr = $2;
lead_vbar = None; lead_vbar = None;
kwd_with = Region.ghost; kwd_with = Region.ghost;
cases = { cases = {
value = cases; value = cases;
region = nsepseq_to_region (fun {region; _} -> region) $4 region = nsepseq_to_region (fun {region; _} -> region) $4
}; };
}; };
region region
} }
} }
switch_expr_: switch_expr_:
| par(expr) { | par(expr) {
$1.value.inside $1.value.inside
} }
@ -693,7 +693,7 @@ switch_expr_:
} }
cases(right_expr): cases(right_expr):
nseq(case_clause(right_expr)) { nseq(case_clause(right_expr)) {
let (hd, tl) = $1 in let (hd, tl) = $1 in
hd, (List.map (fun f -> expr_to_region f.value.rhs, f) tl) hd, (List.map (fun f -> expr_to_region f.value.rhs, f) tl)
} }
@ -701,11 +701,11 @@ cases(right_expr):
case_clause(right_expr): case_clause(right_expr):
VBAR pattern ARROW right_expr SEMI? { VBAR pattern ARROW right_expr SEMI? {
let region = cover (pattern_to_region $2) (expr_to_region $4) in let region = cover (pattern_to_region $2) (expr_to_region $4) in
{value = {value =
{ {
pattern = $2; pattern = $2;
arrow = $3; arrow = $3;
rhs=$4 rhs=$4
}; };
region region
} }
@ -713,11 +713,11 @@ case_clause(right_expr):
let_expr(right_expr): let_expr(right_expr):
Let let_binding SEMI right_expr { Let let_binding SEMI right_expr {
let kwd_let = $1 in let kwd_let = $1 in
let (binding: let_binding), _ = $2 in let (binding: let_binding), _ = $2 in
let kwd_in = $3 in let kwd_in = $3 in
let body = $4 in let body = $4 in
let stop = expr_to_region $4 in let stop = expr_to_region $4 in
let region = cover $1 stop in let region = cover $1 stop in
let let_in = {kwd_let; binding; kwd_in; body} let let_in = {kwd_let; binding; kwd_in; body}
in ELetIn {region; value=let_in} } in ELetIn {region; value=let_in} }
@ -726,19 +726,19 @@ disj_expr_level:
disj_expr { ELogic (BoolExpr (Or $1)) } disj_expr { ELogic (BoolExpr (Or $1)) }
| conj_expr_level { $1 } | conj_expr_level { $1 }
| par(tuple(disj_expr_level)) type_annotation_simple? { | par(tuple(disj_expr_level)) type_annotation_simple? {
let region = $1.region in let region = $1.region in
let tuple = ETuple {value=$1.value.inside; region} in let tuple = ETuple {value=$1.value.inside; region} in
let region = match $2 with let region = match $2 with
| Some s -> cover $1.region (type_expr_to_region s) | Some s -> cover $1.region (type_expr_to_region s)
| None -> region | None -> region
in in
match $2 with match $2 with
| Some typ -> EAnnot({value = tuple, typ; region}) | Some typ -> EAnnot({value = tuple, typ; region})
| None -> tuple | None -> tuple
} }
bin_op(arg1,op,arg2): bin_op(arg1,op,arg2):
arg1 op arg2 { arg1 op arg2 {
let start = expr_to_region $1 in let start = expr_to_region $1 in
let stop = expr_to_region $3 in let stop = expr_to_region $3 in
let region = cover start stop in let region = cover start stop in
@ -821,29 +821,29 @@ unary_expr_level:
let start = $1 in let start = $1 in
let end_ = expr_to_region $2 in let end_ = expr_to_region $2 in
let region = cover start end_ let region = cover start end_
and value = {op = $1; arg = $2} and value = {op = $1; arg = $2}
in EArith (Neg {region; value}) in EArith (Neg {region; value})
} }
| NOT call_expr_level { | NOT call_expr_level {
let start = $1 in let start = $1 in
let end_ = expr_to_region $2 in let end_ = expr_to_region $2 in
let region = cover start end_ let region = cover start end_
and value = {op = $1; arg = $2} in and value = {op = $1; arg = $2} in
ELogic (BoolExpr (Not ({region; value}))) ELogic (BoolExpr (Not ({region; value})))
} }
| call_expr_level { | call_expr_level {
$1 $1
} }
call_expr_level: call_expr_level:
call_expr_level_in type_annotation_simple? { call_expr_level_in type_annotation_simple? {
let region = match $2 with let region = match $2 with
| Some s -> cover (expr_to_region $1) (type_expr_to_region s) | Some s -> cover (expr_to_region $1) (type_expr_to_region s)
| None -> expr_to_region $1 | None -> expr_to_region $1
in in
match $2 with match $2 with
| Some t -> | Some t ->
EAnnot { value = $1, t; region } EAnnot { value = $1, t; region }
| None -> $1 | None -> $1
} }
@ -859,12 +859,12 @@ constr_expr:
| C_Some core_expr { | C_Some core_expr {
let region = cover $1 (expr_to_region $2) let region = cover $1 (expr_to_region $2)
in EConstr (ESomeApp {value = $1,$2; region}) in EConstr (ESomeApp {value = $1,$2; region})
} }
| Constr core_expr? { | Constr core_expr? {
let start = $1.region in let start = $1.region in
let stop = match $2 with let stop = match $2 with
| Some c -> expr_to_region c | Some c -> expr_to_region c
| None -> start | None -> start
in in
let region = cover start stop in let region = cover start stop in
EConstr (EConstrApp { value = $1,$2; region}) EConstr (EConstrApp { value = $1,$2; region})
@ -892,7 +892,7 @@ core_expr_2:
| Nat { EArith (Nat $1) } | Nat { EArith (Nat $1) }
| Ident | module_field { EVar $1 } | Ident | module_field { EVar $1 }
| projection { EProj $1 } | projection { EProj $1 }
| Str { EString (StrLit $1) } | Str { EString (String $1) }
| unit { EUnit $1 } | unit { EUnit $1 }
| False { ELogic (BoolExpr (False $1)) } | False { ELogic (BoolExpr (False $1)) }
| True { ELogic (BoolExpr (True $1)) } | True { ELogic (BoolExpr (True $1)) }
@ -940,7 +940,7 @@ core_expr:
| Nat { EArith (Nat $1) } | Nat { EArith (Nat $1) }
| Ident | module_field { EVar $1 } | Ident | module_field { EVar $1 }
| projection { EProj $1 } | projection { EProj $1 }
| Str { EString (StrLit $1) } | Str { EString (String $1) }
| unit { EUnit $1 } | unit { EUnit $1 }
| False { ELogic (BoolExpr (False $1)) } | False { ELogic (BoolExpr (False $1)) }
| True { ELogic (BoolExpr (True $1)) } | True { ELogic (BoolExpr (True $1)) }
@ -949,9 +949,9 @@ core_expr:
| sequence_or_record { $1 } | sequence_or_record { $1 }
module_field: module_field:
module_name DOT field_name { module_name DOT field_name {
let region = cover $1.region $3.region in let region = cover $1.region $3.region in
{ value = $1.value ^ "." ^ $3.value; region } { value = $1.value ^ "." ^ $3.value; region }
} }
selection: selection:
@ -962,7 +962,7 @@ selection:
} }
| DOT field_name selection { | DOT field_name selection {
let r, (h, t) = $3 in let r, (h, t) = $3 in
let result:((selection, dot) Utils.nsepseq) = (FieldName $2), ($1, h) :: t in let result:((selection, dot) Utils.nsepseq) = (FieldName $2), ($1, h) :: t in
r, result r, result
} }
| DOT field_name { | DOT field_name {
@ -974,15 +974,15 @@ selection:
projection: projection:
struct_name selection { struct_name selection {
let start = $1.region in let start = $1.region in
let stop = nsepseq_to_region (function let stop = nsepseq_to_region (function
| FieldName f -> f.region | FieldName f -> f.region
| Component c -> c.region) (snd $2) | Component c -> c.region) (snd $2)
in in
let region = cover start stop in let region = cover start stop in
{ value = { value =
{ {
struct_name = $1; struct_name = $1;
selector = fst $2; selector = fst $2;
field_path = snd $2 field_path = snd $2
}; };
@ -994,33 +994,33 @@ projection:
let field_name = $3 in let field_name = $3 in
let value = module_name.value ^ "." ^ field_name.value in let value = module_name.value ^ "." ^ field_name.value in
let struct_name = {$1 with value} in let struct_name = {$1 with value} in
let start = $1.region in let start = $1.region in
let stop = nsepseq_to_region (function let stop = nsepseq_to_region (function
| FieldName f -> f.region | FieldName f -> f.region
| Component c -> c.region) (snd $4) | Component c -> c.region) (snd $4)
in in
let region = cover start stop in let region = cover start stop in
{ value = { value =
{ {
struct_name; struct_name;
selector = fst $4; selector = fst $4;
field_path = snd $4 field_path = snd $4
}; };
region region
} }
} }
sequence_or_record_in: sequence_or_record_in:
expr SEMI sep_or_term_list(expr,SEMI) { expr SEMI sep_or_term_list(expr,SEMI) {
let (e, _region) = $3 in let (e, _region) = $3 in
let e = Utils.nsepseq_cons $1 $2 e in let e = Utils.nsepseq_cons $1 $2 e in
PaSequence { s_elts = e; s_terminator = None} PaSequence { s_elts = e; s_terminator = None}
} }
| field_assignment COMMA sep_or_term_list(field_assignment,COMMA) { | field_assignment COMMA sep_or_term_list(field_assignment,COMMA) {
let (e, _region) = $3 in let (e, _region) = $3 in
let e = Utils.nsepseq_cons $1 $2 e in let e = Utils.nsepseq_cons $1 $2 e in
PaRecord { r_elts = e; r_terminator = None} PaRecord { r_elts = e; r_terminator = None}
} }
| expr SEMI? { | expr SEMI? {
PaSingleExpr $1 PaSingleExpr $1
} }
@ -1029,7 +1029,7 @@ sequence_or_record:
LBRACE sequence_or_record_in RBRACE { LBRACE sequence_or_record_in RBRACE {
let compound = Braces($1, $3) in let compound = Braces($1, $3) in
let region = cover $1 $3 in let region = cover $1 $3 in
match $2 with match $2 with
| PaSequence s -> ( | PaSequence s -> (
let value: expr injection = { let value: expr injection = {
compound; compound;
@ -1045,33 +1045,33 @@ sequence_or_record:
ne_elements = r.r_elts; ne_elements = r.r_elts;
terminator = r.r_terminator; terminator = r.r_terminator;
} }
in in
ERecord {value; region} ERecord {value; region}
) )
| PaSingleExpr e -> e | PaSingleExpr e -> e
} }
field_assignment: field_assignment:
field_name { field_name {
{ value = { value =
{ {
field_name = $1; field_name = $1;
assignment = Region.ghost; assignment = Region.ghost;
field_expr = EVar $1 field_expr = EVar $1
}; };
region = $1.region region = $1.region
} }
} }
| field_name COLON expr { | field_name COLON expr {
let start = $1.region in let start = $1.region in
let stop = expr_to_region $3 in let stop = expr_to_region $3 in
let region = cover start stop in let region = cover start stop in
{ value = { value =
{ {
field_name = $1; field_name = $1;
assignment = $2; assignment = $2;
field_expr = $3 field_expr = $3
}; };
region region
} }
} }

46
src/passes/1-parser/shared/EvalOpt.ml
View File

@ -1,22 +1,32 @@
(* Parsing command-line options *) (** Parsing command-line options *)
(* The type [command] denotes some possible behaviours of the
compiler. *)
(** The type [command] denotes some possible behaviours of the
compiler.
*)
type command = Quiet | Copy | Units | Tokens type command = Quiet | Copy | Units | Tokens
(* The type [options] gathers the command-line options. *) (** The type [options] gathers the command-line options.
*)
type options = { type options = <
input : string option; input : string option;
libs : string list; libs : string list;
verbose : Utils.String.Set.t; verbose : Utils.String.Set.t;
offsets : bool; offsets : bool;
mode : [`Byte | `Point]; mode : [`Byte | `Point];
cmd : command cmd : command
} >
(* Auxiliary functions *) let make ~input ~libs ~verbose ~offsets ~mode ~cmd =
object
method input = input
method libs = libs
method verbose = verbose
method offsets = offsets
method mode = mode
method cmd = cmd
end
(** {1 Auxiliary functions} *)
let printf = Printf.printf let printf = Printf.printf
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
@ -25,7 +35,7 @@ let print = print_endline
let abort msg = let abort msg =
Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1 Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1
(* Help *) (** {1 Help} *)
let help language extension () = let help language extension () =
let file = Filename.basename Sys.argv.(0) in let file = Filename.basename Sys.argv.(0) in
@ -44,11 +54,11 @@ let help language extension () =
print " -h, --help This help"; print " -h, --help This help";
exit 0 exit 0
(* Version *) (** {1 Version} *)
let version () = printf "%s\n" Version.version; exit 0 let version () = printf "%s\n" Version.version; exit 0
(* Specifying the command-line options a la GNU *) (** {1 Specifying the command-line options a la GNU} *)
let copy = ref false let copy = ref false
and tokens = ref false and tokens = ref false
@ -85,8 +95,8 @@ let specs language extension =
] ]
;; ;;
(* Handler of anonymous arguments *) (** Handler of anonymous arguments
*)
let anonymous arg = let anonymous arg =
match !input with match !input with
None -> input := Some arg None -> input := Some arg
@ -94,8 +104,8 @@ let anonymous arg =
abort (sprintf "Multiple inputs") abort (sprintf "Multiple inputs")
;; ;;
(* Checking options and exporting them as non-mutable values *) (** Checking options and exporting them as non-mutable values
*)
let string_of convert = function let string_of convert = function
None -> "None" None -> "None"
| Some s -> sprintf "Some %s" (convert s) | Some s -> sprintf "Some %s" (convert s)
@ -168,9 +178,9 @@ let check extension =
| false, false, false, true -> Tokens | false, false, false, true -> Tokens
| _ -> abort "Choose one of -q, -c, -u, -t." | _ -> abort "Choose one of -q, -c, -u, -t."
in {input; libs; verbose; offsets; mode; cmd} in make ~input ~libs ~verbose ~offsets ~mode ~cmd
(* Parsing the command-line options *) (** {1 Parsing the command-line options} *)
let read language extension = let read language extension =
try try

80
src/passes/1-parser/shared/EvalOpt.mli
View File

@ -1,55 +1,67 @@
(* Parsing the command-line options of PascaLIGO *) (** Parsing the command-line options of PascaLIGO *)
(* The type [command] denotes some possible behaviours of the (** The type [command] denotes some possible behaviours of the
compiler. The constructors are compiler. The constructors are
{ul
* [Quiet], then no output from the lexer and parser should be {li [Quiet], then no output from the lexer and parser should be
expected, safe error messages: this is the default value; expected, safe error messages: this is the default value;}
* [Copy], then lexemes of tokens and markup will be printed to
standard output, with the expectation of a perfect match with
the input file;
* [Units], then the tokens and markup will be printed to standard
output, that is, the abstract representation of the concrete
lexical syntax;
* [Tokens], then the tokens only will be printed.
*)
{li [Copy], then lexemes of tokens and markup will be printed to
standard output, with the expectation of a perfect match
with the input file;}
{li [Units], then the tokens and markup will be printed to
standard output, that is, the abstract representation of the
concrete lexical syntax;}
{li [Tokens], then the tokens only will be printed.}
}
*)
type command = Quiet | Copy | Units | Tokens type command = Quiet | Copy | Units | Tokens
(* The type [options] gathers the command-line options. (** The type [options] gathers the command-line options.
{ul
If the field [input] is [Some src], the name of the PascaLIGO {li If the field [input] is [Some src], the name of the
source file, with the extension ".ligo", is [src]. If [input] is PascaLIGO source file, with the extension ".ligo", is
[Some "-"] or [None], the source file is read from standard input. [src]. If [input] is [Some "-"] or [None], the source file
is read from standard input.}
The field [libs] is the paths where to find PascaLIGO files for {li The field [libs] is the paths where to find PascaLIGO files
inclusion (#include). for inclusion (#include).}
The field [verbose] is a set of stages of the compiler chain, {li The field [verbose] is a set of stages of the compiler
about which more information may be displayed. chain, about which more information may be displayed.}
If the field [offsets] is [true], then the user requested that {li If the field [offsets] is [true], then the user requested
messages about source positions and regions be expressed in terms that messages about source positions and regions be
of horizontal offsets. expressed in terms of horizontal offsets.}
If the value [mode] is [`Byte], then the unit in which source {li If the value [mode] is [`Byte], then the unit in which
positions and regions are expressed in messages is the byte. If source positions and regions are expressed in messages is
[`Point], the unit is unicode points. the byte. If [`Point], the unit is unicode points.}
}
*) *)
type options = <
type options = {
input : string option; input : string option;
libs : string list; libs : string list;
verbose : Utils.String.Set.t; verbose : Utils.String.Set.t;
offsets : bool; offsets : bool;
mode : [`Byte | `Point]; mode : [`Byte | `Point];
cmd : command cmd : command
} >
(* Parsing the command-line options on stdin. The first parameter is val make :
input:string option ->
libs:string list ->
verbose:Utils.String.Set.t ->
offsets:bool ->
mode:[`Byte | `Point] ->
cmd:command -> options
(** Parsing the command-line options on stdin. The first parameter is
the name of the concrete syntax, e.g., "pascaligo", and the second the name of the concrete syntax, e.g., "pascaligo", and the second
is the file extension, e.g., ".ligo". is the file extension, e.g., ".ligo".
*) *)
val read : string -> string -> options val read : string -> string -> options

1
src/passes/1-parser/shared/Lexer.mll
View File

@ -1,6 +1,7 @@
(* Lexer specification for LIGO, to be processed by [ocamllex]. *) (* Lexer specification for LIGO, to be processed by [ocamllex]. *)
{ {
[@@@warning "-42"]
module Region = Simple_utils.Region module Region = Simple_utils.Region
module Pos = Simple_utils.Pos module Pos = Simple_utils.Pos

5
src/passes/1-parser/shared/LexerLog.ml
View File

@ -1,4 +1,4 @@
(* Embedding the lexer of PascaLIGO in a debug module *) (** Embedding the LIGO lexer in a debug module *)
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
@ -24,10 +24,9 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
module Lexer = Lexer module Lexer = Lexer
module Token = Lexer.Token module Token = Lexer.Token
(* Pretty-printing in a string the lexemes making up the markup (** Pretty-printing in a string the lexemes making up the markup
between two tokens, concatenated with the last lexeme between two tokens, concatenated with the last lexeme
itself. *) itself. *)
let output_token ?(offsets=true) mode command let output_token ?(offsets=true) mode command
channel left_mark token : unit = channel left_mark token : unit =
let output str = Printf.fprintf channel "%s%!" str in let output str = Printf.fprintf channel "%s%!" str in

12
src/passes/2-simplify/ligodity.ml
View File

@ -100,8 +100,10 @@ module Errors = struct
let title () = "simplifying expression" in let title () = "simplifying expression" in
let message () = "" in let message () = "" in
let data = [ let data = [
("expression" , ("expression" ,
thunk @@ Parser.Ligodity.ParserLog.expr_to_string t) (** TODO: The labelled arguments should be flowing from the CLI. *)
thunk @@ Parser.Ligodity.ParserLog.expr_to_string
~offsets:true ~mode:`Point t)
] in ] in
error ~data title message error ~data title message
@ -350,7 +352,7 @@ let rec simpl_expression :
return @@ e_literal ~loc (Literal_mutez n) return @@ e_literal ~loc (Literal_mutez n)
) )
| EArith (Neg e) -> simpl_unop "NEG" e | EArith (Neg e) -> simpl_unop "NEG" e
| EString (StrLit s) -> ( | EString (String s) -> (
let (s , loc) = r_split s in let (s , loc) = r_split s in
let s' = let s' =
let s = s in let s = s in
@ -724,9 +726,11 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result =
| lst -> | lst ->
let error x = let error x =
let title () = "Pattern" in let title () = "Pattern" in
(** TODO: The labelled arguments should be flowing from the CLI. *)
let content () = let content () =
Printf.sprintf "Pattern : %s" Printf.sprintf "Pattern : %s"
(Parser.Ligodity.ParserLog.pattern_to_string x) in (Parser.Ligodity.ParserLog.pattern_to_string
~offsets:true ~mode:`Point x) in
error title content error title content
in in
let as_variant () = let as_variant () =

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

@ -1,4 +1,4 @@
open Trace open! Trace
open Ast_simplified open Ast_simplified
module Raw = Parser.Pascaligo.AST module Raw = Parser.Pascaligo.AST
@ -13,12 +13,12 @@ let pseq_to_list = function
| None -> [] | None -> []
| Some lst -> npseq_to_list lst | Some lst -> npseq_to_list lst
let get_value : 'a Raw.reg -> 'a = fun x -> x.value let get_value : 'a Raw.reg -> 'a = fun x -> x.value
let is_compiler_generated = fun (name) -> String.contains (Var.to_name name) '#' let is_compiler_generated name = String.contains (Var.to_name name) '#'
let detect_local_declarations (for_body : expression) = let detect_local_declarations (for_body : expression) =
let%bind aux = Self_ast_simplified.fold_expression let%bind aux = Self_ast_simplified.fold_expression
(fun (nlist, cur_loop : expression_variable list * bool) (ass_exp : expression) -> (fun (nlist, cur_loop : expression_variable list * bool) (ass_exp : expression) ->
if cur_loop then if cur_loop then
match ass_exp.expression with match ass_exp.expression with
| E_let_in {binder;rhs = _;result = _} -> | E_let_in {binder;rhs = _;result = _} ->
let (name,_) = binder in let (name,_) = binder in
@ -45,14 +45,14 @@ let detect_free_variables (for_body : expression) (local_decl_names : expression
when n=C_OR || n=C_AND || n=C_LT || n=C_GT || when n=C_OR || n=C_AND || n=C_LT || n=C_GT ||
n=C_LE || n=C_GE || n=C_EQ || n=C_NEQ -> ( n=C_LE || n=C_GE || n=C_EQ || n=C_NEQ -> (
match (a.expression,b.expression) with match (a.expression,b.expression) with
| E_variable na , E_variable nb -> | E_variable na , E_variable nb ->
let ret = [] in let ret = [] in
let ret = if not (is_compiler_generated na) then let ret = if not (is_compiler_generated na) then
na::ret else ret in na::ret else ret in
let ret = if not (is_compiler_generated nb) then let ret = if not (is_compiler_generated nb) then
nb::ret else ret in nb::ret else ret in
ok (ret@prev) ok (ret@prev)
| E_variable n , _ | E_variable n , _
| _ , E_variable n -> | _ , E_variable n ->
if not (is_compiler_generated n) then if not (is_compiler_generated n) then
ok (n::prev) else ok prev ok (n::prev) else ok prev
@ -140,8 +140,10 @@ module Errors = struct
let data = [ let data = [
("pattern_loc", ("pattern_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) ; fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) ;
(** TODO: The labelled arguments should be flowing from the CLI. *)
("pattern", ("pattern",
fun () -> Parser.Pascaligo.ParserLog.pattern_to_string p) fun () -> Parser.Pascaligo.ParserLog.pattern_to_string
~offsets:true ~mode:`Point p)
] in ] in
error ~data title message error ~data title message
@ -189,9 +191,11 @@ module Errors = struct
let simplifying_instruction t = let simplifying_instruction t =
let title () = "simplifiying instruction" in let title () = "simplifiying instruction" in
let message () = "" in let message () = "" in
(** TODO: The labelled arguments should be flowing from the CLI. *)
let data = [ let data = [
("instruction", ("instruction",
fun () -> Parser.Pascaligo.ParserLog.instruction_to_string t) fun () -> Parser.Pascaligo.ParserLog.instruction_to_string
~offsets:true ~mode:`Point t)
] in ] in
error ~data title message error ~data title message
end end
@ -569,11 +573,6 @@ and simpl_tuple_expression ?loc (lst:Raw.expr list) : expression result =
let%bind lst = bind_list @@ List.map simpl_expression lst in let%bind lst = bind_list @@ List.map simpl_expression lst in
return @@ e_tuple ?loc lst return @@ e_tuple ?loc lst
and simpl_local_declaration : Raw.local_decl -> _ result = fun t ->
match t with
| LocalData d ->
simpl_data_declaration d
and simpl_data_declaration : Raw.data_decl -> _ result = fun t -> and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
match t with match t with
| LocalVar x -> | LocalVar x ->
@ -612,10 +611,10 @@ and simpl_fun_expression :
loc:_ -> Raw.fun_expr -> ((expression_variable option * type_expression option) * expression) result = loc:_ -> Raw.fun_expr -> ((expression_variable option * type_expression option) * expression) result =
fun ~loc x -> fun ~loc x ->
let open! Raw in let open! Raw in
let {name;param;ret_type;local_decls;block;return} : fun_expr = x in let {name;param;ret_type;block_with;return} : fun_expr = x in
let statements = let statements =
match block with match block_with with
| Some block -> npseq_to_list block.value.statements | Some (block,_) -> npseq_to_list block.value.statements
| None -> [] | None -> []
in in
(match param.value.inside with (match param.value.inside with
@ -623,14 +622,12 @@ and simpl_fun_expression :
let%bind input = simpl_param a in let%bind input = simpl_param a in
let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name in let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name in
let (binder , input_type) = input in let (binder , input_type) = input in
let%bind local_declarations =
bind_map_list simpl_local_declaration local_decls in
let%bind instructions = bind_list let%bind instructions = bind_list
@@ List.map simpl_statement @@ List.map simpl_statement
@@ statements in @@ statements in
let%bind result = simpl_expression return in let%bind result = simpl_expression return in
let%bind output_type = simpl_type_expression ret_type in let%bind output_type = simpl_type_expression ret_type in
let body = local_declarations @ instructions in let body = instructions in
let%bind result = let%bind result =
let aux prec cur = cur (Some prec) in let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in bind_fold_right_list aux result body in
@ -654,14 +651,12 @@ and simpl_fun_expression :
ass ass
in in
bind_list @@ List.mapi aux params in bind_list @@ List.mapi aux params in
let%bind local_declarations =
bind_map_list simpl_local_declaration local_decls in
let%bind instructions = bind_list let%bind instructions = bind_list
@@ List.map simpl_statement @@ List.map simpl_statement
@@ statements in @@ statements in
let%bind result = simpl_expression return in let%bind result = simpl_expression return in
let%bind output_type = simpl_type_expression ret_type in let%bind output_type = simpl_type_expression ret_type in
let body = tpl_declarations @ local_declarations @ instructions in let body = tpl_declarations @ instructions in
let%bind result = let%bind result =
let aux prec cur = cur (Some prec) in let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in bind_fold_right_list aux result body in
@ -1002,9 +997,11 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result =
let aux (x , y) = let aux (x , y) =
let error = let error =
let title () = "Pattern" in let title () = "Pattern" in
(** TODO: The labelled arguments should be flowing from the CLI. *)
let content () = let content () =
Printf.sprintf "Pattern : %s" Printf.sprintf "Pattern : %s"
(Parser.Pascaligo.ParserLog.pattern_to_string x) in (Parser.Pascaligo.ParserLog.pattern_to_string
~offsets:true ~mode:`Point x) in
error title content in error title content in
let%bind x' = let%bind x' =
trace error @@ trace error @@
@ -1113,7 +1110,7 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
- references to the iterated value ==> variable `#COMPILER#elt_X` - references to the iterated value ==> variable `#COMPILER#elt_X`
Note: In the case of an inner loop capturing variable from an outer loop Note: In the case of an inner loop capturing variable from an outer loop
the free variable name can be `#COMPILER#acc.Y` and because we do not the free variable name can be `#COMPILER#acc.Y` and because we do not
capture the accumulator record in the inner loop, we don't want to capture the accumulator record in the inner loop, we don't want to
generate `#COMPILER#acc.#COMPILER#acc.Y` but `#COMPILER#acc.Y` generate `#COMPILER#acc.#COMPILER#acc.Y` but `#COMPILER#acc.Y`
5) Append the return value to the body 5) Append the return value to the body
@ -1145,7 +1142,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
let elt_v_name = match fc.bind_to with let elt_v_name = match fc.bind_to with
| Some v -> "#COMPILER#elt_"^(snd v).value | Some v -> "#COMPILER#elt_"^(snd v).value
| None -> "#COMPILER#elt_unused" in | None -> "#COMPILER#elt_unused" in
let element_names = ok @@ match fc.bind_to with let element_names = ok @@ match fc.bind_to with
| Some v -> [Var.of_name fc.var.value;Var.of_name (snd v).value] | Some v -> [Var.of_name fc.var.value;Var.of_name (snd v).value]
| None -> [Var.of_name fc.var.value] in | None -> [Var.of_name fc.var.value] in
(* STEP 1 *) (* STEP 1 *)