Refactoring of the AST and simplfier of PascaLIGO.

Some weeks ago, anonymous functions as expressions were added to
PascaLIGO, unfortunately in a manner that allowed in theory for
contexts in which a named function was found when an anonymous was
expected, and vice-versa. That explains that the simplifier had two new possible errors:

   * unexpected_anonymous_function
     ("you provided a function declaration without name")
   * unexpected_named_function

I changed the AST and the parser so that function expressions
correspond to anonymous functions (without block) and function
declarations correspond to named functions.

I also removed a error in the simplifier, which was unused:

   * bad_bytes
     ("you provided a function expression with a name (remove it)")
This commit is contained in:
Christian Rinderknecht 2020-01-09 17:26:07 +01:00
parent c347d1b08b
commit dad9b0f816
7 changed files with 263 additions and 173 deletions

View File

@ -196,17 +196,22 @@ and type_tuple = (type_expr, comma) nsepseq par reg
and fun_expr = {
kwd_function : kwd_function;
name : variable option;
param : parameters;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
return : expr
}
and fun_decl = {
kwd_function : kwd_function;
fun_name : variable;
param : parameters;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
block_with : (block reg * kwd_with) option;
return : expr
}
and fun_decl = {
fun_expr : fun_expr reg;
return : expr;
terminator : semi option
}

View File

