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

Merge branch 'rinderknecht-dev' into 'dev'

Browse Source 
Refactoring of the front-end

See merge request ligolang/ligo!256
This commit is contained in:
Christian Rinderknecht 2019-12-13 19:11:11 +00:00
commit 9fa2a4281f
30 changed files with 2281 additions and 2218 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/passes/1-parser/cameligo/.Eval.ml.tag
View File

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

1
src/passes/1-parser/cameligo/.EvalMain.ml.tag
View File

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

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

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

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

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

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

@ -1,43 +1,40 @@
(* Driver for the lexer of Cameligo *)
(** 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
(* Running the lexer on the source *)
let options = EvalOpt.read "CameLIGO" ".mligo"
open EvalOpt
let external_ text =
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 =
match options.libs with
match options#libs with
[] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs ""
(* Preprocessing the input source and opening the input channels *)
let prefix =
match options.input with
match options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp.mligo"
let suffix = ".pp" ^ extension
let pp_input =
if Utils.String.Set.mem "cpp" options.verbose
if Utils.String.Set.mem "cpp" options#verbose
then prefix ^ suffix
else let pp_input, pp_out = Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input
let cpp_cmd =
match options.input with
match options#input with
None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
@ -46,16 +43,14 @@ let cpp_cmd =
lib_path file pp_input
let () =
if Utils.String.Set.mem "cpp" options.verbose
if Utils.String.Set.mem "cpp" options#verbose
then Printf.eprintf "%s\n%!" cpp_cmd;
if Sys.command cpp_cmd <> 0 then
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/cameligo/Parser.mly
View File

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

1329
src/passes/1-parser/cameligo/ParserLog.ml
View File

File diff suppressed because it is too large Load Diff

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

@ -1,23 +1,30 @@
(* Printing the AST *)
(** Printing the AST *)
val offsets : bool ref
val mode : [`Byte | `Point] ref
(** The type [state] captures the state that is threaded in the
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
compared to that of [Lexer.trace] (see module [LexerMain]). The
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]). *)
compared to that of [Lexer.trace] (see module [LexerMain]). *)
val print_tokens : Buffer.t -> AST.t -> unit
val print_pattern : Buffer.t -> AST.pattern -> unit
val print_expr : Buffer.t -> AST.expr -> unit
val print_tokens : state -> AST.t -> unit
val print_pattern : state -> AST.pattern -> unit
val print_expr : state -> AST.expr -> unit
val tokens_to_string : AST.t -> string
val pattern_to_string : AST.pattern -> string
val expr_to_string : AST.expr -> string
val tokens_to_string :
offsets:bool -> mode:[`Point|`Byte] -> AST.t -> 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

81
src/passes/1-parser/cameligo/ParserMain.ml
View File

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

26
src/passes/1-parser/cameligo/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/region.mli
$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.mll
../shared/Error.mli

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

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

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

