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)) }

1329
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

81
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
@ -39,31 +36,31 @@ let print_error ?(offsets=true) mode Region.{region; value} ~file =
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

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

@ -252,11 +252,8 @@ 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;
return = $9;
}
in {region;value} } in {region;value} }
| Function option(fun_name) parameters COLON type_expr Is | Function option(fun_name) parameters COLON type_expr Is
expr { expr {
@ -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}}
@ -289,8 +283,7 @@ fun_decl:
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:
@ -298,11 +291,9 @@ open_fun_decl:
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 }

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 (** 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

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 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
@ -39,31 +36,31 @@ let print_error ?(offsets=true) mode Region.{region; value} ~file =
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 {

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

@ -525,7 +525,7 @@ type_expr_simple:
| 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"
@ -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)) }

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

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 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 {li [Copy], then lexemes of tokens and markup will be printed to
the input file; standard output, with the expectation of a perfect match
* [Units], then the tokens and markup will be printed to standard with the input file;}
output, that is, the abstract representation of the concrete
lexical syntax; {li [Units], then the tokens and markup will be printed to
* [Tokens], then the tokens only will be printed. 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
positions and regions are expressed in messages is the byte. If
[`Point], the unit is unicode points.
{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; 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

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

@ -101,7 +101,9 @@ module Errors = struct
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 () =

35
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,7 +13,7 @@ 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
@ -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 @@