@ -226,50 +226,54 @@ field_decl:
in {region; value} }
fun_expr:
"function" fun_name? parameters ":" type_expr "is"
"function" parameters ":" type_expr "is" expr {
let stop = expr_to_region $6 in
let region = cover $1 stop
and value = {kwd_function = $1;
param = $2;
colon = $3;
ret_type = $4;
kwd_is = $5;
return = $6}
in {region; value} }
(* Function declarations *)
open_fun_decl:
"function" fun_name parameters ":" type_expr "is"
block
"with" expr {
let () = SyntaxError.check_reserved_name_opt $2 in
let fun_name = SyntaxError.check_reserved_name $2 in
let stop = expr_to_region $9 in
let region = cover $1 stop
and value = {kwd_function = $1;
name = $2;
fun_name;
param = $3;
colon = $4;
ret_type = $5;
kwd_is = $6;
block_with = Some ($7, $8);
return = $9}
return = $9;
terminator = None}
in {region; value} }
| "function" fun_name? parameters ":" type_expr "is" expr {
let () = SyntaxError.check_reserved_name_opt $2 in
| "function" fun_name parameters ":" type_expr "is" expr {
let fun_name = SyntaxError.check_reserved_name $2 in
let stop = expr_to_region $7 in
let region = cover $1 stop
and value = {kwd_function = $1;
name = $2;
fun_name;
param = $3;
colon = $4;
ret_type = $5;
kwd_is = $6;
block_with = None;
return = $7}
return = $7;
terminator = None}
in {region; value} }
(* Function declarations *)
fun_decl:
open_fun_decl { $1 }
| fun_expr ";" {
let region = cover $1.region $2
and value = {fun_expr=$1; terminator = Some $2}
in {region; value} }
open_fun_decl:
fun_expr {
let region = $1.region
and value = {fun_expr=$1; terminator=None}
in {region; value} }
open_fun_decl ";"? {
{$1 with value = {$1.value with terminator=$2}} }
parameters:
par(nsepseq(param_decl,";")) {

View File

@ -195,13 +195,12 @@ and print_type_tuple state {value; _} =
print_nsepseq state "," print_type_expr inside;
print_token state rpar ")"
and print_fun_expr state {value; _} =
let {kwd_function; name; param; colon;
ret_type; kwd_is; block_with; return} = value in
and print_fun_decl state {value; _} =
let {kwd_function; fun_name; param; colon;
ret_type; kwd_is; block_with;
return; terminator} = value in
print_token state kwd_function "function";
(match name with
None -> print_var state (Region.wrap_ghost "#anon")
| Some var -> print_var state var);
print_var state fun_name;
print_parameters state param;
print_token state colon ":";
print_type_expr state ret_type;
@ -212,11 +211,17 @@ and print_fun_expr state {value; _} =
print_block state block;
print_token state kwd_with "with");
print_expr state return;
print_terminator state terminator
and print_fun_decl state {value; _} =
let {fun_expr ; terminator;} = value in
print_fun_expr state fun_expr;
print_terminator state terminator;
and print_fun_expr state {value; _} =
let {kwd_function; param; colon;
ret_type; kwd_is; return} : fun_expr = value in
print_token state kwd_function "function";
print_parameters state param;
print_token state colon ":";
print_type_expr state ret_type;
print_token state kwd_is "is";
print_expr state return
and print_parameters state {value; _} =
let {lpar; inside; rpar} = value in
@ -826,7 +831,33 @@ and pp_declaration state = function
pp_const_decl state value
| FunDecl {value; region} ->
pp_loc_node state "FunDecl" region;
pp_fun_expr state value.fun_expr.value
pp_fun_decl state value
and pp_fun_decl state decl =
let () =
let state = state#pad 5 0 in
pp_ident state decl.fun_name in
let () =
let state = state#pad 5 1 in
pp_node state "<parameters>";
pp_parameters state decl.param in
let () =
let state = state#pad 5 2 in
pp_node state "<return type>";
pp_type_expr (state#pad 1 0) decl.ret_type in
let () =
let state = state#pad 5 3 in
pp_node state "<body>";
let statements =
match decl.block_with with
Some (block,_) -> block.value.statements
| None -> Instr (Skip Region.ghost), [] in
pp_statements state statements in
let () =
let state = state#pad 5 4 in
pp_node state "<return>";
pp_expr (state#pad 1 0) decl.return
in ()
and pp_const_decl state decl =
pp_ident (state#pad 3 0) decl.name;
@ -888,32 +919,19 @@ and pp_type_tuple state {value; _} =
let apply len rank = pp_type_expr (state#pad len rank)
in List.iteri (List.length components |> apply) components
and pp_fun_expr state decl =
and pp_fun_expr state (expr: fun_expr) =
let () =
let state = state#pad 5 0 in
match decl.name with
None -> pp_ident state (Region.wrap_ghost "#anon")
| Some var -> pp_ident state var in
let () =
let state = state#pad 5 1 in
let state = state#pad 3 0 in
pp_node state "<parameters>";
pp_parameters state decl.param in
pp_parameters state expr.param in
let () =
let state = state#pad 5 2 in
let state = state#pad 3 1 in
pp_node state "<return type>";
pp_type_expr (state#pad 1 0) decl.ret_type in
pp_type_expr (state#pad 1 0) expr.ret_type in
let () =
let state = state#pad 5 3 in
pp_node state "<body>";
let statements =
match decl.block_with with
Some (block,_) -> block.value.statements
| None -> Instr (Skip Region.ghost), [] in
pp_statements state statements in
let () =
let state = state#pad 5 4 in
let state = state#pad 3 2 in
pp_node state "<return>";
pp_expr (state#pad 1 0) decl.return
pp_expr (state#pad 1 0) expr.return
in ()
and pp_parameters state {value; _} =
@ -1307,7 +1325,7 @@ and pp_data_decl state = function
pp_var_decl state value
| LocalFun {value; region} ->
pp_loc_node state "LocalFun" region;
pp_fun_expr state value.fun_expr.value
pp_fun_decl state value
and pp_var_decl state decl =
pp_ident (state#pad 3 0) decl.name;

View File

@ -77,16 +77,6 @@ module Errors = struct
] in
error ~data title message
let bad_bytes loc str =
let title () = "bad bytes string" in
let message () =
Format.asprintf "bytes string contained non-hexadecimal chars" in
let data = [
("location", fun () -> Format.asprintf "%a" Location.pp loc) ;
("bytes", fun () -> str) ;
] in
error ~data title message
let corner_case ~loc message =
let title () = "corner case" in
let content () = "We don't have a good error message for this case. \
@ -170,22 +160,6 @@ module Errors = struct
] in
error ~data title message
let unexpected_anonymous_function loc =
let title () = "unexpected anonymous function" in
let message () = "you provided a function declaration without name" in
let data = [
("location" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
] in
error ~data title message
let unexpected_named_function loc =
let title () = "unexpected named function" in
let message () = "you provided a function expression with a name (remove it)" in
let data = [
("location" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
] in
error ~data title message
(* Logging *)
let simplifying_instruction t =
@ -205,20 +179,21 @@ open Operators.Simplify.Pascaligo
let r_split = Location.r_split
(*
Statements can't be simplified in isolation. `a ; b ; c` can get simplified either
as `let x = expr in (b ; c)` if `a` is a ` const x = expr` declaration or as
`sequence(a , sequence(b , c))` for everything else.
Because of this, simplifying sequences depend on their contents. To avoid peeking in
their contents, we instead simplify sequences elements as functions from their next
elements to the actual result.
(* Statements can't be simplified in isolation. [a ; b ; c] can get
simplified either as [let x = expr in (b ; c)] if [a] is a [const x
= expr] declaration or as [sequence(a, sequence(b, c))] for
everything else. Because of this, simplifying sequences depend on
their contents. To avoid peeking in their contents, we instead
simplify sequences elements as functions from their next elements
to the actual result.
For `return_let_in`, if there is no follow-up element, an error is triggered, as
you can't have `let x = expr in ...` with no `...`. A cleaner option might be to add
a `unit` instead of erroring.
For [return_let_in], if there is no follow-up element, an error is
triggered, as you can't have [let x = expr in ...] with no [...]. A
cleaner option might be to add a [unit] instead of failing.
`return_statement` is used for non-let_in statements.
[return_statement] is used for non-let-in statements.
*)
let return_let_in ?loc binder rhs = ok @@ fun expr'_opt ->
match expr'_opt with
| None -> fail @@ corner_case ~loc:__LOC__ "missing return"
@ -246,7 +221,8 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
| TApp x ->
let (name, tuple) = x.value in
let lst = npseq_to_list tuple.value.inside in
let%bind lst = bind_list @@ List.map simpl_type_expression lst in (** TODO: fix constant and operator*)
let%bind lst =
bind_list @@ List.map simpl_type_expression lst in (** TODO: fix constant and operator*)
let%bind cst =
trace (unknown_predefined_type name) @@
type_operators name.value in
@ -481,13 +457,10 @@ let rec simpl_expression (t:Raw.expr) : expr result =
let%bind index = simpl_expression lu.index.value.inside in
return @@ e_look_up ~loc path index
)
| EFun f -> (
| EFun f ->
let (f , loc) = r_split f in
let%bind ((name_opt , _ty_opt) , f') = simpl_fun_expression ~loc f in
match name_opt with
| None -> return @@ f'
| Some _ -> fail @@ unexpected_named_function loc
)
let%bind (_ty_opt, f') = simpl_fun_expression ~loc f
in return @@ f'
and simpl_logic_expression (t:Raw.logic_expr) : expression result =
let return x = ok x in
@ -589,9 +562,8 @@ and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
return_let_in ~loc (Var.of_name name , Some t) expression
| LocalFun f ->
let (f , loc) = r_split f in
let%bind ((name_opt , ty_opt) , e) = simpl_fun_expression ~loc f.fun_expr.value in
let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in
return_let_in ~loc (name , ty_opt) e
let%bind (binder, expr) = simpl_fun_decl ~loc f
in return_let_in ~loc binder expr
and simpl_param : Raw.param_decl -> (expression_variable * type_expression) result =
fun t ->
@ -607,11 +579,11 @@ and simpl_param : Raw.param_decl -> (expression_variable * type_expression) resu
let%bind type_expression = simpl_type_expression c.param_type in
ok (type_name , type_expression)
and simpl_fun_expression :
loc:_ -> Raw.fun_expr -> ((expression_variable option * type_expression option) * expression) result =
and simpl_fun_decl :
loc:_ -> Raw.fun_decl -> ((expression_variable * type_expression option) * expression) result =
fun ~loc x ->
let open! Raw in
let {name;param;ret_type;block_with;return} : fun_expr = x in
let {fun_name;param;ret_type;block_with;return} : fun_decl = x in
let statements =
match block_with with
| Some (block,_) -> npseq_to_list block.value.statements
@ -620,7 +592,6 @@ and simpl_fun_expression :
(match param.value.inside with
a, [] -> (
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 instructions = bind_list
@@ List.map simpl_statement
@ -633,19 +604,22 @@ and simpl_fun_expression :
bind_fold_right_list aux result body in
let expression : expression = e_lambda ~loc binder (Some input_type)
(Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow (input_type, output_type)) in
ok ((name , type_annotation) , expression)
let type_annotation =
Some (make_t @@ T_arrow (input_type, output_type)) in
ok ((Var.of_name fun_name.value, type_annotation), expression)
)
| lst -> (
let lst = npseq_to_list lst in
let arguments_name = Var.of_name "arguments" in (* TODO wrong, should be fresh? *)
(* TODO wrong, should be fresh? *)
let arguments_name = Var.of_name "arguments" in
let%bind params = bind_map_list simpl_param lst in
let (binder , input_type) =
let type_expression = T_tuple (List.map snd params) in
(arguments_name , type_expression) in
let%bind tpl_declarations =
let aux = fun i x ->
let expr = e_accessor (e_variable arguments_name) [Access_tuple i] in
let expr =
e_accessor (e_variable arguments_name) [Access_tuple i] in
let type_variable = Some (snd x) in
let ass = return_let_in (fst x , type_variable) expr in
ass
@ -663,34 +637,91 @@ and simpl_fun_expression :
let expression =
e_lambda ~loc binder (Some (make_t @@ input_type)) (Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow (make_t input_type, output_type)) in
let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name in
ok ((name , type_annotation) , expression)
ok ((Var.of_name fun_name.value, type_annotation), expression)
)
)
and simpl_fun_expression :
loc:_ -> Raw.fun_expr -> (type_expression option * expression) result =
fun ~loc x ->
let open! Raw in
let {param;ret_type;return;_} : fun_expr = x in
let statements = [] in
(match param.value.inside with
a, [] -> (
let%bind input = simpl_param a in
let (binder , input_type) = input 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 = instructions in
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let expression : expression = e_lambda ~loc binder (Some input_type)
(Some output_type) result in
let type_annotation =
Some (make_t @@ T_arrow (input_type, output_type)) in
ok (type_annotation, expression)
)
| lst -> (
let lst = npseq_to_list lst in
(* TODO wrong, should be fresh? *)
let arguments_name = Var.of_name "arguments" in
let%bind params = bind_map_list simpl_param lst in
let (binder , input_type) =
let type_expression = T_tuple (List.map snd params) in
(arguments_name , type_expression) in
let%bind tpl_declarations =
let aux = fun i x ->
let expr =
e_accessor (e_variable arguments_name) [Access_tuple i] in
let type_variable = Some (snd x) in
let ass = return_let_in (fst x , type_variable) expr in
ass
in
bind_list @@ List.mapi aux params 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 @ instructions in
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let expression =
e_lambda ~loc binder (Some (make_t @@ input_type)) (Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow (make_t input_type, output_type)) in
ok (type_annotation, expression)
)
)
and simpl_declaration : Raw.declaration -> declaration Location.wrap result =
fun t ->
let open! Raw in
match t with
| TypeDecl x -> (
let (x , loc) = r_split x in
let {name;type_expr} : Raw.type_decl = x in
| TypeDecl x ->
let decl, loc = r_split x in
let {name;type_expr} : Raw.type_decl = decl in
let%bind type_expression = simpl_type_expression type_expr in
ok @@ Location.wrap ~loc (Declaration_type (Var.of_name name.value , type_expression))
)
ok @@ Location.wrap ~loc (Declaration_type
(Var.of_name name.value, type_expression))
| ConstDecl x ->
let simpl_const_decl = fun {name;const_type;init} ->
let%bind expression = simpl_expression init in
let%bind t = simpl_type_expression const_type in
let type_annotation = Some t in
ok @@ Declaration_constant (Var.of_name name.value , type_annotation , expression)
in
bind_map_location simpl_const_decl (Location.lift_region x)
| FunDecl x -> (
let (x , loc) = r_split x in
let%bind ((name_opt , ty_opt) , expr) = simpl_fun_expression ~loc x.fun_expr.value in
let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in
ok @@ Declaration_constant
(Var.of_name name.value, type_annotation, expression)
in bind_map_location simpl_const_decl (Location.lift_region x)
| FunDecl x ->
let decl, loc = r_split x in
let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in
ok @@ Location.wrap ~loc (Declaration_constant (name, ty_opt, expr))
)
and simpl_statement : Raw.statement -> (_ -> expression result) result =
fun s ->

View File

@ -6,16 +6,10 @@ open Ast_simplified
module Raw = Parser.Pascaligo.AST
module SMap = Map.String
module Errors :
sig
val bad_bytes : Location.t -> string -> unit -> error
end
(** Convert a concrete PascaLIGO expression AST to the simplified expression AST
used by the compiler. *)
(** Convert a concrete PascaLIGO expression AST to the simplified
expression AST used by the compiler. *)
val simpl_expression : Raw.expr -> expr result
(** Convert a concrete PascaLIGO program AST to the simplified program AST used
by the compiler. *)
(** Convert a concrete PascaLIGO program AST to the simplified program
AST used by the compiler. *)
val simpl_program : Raw.ast -> program result

36
vendors/UnionFind/UnionFind.install vendored Normal file
View File

@ -0,0 +1,36 @@
lib: [
"_build/install/default/lib/UnionFind/META"
"_build/install/default/lib/UnionFind/Partition.cmi"
"_build/install/default/lib/UnionFind/Partition.cmti"
"_build/install/default/lib/UnionFind/Partition.mli"
"_build/install/default/lib/UnionFind/Partition0.cmi"
"_build/install/default/lib/UnionFind/Partition0.cmt"
"_build/install/default/lib/UnionFind/Partition0.cmx"
"_build/install/default/lib/UnionFind/Partition0.ml"
"_build/install/default/lib/UnionFind/Partition1.cmi"
"_build/install/default/lib/UnionFind/Partition1.cmt"
"_build/install/default/lib/UnionFind/Partition1.cmx"
"_build/install/default/lib/UnionFind/Partition1.ml"
"_build/install/default/lib/UnionFind/Partition2.cmi"
"_build/install/default/lib/UnionFind/Partition2.cmt"
"_build/install/default/lib/UnionFind/Partition2.cmx"
"_build/install/default/lib/UnionFind/Partition2.ml"
"_build/install/default/lib/UnionFind/Partition3.cmi"
"_build/install/default/lib/UnionFind/Partition3.cmt"
"_build/install/default/lib/UnionFind/Partition3.cmx"
"_build/install/default/lib/UnionFind/Partition3.ml"
"_build/install/default/lib/UnionFind/UnionFind.a"
"_build/install/default/lib/UnionFind/UnionFind.cma"
"_build/install/default/lib/UnionFind/UnionFind.cmxa"
"_build/install/default/lib/UnionFind/UnionFind.cmxs"
"_build/install/default/lib/UnionFind/dune-package"
"_build/install/default/lib/UnionFind/opam"
"_build/install/default/lib/UnionFind/unionFind.cmi"
"_build/install/default/lib/UnionFind/unionFind.cmt"
"_build/install/default/lib/UnionFind/unionFind.cmx"
"_build/install/default/lib/UnionFind/unionFind.ml"
]
doc: [
"_build/install/default/doc/UnionFind/LICENSE"
"_build/install/default/doc/UnionFind/README.md"
]

View File

@ -98,6 +98,8 @@ let make ~(start: Pos.t) ~(stop: Pos.t) =
info start_offset stop#line horizontal stop_offset
method compact ?(file=true) ?(offsets=true) mode =
if start#is_ghost || stop#is_ghost then "ghost"
else
let prefix = if file then start#file ^ ":" else ""
and start_str = start#anonymous ~offsets mode
and stop_str = stop#anonymous ~offsets mode in