@ -208,10 +208,8 @@ and fun_expr = {
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
local_decls : local_decl list;
block : block reg option;
kwd_with : kwd_with option;
return : expr;
block_with : (block reg * kwd_with) option;
return : expr
}
and fun_decl = {
@ -260,9 +258,6 @@ and statement =
Instr of instruction
| Data of data_decl
and local_decl =
| LocalData of data_decl
and data_decl =
LocalConst of const_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 instr_to_region : instruction -> 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 lhs_to_region : lhs -> 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
(* Running the lexer on the source *)
let options = EvalOpt.read "PascaLIGO" ".ligo"
open EvalOpt
let external_ text =
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 =
match options.libs with
match options#libs with
[] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs ""
(* Preprocessing the input source and opening the input channels *)
let prefix =
match options.input with
match options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp.ligo"
let suffix = ".pp" ^ extension
let pp_input =
if Utils.String.Set.mem "cpp" options.verbose
if Utils.String.Set.mem "cpp" options#verbose
then prefix ^ suffix
else let pp_input, pp_out = Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input
let cpp_cmd =
match options.input with
match options#input with
None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
@ -46,16 +43,14 @@ let cpp_cmd =
lib_path file pp_input
let () =
if Utils.String.Set.mem "cpp" options.verbose
if Utils.String.Set.mem "cpp" options#verbose
then Printf.eprintf "%s\n%!" cpp_cmd;
if Sys.command cpp_cmd <> 0 then
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

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

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

1992
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
val mode : [`Byte | `Point] ref
(** The type [state] captures the state that is threaded in the
printing iterators in this module.
*)
type state
val print_tokens : Buffer.t -> AST.t -> unit
val print_path : Buffer.t -> AST.path -> unit
val print_pattern : Buffer.t -> AST.pattern -> unit
val print_instruction : Buffer.t -> AST.instruction -> unit
val mk_state :
offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
val tokens_to_string : AST.t -> string
val path_to_string : AST.path -> string
val pattern_to_string : AST.pattern -> string
val instruction_to_string : AST.instruction -> string
(** {1 Printing tokens from the AST in a buffer}
(* 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

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

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

@ -1,3 +0,0 @@
module Region = Region
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
function back (var store : store) : list (operation) * store is
var operations : list (operation) := list []
begin
var operations : list (operation) := list [];
const a : nat = 0n;
x0 := record foo = "1"; bar = 4n end;
x1 := nil;
@ -31,8 +31,8 @@ function back (var store : store) : list (operation) * store is
if now > store.deadline and (not True) then
begin
f (x,1);
for k -> d : int * string in map m block { skip };
for x : int in set s block { skip };
for k -> d in map m block { skip };
for x in set s block { skip };
while i < 10n
begin
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)
function claim (var store : store) : list (operation) * store is
var operations : list (operation) := nil
begin
var operations : list (operation) := nil;
if now <= store.deadline then
failwith ("Too soon.")
else
@ -73,8 +73,8 @@ function claim (var store : store) : list (operation) * store is
end with (operations, store)
function withdraw (var store : store) : list (operation) * store is
var operations : list (operation) := list end
begin
var operations : list (operation) := list end;
if sender = owner then
if now >= store.deadline then
if balance >= store.goal then {

42
src/passes/1-parser/reasonligo/LexerMain.ml
View File

@ -1,44 +1,40 @@
(* Driver for the lexer of ReasonLIGO *)
(** Driver for the LIGO lexer *)
(* Error printing and exception tracing *)
let extension = ".religo"
let options = EvalOpt.read "ReasonLIGO" extension
(** Error printing and exception tracing
*)
let () = Printexc.record_backtrace true
(* Running the lexer on the source *)
let options = EvalOpt.read "ReasonLIGO" ".religo"
open EvalOpt
let external_ text =
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 =
match options.libs with
match options#libs with
[] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs ""
(* Preprocessing the input source and opening the input channels *)
let prefix =
match options.input with
match options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp.religo"
let suffix = ".pp" ^ extension
let pp_input =
if Utils.String.Set.mem "cpp" options.verbose
if Utils.String.Set.mem "cpp" options#verbose
then prefix ^ suffix
else let pp_input, pp_out = Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input
let cpp_cmd =
match options.input with
match options#input with
None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
@ -47,16 +43,14 @@ let cpp_cmd =
lib_path file pp_input
let () =
if Utils.String.Set.mem "cpp" options.verbose
if Utils.String.Set.mem "cpp" options#verbose
then Printf.eprintf "%s\n%!" cpp_cmd;
if Sys.command cpp_cmd <> 0 then
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

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

@ -525,7 +525,7 @@ type_expr_simple:
| EArith (Mutez {value = s, _; region })
| EArith (Int {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 (False f)) -> { value = "false"; region = f }
| _ -> failwith "Not supported"
@ -892,7 +892,7 @@ core_expr_2:
| Nat { EArith (Nat $1) }
| Ident | module_field { EVar $1 }
| projection { EProj $1 }
| Str { EString (StrLit $1) }
| Str { EString (String $1) }
| unit { EUnit $1 }
| False { ELogic (BoolExpr (False $1)) }
| True { ELogic (BoolExpr (True $1)) }
@ -940,7 +940,7 @@ core_expr:
| Nat { EArith (Nat $1) }
| Ident | module_field { EVar $1 }
| projection { EProj $1 }
| Str { EString (StrLit $1) }
| Str { EString (String $1) }
| unit { EUnit $1 }
| False { ELogic (BoolExpr (False $1)) }
| True { ELogic (BoolExpr (True $1)) }

81
src/passes/1-parser/reasonligo/ParserMain.ml
View File

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

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

@ -1,22 +1,32 @@
(* Parsing command-line options *)
(* The type [command] denotes some possible behaviours of the
compiler. *)
(** Parsing command-line options *)
(** The type [command] denotes some possible behaviours of the
compiler.
*)
type command = Quiet | Copy | Units | Tokens
(* The type [options] gathers the command-line options. *)
type options = {
(** The type [options] gathers the command-line options.
*)
type options = <
input : string option;
libs : string list;
verbose : Utils.String.Set.t;
offsets : bool;
mode : [`Byte | `Point];
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 sprintf = Printf.sprintf
@ -25,7 +35,7 @@ let print = print_endline
let abort msg =
Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1
(* Help *)
(** {1 Help} *)
let help language extension () =
let file = Filename.basename Sys.argv.(0) in
@ -44,11 +54,11 @@ let help language extension () =
print " -h, --help This help";
exit 0
(* Version *)
(** {1 Version} *)
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
and tokens = ref false
@ -85,8 +95,8 @@ let specs language extension =
]
;;
(* Handler of anonymous arguments *)
(** Handler of anonymous arguments
*)
let anonymous arg =
match !input with
None -> input := Some arg
@ -94,8 +104,8 @@ let anonymous arg =
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
None -> "None"
| Some s -> sprintf "Some %s" (convert s)
@ -168,9 +178,9 @@ let check extension =
| false, false, false, true -> Tokens
| _ -> 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 =
try

76
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
{ul
* [Quiet], then no output from the lexer and parser should be
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 [Quiet], then no output from the lexer and parser should be
expected, safe error messages: this is the default value;}
{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
(* 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
source file, with the extension ".ligo", is [src]. If [input] is
[Some "-"] or [None], the source file is read from standard input.
{li If the field [input] is [Some src], the name of the
PascaLIGO source file, with the extension ".ligo", is
[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
inclusion (#include).
{li The field [libs] is the paths where to find PascaLIGO files
for inclusion (#include).}
The field [verbose] is a set of stages of the compiler chain,
about which more information may be displayed.
{li The field [verbose] is a set of stages of the compiler
chain, about which more information may be displayed.}
If the field [offsets] is [true], then the user requested that
messages about source positions and regions be expressed in terms
of horizontal offsets.
If the value [mode] is [`Byte], then the unit in which source
positions and regions are expressed in messages is the byte. If
[`Point], the unit is unicode points.
{li If the field [offsets] is [true], then the user requested
that messages about source positions and regions be
expressed in terms of horizontal offsets.}
{li If the value [mode] is [`Byte], then the unit in which
source positions and regions are expressed in messages is
the byte. If [`Point], the unit is unicode points.}
}
*)
type options = {
type options = <
input : string option;
libs : string list;
verbose : Utils.String.Set.t;
offsets : bool;
mode : [`Byte | `Point];
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
is the file extension, e.g., ".ligo".
*)
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]. *)
{
[@@@warning "-42"]
module Region = Simple_utils.Region
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
@ -24,10 +24,9 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
module Lexer = Lexer
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
itself. *)
let output_token ?(offsets=true) mode command
channel left_mark token : unit =
let output str = Printf.fprintf channel "%s%!" str in

10
src/passes/2-simplify/cameligo.ml
View File

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

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

@ -1,4 +1,4 @@
open Trace
open! Trace
open Ast_simplified
module Raw = Parser.Pascaligo.AST
@ -13,7 +13,7 @@ let pseq_to_list = function
| None -> []
| Some lst -> npseq_to_list lst
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%bind aux = Self_ast_simplified.fold_expression
@ -140,8 +140,10 @@ module Errors = struct
let data = [
("pattern_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) ;
(** TODO: The labelled arguments should be flowing from the CLI. *)
("pattern",
fun () -> Parser.Pascaligo.ParserLog.pattern_to_string p)
fun () -> Parser.Pascaligo.ParserLog.pattern_to_string
~offsets:true ~mode:`Point p)
] in
error ~data title message
@ -189,9 +191,11 @@ module Errors = struct
let simplifying_instruction t =
let title () = "simplifiying instruction" in
let message () = "" in
(** TODO: The labelled arguments should be flowing from the CLI. *)
let data = [
("instruction",
fun () -> Parser.Pascaligo.ParserLog.instruction_to_string t)
fun () -> Parser.Pascaligo.ParserLog.instruction_to_string
~offsets:true ~mode:`Point t)
] in
error ~data title message
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
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 ->
match t with
| LocalVar x ->
@ -612,10 +611,10 @@ and simpl_fun_expression :
loc:_ -> Raw.fun_expr -> ((expression_variable option * type_expression option) * expression) result =
fun ~loc x ->
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 =
match block with
| Some block -> npseq_to_list block.value.statements
match block_with with
| Some (block,_) -> npseq_to_list block.value.statements
| None -> []
in
(match param.value.inside with
@ -623,14 +622,12 @@ and simpl_fun_expression :
let%bind input = simpl_param a in
let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name 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
@@ List.map simpl_statement
@@ statements in
let%bind result = simpl_expression return 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 aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
@ -654,14 +651,12 @@ and simpl_fun_expression :
ass
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
@@ List.map simpl_statement
@@ statements in
let%bind result = simpl_expression return 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 aux prec cur = cur (Some prec) 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 error =
let title () = "Pattern" in
(** TODO: The labelled arguments should be flowing from the CLI. *)
let content () =
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
let%bind x' =
trace error @@