Keyword add for pasca,came,reason:ligo;typing error in contract

This commit is contained in:
Pierre-Emmanuel Wulfman 2020-02-21 16:10:02 +01:00
parent b51818bc4e
commit 734620a179
9 changed files with 49 additions and 19 deletions

View File

@ -135,7 +135,7 @@ and ast = t
and attributes = attribute list
and declaration =
Let of (kwd_let * let_binding * attributes) reg
Let of (kwd_let * kwd_rec option * let_binding * attributes) reg
| TypeDecl of type_decl reg
(* Non-recursive values *)

View File

@ -253,6 +253,7 @@ let keywords = [
(fun reg -> End reg);
(fun reg -> False reg);
(fun reg -> Fun reg);
(fun reg -> Rec reg);
(fun reg -> If reg);
(fun reg -> In reg);
(fun reg -> Let reg);
@ -294,7 +295,6 @@ let reserved =
|> add "object"
|> add "open"
|> add "private"
|> add "rec"
|> add "sig"
|> add "struct"
|> add "to"
@ -502,6 +502,7 @@ let is_kwd = function
| End _
| False _
| Fun _
| Rec _
| If _
| In _
| Let _

View File

@ -206,11 +206,12 @@ field_decl:
(* Top-level non-recursive definitions *)
let_declaration:
"let" let_binding seq(Attr) {
"let" ioption("rec") let_binding seq(Attr) {
let kwd_let = $1 in
let attributes = $3 in
let binding = $2 in
let value = kwd_let, binding, attributes in
let kwd_rec = $2 in
let attributes = $4 in
let binding = $3 in
let value = kwd_let, kwd_rec, binding, attributes in
let stop = expr_to_region binding.let_rhs in
let region = cover $1 stop
in {region; value} }

View File

@ -136,8 +136,9 @@ and print_attributes state attributes =
) attributes
and print_statement state = function
Let {value=kwd_let, let_binding, attributes; _} ->
Let {value=kwd_let, kwd_rec, let_binding, attributes; _} ->
print_token state kwd_let "let";
print_token_opt state kwd_rec "rec";
print_let_binding state let_binding;
print_attributes state attributes
| TypeDecl {value={kwd_type; name; eq; type_expr}; _} ->
@ -617,9 +618,14 @@ let rec pp_ast state {decl; _} =
List.iteri (List.length decls |> apply) decls
and pp_declaration state = function
Let {value = (_, let_binding, attr); region} ->
Let {value = (_, kwd_rec, let_binding, attr); region} ->
pp_loc_node state "Let" region;
(match kwd_rec with
| None -> ()
| Some (_) -> pp_node (state#pad 0 0) "rec"
);
pp_let_binding state let_binding attr;
| TypeDecl {value; region} ->
pp_loc_node state "TypeDecl" region;
pp_type_decl state value
@ -855,14 +861,21 @@ and pp_fun_expr state node =
in ()
and pp_let_in state node =
let {binding; body; attributes; _} = node in
let {binding; body; attributes; kwd_rec; _} = node in
let {binders; lhs_type; let_rhs; _} = binding in
let fields = if lhs_type = None then 3 else 4 in
let fields = if kwd_rec = None then fields else fields+1 in
let fields = if attributes = [] then fields else fields+1 in
let arity =
match kwd_rec with
None -> 0
| Some (_) ->
let state = state#pad fields 0 in
pp_node state "rec"; 0 in
let arity =
let state = state#pad fields 0 in
pp_node state "<binders>";
pp_binders state binders; 0 in
pp_binders state binders; arity in
let arity =
match lhs_type with
None -> arity

View File

@ -235,6 +235,7 @@ let keywords = [
(fun reg -> False reg);
(fun reg -> If reg);
(fun reg -> Let reg);
(fun reg -> Rec reg);
(fun reg -> Switch reg);
(fun reg -> Mod reg);
(fun reg -> Or reg);
@ -276,7 +277,6 @@ let reserved =
|> add "of"
|> add "open"
|> add "private"
|> add "rec"
|> add "sig"
|> add "struct"
|> add "then"
@ -481,6 +481,7 @@ let is_kwd = function
| False _
| If _
| Let _
| Rec _
| Switch _
| Mod _
| Or _

View File

@ -264,11 +264,12 @@ field_decl:
(* Top-level non-recursive definitions *)
let_declaration:
seq(Attr) "let" let_binding {
seq(Attr) "let" ioption("rec") let_binding {
let attributes = $1 in
let kwd_let = $2 in
let binding = $3 in
let value = kwd_let, binding, attributes in
let kwd_rec = $3 in
let binding = $4 in
let value = kwd_let, kwd_rec, binding, attributes in
let stop = expr_to_region binding.let_rhs in
let region = cover $2 stop
in {region; value} }

View File

@ -739,7 +739,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
let%bind type_expression = simpl_type_expression type_expr in
ok @@ [loc x @@ Declaration_type (Var.of_name name.value , type_expression)]
| Let x -> (
let (_, let_binding, attributes), _ = r_split x in
let (_, _rec, let_binding, attributes), _ = r_split x in
let inline = List.exists (fun (a: Raw.attribute) -> a.value = "inline") attributes in
let binding = let_binding in
let {binders; lhs_type; let_rhs} = binding in
@ -796,11 +796,11 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
in ok @@ decls
| PPar {region = _ ; value = { lpar = _ ; inside = pt; rpar = _; } } ->
(* Extract parenthetical multi-bind *)
let (wild, _, attributes) = fst @@ r_split x in
let (wild, _rec, _, attributes) = fst @@ r_split x in
simpl_declaration
(Let {
region = x.region;
value = (wild, {binders = (pt, []);
value = (wild, _rec, {binders = (pt, []);
lhs_type = lhs_type;
eq = Region.ghost ;
let_rhs = let_rhs}, attributes)}

View File

@ -0,0 +1,5 @@
// Test while loops in PascaLIGO
let rec fibo = (n : int, acc: int): int =>
if (n < 1) {acc;}
else {fibo (n-1,acc+n);};

View File

@ -1507,6 +1507,13 @@ let recursion_mligo () : unit result =
let%bind _ = expect_eq program "fibo" make_input make_expected in
ok ()
let recursion_religo () : unit result =
let%bind program = retype_file "./contracts/recursion.religo" in
let make_input = e_pair (e_int 10) (e_int 0) in
let make_expected = e_int 55 in
let%bind _ = expect_eq program "fibo" make_input make_expected in
ok ()
let guess_string_mligo () : unit result =
let%bind program = type_file "./contracts/guess_string.mligo" in
let make_input = fun n -> e_pair (e_int n) (e_int 42) in
@ -2421,8 +2428,9 @@ let main = test_suite "Integration (End to End)" [
test "failwith ligo" failwith_ligo ;
test "failwith mligo" failwith_mligo ;
test "assert mligo" assert_mligo ;
test "recursion (ligo)" recursion_ligo ;
test "recursion (mligo)" recursion_mligo ;
(* test "recursion (ligo)" recursion_ligo ; *)
(* test "recursion (mligo)" recursion_mligo ; *)
test "recursion (religo)" recursion_religo ;
(* test "guess string mligo" guess_string_mligo ; WIP? *)
test "lambda mligo" lambda_mligo ;
test "lambda religo" lambda_religo ;