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:
parent
c347d1b08b
commit
dad9b0f816
@ -196,18 +196,23 @@ and type_tuple = (type_expr, comma) nsepseq par reg
|
|||||||
|
|
||||||
and fun_expr = {
|
and fun_expr = {
|
||||||
kwd_function : kwd_function;
|
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;
|
param : parameters;
|
||||||
colon : colon;
|
colon : colon;
|
||||||
ret_type : type_expr;
|
ret_type : type_expr;
|
||||||
kwd_is : kwd_is;
|
kwd_is : kwd_is;
|
||||||
block_with : (block reg * kwd_with) option;
|
block_with : (block reg * kwd_with) option;
|
||||||
return : expr
|
return : expr;
|
||||||
}
|
terminator : semi option
|
||||||
|
|
||||||
and fun_decl = {
|
|
||||||
fun_expr : fun_expr reg;
|
|
||||||
terminator : semi option
|
|
||||||
}
|
}
|
||||||
|
|
||||||
and parameters = (param_decl, semi) nsepseq par reg
|
and parameters = (param_decl, semi) nsepseq par reg
|
||||||
|
@ -226,50 +226,54 @@ field_decl:
|
|||||||
in {region; value} }
|
in {region; value} }
|
||||||
|
|
||||||
fun_expr:
|
fun_expr:
|
||||||
"function" fun_name? parameters ":" type_expr "is"
|
"function" parameters ":" type_expr "is" expr {
|
||||||
block
|
let stop = expr_to_region $6 in
|
||||||
"with" expr {
|
|
||||||
let () = SyntaxError.check_reserved_name_opt $2 in
|
|
||||||
let stop = expr_to_region $9 in
|
|
||||||
let region = cover $1 stop
|
let region = cover $1 stop
|
||||||
and value = {kwd_function = $1;
|
and value = {kwd_function = $1;
|
||||||
name = $2;
|
param = $2;
|
||||||
param = $3;
|
colon = $3;
|
||||||
colon = $4;
|
ret_type = $4;
|
||||||
ret_type = $5;
|
kwd_is = $5;
|
||||||
kwd_is = $6;
|
return = $6}
|
||||||
block_with = Some ($7, $8);
|
|
||||||
return = $9}
|
|
||||||
in {region; value} }
|
in {region; value} }
|
||||||
| "function" fun_name? parameters ":" type_expr "is" expr {
|
|
||||||
let () = SyntaxError.check_reserved_name_opt $2 in
|
|
||||||
let stop = expr_to_region $7 in
|
|
||||||
let region = cover $1 stop
|
|
||||||
and value = {kwd_function = $1;
|
|
||||||
name = $2;
|
|
||||||
param = $3;
|
|
||||||
colon = $4;
|
|
||||||
ret_type = $5;
|
|
||||||
kwd_is = $6;
|
|
||||||
block_with = None;
|
|
||||||
return = $7}
|
|
||||||
in {region; value} }
|
|
||||||
|
|
||||||
|
|
||||||
(* Function declarations *)
|
(* Function declarations *)
|
||||||
|
|
||||||
fun_decl:
|
open_fun_decl:
|
||||||
open_fun_decl { $1 }
|
"function" fun_name parameters ":" type_expr "is"
|
||||||
| fun_expr ";" {
|
block
|
||||||
let region = cover $1.region $2
|
"with" expr {
|
||||||
and value = {fun_expr=$1; terminator = Some $2}
|
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;
|
||||||
|
fun_name;
|
||||||
|
param = $3;
|
||||||
|
colon = $4;
|
||||||
|
ret_type = $5;
|
||||||
|
kwd_is = $6;
|
||||||
|
block_with = Some ($7, $8);
|
||||||
|
return = $9;
|
||||||
|
terminator = None}
|
||||||
|
in {region; value} }
|
||||||
|
| "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;
|
||||||
|
fun_name;
|
||||||
|
param = $3;
|
||||||
|
colon = $4;
|
||||||
|
ret_type = $5;
|
||||||
|
kwd_is = $6;
|
||||||
|
block_with = None;
|
||||||
|
return = $7;
|
||||||
|
terminator = None}
|
||||||
in {region; value} }
|
in {region; value} }
|
||||||
|
|
||||||
open_fun_decl:
|
fun_decl:
|
||||||
fun_expr {
|
open_fun_decl ";"? {
|
||||||
let region = $1.region
|
{$1 with value = {$1.value with terminator=$2}} }
|
||||||
and value = {fun_expr=$1; terminator=None}
|
|
||||||
in {region; value} }
|
|
||||||
|
|
||||||
parameters:
|
parameters:
|
||||||
par(nsepseq(param_decl,";")) {
|
par(nsepseq(param_decl,";")) {
|
||||||
|
@ -195,13 +195,12 @@ and print_type_tuple state {value; _} =
|
|||||||
print_nsepseq state "," print_type_expr inside;
|
print_nsepseq state "," print_type_expr inside;
|
||||||
print_token state rpar ")"
|
print_token state rpar ")"
|
||||||
|
|
||||||
and print_fun_expr state {value; _} =
|
and print_fun_decl state {value; _} =
|
||||||
let {kwd_function; name; param; colon;
|
let {kwd_function; fun_name; param; colon;
|
||||||
ret_type; kwd_is; block_with; return} = value in
|
ret_type; kwd_is; block_with;
|
||||||
print_token state kwd_function "function";
|
return; terminator} = value in
|
||||||
(match name with
|
print_token state kwd_function "function";
|
||||||
None -> print_var state (Region.wrap_ghost "#anon")
|
print_var state fun_name;
|
||||||
| Some var -> print_var state var);
|
|
||||||
print_parameters state param;
|
print_parameters state param;
|
||||||
print_token state colon ":";
|
print_token state colon ":";
|
||||||
print_type_expr state ret_type;
|
print_type_expr state ret_type;
|
||||||
@ -212,11 +211,17 @@ and print_fun_expr state {value; _} =
|
|||||||
print_block state block;
|
print_block state block;
|
||||||
print_token state kwd_with "with");
|
print_token state kwd_with "with");
|
||||||
print_expr state return;
|
print_expr state return;
|
||||||
|
print_terminator state terminator
|
||||||
|
|
||||||
and print_fun_decl state {value; _} =
|
and print_fun_expr state {value; _} =
|
||||||
let {fun_expr ; terminator;} = value in
|
let {kwd_function; param; colon;
|
||||||
print_fun_expr state fun_expr;
|
ret_type; kwd_is; return} : fun_expr = value in
|
||||||
print_terminator state terminator;
|
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; _} =
|
and print_parameters state {value; _} =
|
||||||
let {lpar; inside; rpar} = value in
|
let {lpar; inside; rpar} = value in
|
||||||
@ -826,7 +831,33 @@ and pp_declaration state = function
|
|||||||
pp_const_decl state value
|
pp_const_decl state value
|
||||||
| FunDecl {value; region} ->
|
| FunDecl {value; region} ->
|
||||||
pp_loc_node state "FunDecl" 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 =
|
and pp_const_decl state decl =
|
||||||
pp_ident (state#pad 3 0) decl.name;
|
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)
|
let apply len rank = pp_type_expr (state#pad len rank)
|
||||||
in List.iteri (List.length components |> apply) components
|
in List.iteri (List.length components |> apply) components
|
||||||
|
|
||||||
and pp_fun_expr state decl =
|
and pp_fun_expr state (expr: fun_expr) =
|
||||||
let () =
|
let () =
|
||||||
let state = state#pad 5 0 in
|
let state = state#pad 3 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
|
|
||||||
pp_node state "<parameters>";
|
pp_node state "<parameters>";
|
||||||
pp_parameters state decl.param in
|
pp_parameters state expr.param in
|
||||||
let () =
|
let () =
|
||||||
let state = state#pad 5 2 in
|
let state = state#pad 3 1 in
|
||||||
pp_node state "<return type>";
|
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 () =
|
||||||
let state = state#pad 5 3 in
|
let state = state#pad 3 2 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_node state "<return>";
|
||||||
pp_expr (state#pad 1 0) decl.return
|
pp_expr (state#pad 1 0) expr.return
|
||||||
in ()
|
in ()
|
||||||
|
|
||||||
and pp_parameters state {value; _} =
|
and pp_parameters state {value; _} =
|
||||||
@ -1307,7 +1325,7 @@ and pp_data_decl state = function
|
|||||||
pp_var_decl state value
|
pp_var_decl state value
|
||||||
| LocalFun {value; region} ->
|
| LocalFun {value; region} ->
|
||||||
pp_loc_node state "LocalFun" 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 =
|
and pp_var_decl state decl =
|
||||||
pp_ident (state#pad 3 0) decl.name;
|
pp_ident (state#pad 3 0) decl.name;
|
||||||
|
@ -77,16 +77,6 @@ module Errors = struct
|
|||||||
] in
|
] in
|
||||||
error ~data title message
|
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 corner_case ~loc message =
|
||||||
let title () = "corner case" in
|
let title () = "corner case" in
|
||||||
let content () = "We don't have a good error message for this case. \
|
let content () = "We don't have a good error message for this case. \
|
||||||
@ -170,22 +160,6 @@ module Errors = struct
|
|||||||
] in
|
] in
|
||||||
error ~data title message
|
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 *)
|
(* Logging *)
|
||||||
|
|
||||||
let simplifying_instruction t =
|
let simplifying_instruction t =
|
||||||
@ -205,20 +179,21 @@ open Operators.Simplify.Pascaligo
|
|||||||
|
|
||||||
let r_split = Location.r_split
|
let r_split = Location.r_split
|
||||||
|
|
||||||
(*
|
(* Statements can't be simplified in isolation. [a ; b ; c] can get
|
||||||
Statements can't be simplified in isolation. `a ; b ; c` can get simplified either
|
simplified either as [let x = expr in (b ; c)] if [a] is a [const x
|
||||||
as `let x = expr in (b ; c)` if `a` is a ` const x = expr` declaration or as
|
= expr] declaration or as [sequence(a, sequence(b, c))] for
|
||||||
`sequence(a , sequence(b , c))` for everything else.
|
everything else. Because of this, simplifying sequences depend on
|
||||||
Because of this, simplifying sequences depend on their contents. To avoid peeking in
|
their contents. To avoid peeking in their contents, we instead
|
||||||
their contents, we instead simplify sequences elements as functions from their next
|
simplify sequences elements as functions from their next elements
|
||||||
elements to the actual result.
|
to the actual result.
|
||||||
|
|
||||||
For `return_let_in`, if there is no follow-up element, an error is triggered, as
|
For [return_let_in], if there is no follow-up element, an error is
|
||||||
you can't have `let x = expr in ...` with no `...`. A cleaner option might be to add
|
triggered, as you can't have [let x = expr in ...] with no [...]. A
|
||||||
a `unit` instead of erroring.
|
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 ->
|
let return_let_in ?loc binder rhs = ok @@ fun expr'_opt ->
|
||||||
match expr'_opt with
|
match expr'_opt with
|
||||||
| None -> fail @@ corner_case ~loc:__LOC__ "missing return"
|
| 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 ->
|
| TApp x ->
|
||||||
let (name, tuple) = x.value in
|
let (name, tuple) = x.value in
|
||||||
let lst = npseq_to_list tuple.value.inside 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 =
|
let%bind cst =
|
||||||
trace (unknown_predefined_type name) @@
|
trace (unknown_predefined_type name) @@
|
||||||
type_operators name.value in
|
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
|
let%bind index = simpl_expression lu.index.value.inside in
|
||||||
return @@ e_look_up ~loc path index
|
return @@ e_look_up ~loc path index
|
||||||
)
|
)
|
||||||
| EFun f -> (
|
| EFun f ->
|
||||||
let (f , loc) = r_split f in
|
let (f , loc) = r_split f in
|
||||||
let%bind ((name_opt , _ty_opt) , f') = simpl_fun_expression ~loc f in
|
let%bind (_ty_opt, f') = simpl_fun_expression ~loc f
|
||||||
match name_opt with
|
in return @@ f'
|
||||||
| None -> return @@ f'
|
|
||||||
| Some _ -> fail @@ unexpected_named_function loc
|
|
||||||
)
|
|
||||||
|
|
||||||
and simpl_logic_expression (t:Raw.logic_expr) : expression result =
|
and simpl_logic_expression (t:Raw.logic_expr) : expression result =
|
||||||
let return x = ok x in
|
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
|
return_let_in ~loc (Var.of_name name , Some t) expression
|
||||||
| LocalFun f ->
|
| LocalFun f ->
|
||||||
let (f , loc) = r_split f in
|
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 (binder, expr) = simpl_fun_decl ~loc f
|
||||||
let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in
|
in return_let_in ~loc binder expr
|
||||||
return_let_in ~loc (name , ty_opt) e
|
|
||||||
|
|
||||||
and simpl_param : Raw.param_decl -> (expression_variable * type_expression) result =
|
and simpl_param : Raw.param_decl -> (expression_variable * type_expression) result =
|
||||||
fun t ->
|
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
|
let%bind type_expression = simpl_type_expression c.param_type in
|
||||||
ok (type_name , type_expression)
|
ok (type_name , type_expression)
|
||||||
|
|
||||||
and simpl_fun_expression :
|
and simpl_fun_decl :
|
||||||
loc:_ -> Raw.fun_expr -> ((expression_variable option * type_expression option) * expression) result =
|
loc:_ -> Raw.fun_decl -> ((expression_variable * type_expression option) * expression) result =
|
||||||
fun ~loc x ->
|
fun ~loc x ->
|
||||||
let open! Raw in
|
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 =
|
let statements =
|
||||||
match block_with with
|
match block_with with
|
||||||
| Some (block,_) -> npseq_to_list block.value.statements
|
| Some (block,_) -> npseq_to_list block.value.statements
|
||||||
@ -620,7 +592,6 @@ and simpl_fun_expression :
|
|||||||
(match param.value.inside with
|
(match param.value.inside with
|
||||||
a, [] -> (
|
a, [] -> (
|
||||||
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 (binder , input_type) = input in
|
let (binder , input_type) = input in
|
||||||
let%bind instructions = bind_list
|
let%bind instructions = bind_list
|
||||||
@@ List.map simpl_statement
|
@@ List.map simpl_statement
|
||||||
@ -633,19 +604,22 @@ and simpl_fun_expression :
|
|||||||
bind_fold_right_list aux result body in
|
bind_fold_right_list aux result body in
|
||||||
let expression : expression = e_lambda ~loc binder (Some input_type)
|
let expression : expression = e_lambda ~loc binder (Some input_type)
|
||||||
(Some output_type) result in
|
(Some output_type) result in
|
||||||
let type_annotation = Some (make_t @@ T_arrow (input_type, output_type)) in
|
let type_annotation =
|
||||||
ok ((name , type_annotation) , expression)
|
Some (make_t @@ T_arrow (input_type, output_type)) in
|
||||||
|
ok ((Var.of_name fun_name.value, type_annotation), expression)
|
||||||
)
|
)
|
||||||
| lst -> (
|
| lst -> (
|
||||||
let lst = npseq_to_list lst in
|
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%bind params = bind_map_list simpl_param lst in
|
||||||
let (binder , input_type) =
|
let (binder , input_type) =
|
||||||
let type_expression = T_tuple (List.map snd params) in
|
let type_expression = T_tuple (List.map snd params) in
|
||||||
(arguments_name , type_expression) in
|
(arguments_name , type_expression) in
|
||||||
let%bind tpl_declarations =
|
let%bind tpl_declarations =
|
||||||
let aux = fun i x ->
|
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 type_variable = Some (snd x) in
|
||||||
let ass = return_let_in (fst x , type_variable) expr in
|
let ass = return_let_in (fst x , type_variable) expr in
|
||||||
ass
|
ass
|
||||||
@ -663,34 +637,91 @@ and simpl_fun_expression :
|
|||||||
let expression =
|
let expression =
|
||||||
e_lambda ~loc binder (Some (make_t @@ input_type)) (Some output_type) result in
|
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 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 ((Var.of_name fun_name.value, type_annotation), expression)
|
||||||
ok ((name , 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 =
|
and simpl_declaration : Raw.declaration -> declaration Location.wrap result =
|
||||||
fun t ->
|
fun t ->
|
||||||
let open! Raw in
|
let open! Raw in
|
||||||
match t with
|
match t with
|
||||||
| TypeDecl x -> (
|
| TypeDecl x ->
|
||||||
let (x , loc) = r_split x in
|
let decl, loc = r_split x in
|
||||||
let {name;type_expr} : Raw.type_decl = x in
|
let {name;type_expr} : Raw.type_decl = decl in
|
||||||
let%bind type_expression = simpl_type_expression type_expr 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 ->
|
| ConstDecl x ->
|
||||||
let simpl_const_decl = fun {name;const_type;init} ->
|
let simpl_const_decl = fun {name;const_type;init} ->
|
||||||
let%bind expression = simpl_expression init in
|
let%bind expression = simpl_expression init in
|
||||||
let%bind t = simpl_type_expression const_type in
|
let%bind t = simpl_type_expression const_type in
|
||||||
let type_annotation = Some t in
|
let type_annotation = Some t in
|
||||||
ok @@ Declaration_constant (Var.of_name name.value , type_annotation , expression)
|
ok @@ Declaration_constant
|
||||||
in
|
(Var.of_name name.value, type_annotation, expression)
|
||||||
bind_map_location simpl_const_decl (Location.lift_region x)
|
in bind_map_location simpl_const_decl (Location.lift_region x)
|
||||||
| FunDecl x -> (
|
| FunDecl x ->
|
||||||
let (x , loc) = r_split x in
|
let decl, loc = r_split x in
|
||||||
let%bind ((name_opt , ty_opt) , expr) = simpl_fun_expression ~loc x.fun_expr.value in
|
let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in
|
||||||
let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in
|
ok @@ Location.wrap ~loc (Declaration_constant (name, ty_opt, expr))
|
||||||
ok @@ Location.wrap ~loc (Declaration_constant (name , ty_opt , expr))
|
|
||||||
)
|
|
||||||
|
|
||||||
and simpl_statement : Raw.statement -> (_ -> expression result) result =
|
and simpl_statement : Raw.statement -> (_ -> expression result) result =
|
||||||
fun s ->
|
fun s ->
|
||||||
@ -954,8 +985,8 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result =
|
|||||||
| PConstr (PConstrApp v) -> (
|
| PConstr (PConstrApp v) -> (
|
||||||
let value = v.value in
|
let value = v.value in
|
||||||
match value with
|
match value with
|
||||||
| constr, None ->
|
| constr, None ->
|
||||||
ok (constr.value, "unit")
|
ok (constr.value, "unit")
|
||||||
| _ ->
|
| _ ->
|
||||||
let const, pat_opt = v.value in
|
let const, pat_opt = v.value in
|
||||||
let%bind pat =
|
let%bind pat =
|
||||||
|
@ -6,16 +6,10 @@ open Ast_simplified
|
|||||||
module Raw = Parser.Pascaligo.AST
|
module Raw = Parser.Pascaligo.AST
|
||||||
module SMap = Map.String
|
module SMap = Map.String
|
||||||
|
|
||||||
module Errors :
|
(** Convert a concrete PascaLIGO expression AST to the simplified
|
||||||
sig
|
expression AST used by the compiler. *)
|
||||||
val bad_bytes : Location.t -> string -> unit -> error
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
(** Convert a concrete PascaLIGO expression AST to the simplified expression AST
|
|
||||||
used by the compiler. *)
|
|
||||||
val simpl_expression : Raw.expr -> expr result
|
val simpl_expression : Raw.expr -> expr result
|
||||||
|
|
||||||
(** Convert a concrete PascaLIGO program AST to the simplified program AST used
|
(** Convert a concrete PascaLIGO program AST to the simplified program
|
||||||
by the compiler. *)
|
AST used by the compiler. *)
|
||||||
val simpl_program : Raw.ast -> program result
|
val simpl_program : Raw.ast -> program result
|
||||||
|
36
vendors/UnionFind/UnionFind.install
vendored
Normal file
36
vendors/UnionFind/UnionFind.install
vendored
Normal 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"
|
||||||
|
]
|
26
vendors/ligo-utils/simple-utils/region.ml
vendored
26
vendors/ligo-utils/simple-utils/region.ml
vendored
@ -98,18 +98,20 @@ let make ~(start: Pos.t) ~(stop: Pos.t) =
|
|||||||
info start_offset stop#line horizontal stop_offset
|
info start_offset stop#line horizontal stop_offset
|
||||||
|
|
||||||
method compact ?(file=true) ?(offsets=true) mode =
|
method compact ?(file=true) ?(offsets=true) mode =
|
||||||
let prefix = if file then start#file ^ ":" else ""
|
if start#is_ghost || stop#is_ghost then "ghost"
|
||||||
and start_str = start#anonymous ~offsets mode
|
else
|
||||||
and stop_str = stop#anonymous ~offsets mode in
|
let prefix = if file then start#file ^ ":" else ""
|
||||||
if start#file = stop#file then
|
and start_str = start#anonymous ~offsets mode
|
||||||
if start#line = stop#line then
|
and stop_str = stop#anonymous ~offsets mode in
|
||||||
sprintf "%s%s-%i" prefix start_str
|
if start#file = stop#file then
|
||||||
(if offsets then stop#offset mode
|
if start#line = stop#line then
|
||||||
else stop#column mode)
|
sprintf "%s%s-%i" prefix start_str
|
||||||
else
|
(if offsets then stop#offset mode
|
||||||
sprintf "%s%s-%s" prefix start_str stop_str
|
else stop#column mode)
|
||||||
else sprintf "%s:%s-%s:%s"
|
else
|
||||||
start#file start_str stop#file stop_str
|
sprintf "%s%s-%s" prefix start_str stop_str
|
||||||
|
else sprintf "%s:%s-%s:%s"
|
||||||
|
start#file start_str stop#file stop_str
|
||||||
end
|
end
|
||||||
|
|
||||||
(* Special regions *)
|
(* Special regions *)
|
||||||
|
Loading…
Reference in New Issue
Block a user