fix bug in string; add address in expressions in pascaligo; add type annotations for expressions in pascaligo
This commit is contained in:
parent
14ad75892c
commit
260c56ad58
@ -80,9 +80,11 @@ let e_variable v = E_variable v
|
||||
let e_failwith v = E_failwith v
|
||||
|
||||
let e_a_unit : annotated_expression = make_e_a_full (e_unit ()) t_unit
|
||||
let e_a_string s : annotated_expression = make_e_a_full (e_string s) t_string
|
||||
let e_a_int n : annotated_expression = make_e_a_full (e_int n) t_int
|
||||
let e_a_nat n : annotated_expression = make_e_a_full (e_nat n) t_nat
|
||||
let e_a_bool b : annotated_expression = make_e_a_full (e_bool b) t_bool
|
||||
let e_a_list lst : annotated_expression = make_e_a (e_list lst)
|
||||
let e_a_constructor s a : annotated_expression = make_e_a (e_constructor s a)
|
||||
let e_a_address x = make_e_a_full (e_address x) t_address
|
||||
let e_a_tez x = make_e_a_full (e_tez x) t_tez
|
||||
@ -117,11 +119,11 @@ let e_a_some opt =
|
||||
) in
|
||||
make_e_a ?type_annotation (e_some opt)
|
||||
|
||||
let e_a_none t_opt =
|
||||
let e_a_typed_none t_opt =
|
||||
let type_annotation = t_option t_opt in
|
||||
make_e_a ~type_annotation e_none
|
||||
|
||||
let e_a_list lst t =
|
||||
let e_a_typed_list lst t =
|
||||
make_e_a ~type_annotation:(t_list t) (e_list lst)
|
||||
|
||||
let e_a_map lst k v = make_e_a ~type_annotation:(t_map k v) (e_map lst)
|
||||
|
5
src/ligo/contracts/annotation.ligo
Normal file
5
src/ligo/contracts/annotation.ligo
Normal file
@ -0,0 +1,5 @@
|
||||
const lst : list(int) = list [] ;
|
||||
|
||||
const address : address = "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ;
|
||||
|
||||
const address_2 : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ;
|
@ -2,5 +2,5 @@ type some_type is int
|
||||
|
||||
function main (const p : int ; const s : some_type) : (list(operation) * int) is
|
||||
block { skip } // skip is a do nothing instruction, needed for empty blocks
|
||||
with ((nil : operation), p + s)
|
||||
with ((nil : list(operation)), p + s)
|
||||
|
||||
|
@ -9,7 +9,7 @@ function decrement(const i : int ; const n : int) : int is
|
||||
block { skip } with (i - n)
|
||||
|
||||
function main (const p : action ; const s : int) : (list(operation) * int) is
|
||||
block {skip} with ((nil : operation),
|
||||
block {skip} with ((nil : list(operation)),
|
||||
case p of
|
||||
| Increment n -> increment(s , n)
|
||||
| Decrement n -> decrement(s , n)
|
||||
|
1
src/ligo/contracts/string.ligo
Normal file
1
src/ligo/contracts/string.ligo
Normal file
@ -0,0 +1 @@
|
||||
const s : string = "toto"
|
@ -3,7 +3,7 @@ type action is
|
||||
| Decrement of int
|
||||
|
||||
function main (const p : action ; const s : int) : (list(operation) * int) is
|
||||
block {skip} with ((nil : operation),
|
||||
block {skip} with ((nil : list(operation)),
|
||||
case p of
|
||||
| Increment n -> s + n
|
||||
| Decrement n -> s - n
|
||||
|
@ -491,6 +491,7 @@ and for_collect = {
|
||||
|
||||
and expr =
|
||||
| ECase of expr case reg
|
||||
| EAnnot of annot_expr reg
|
||||
| ELogic of logic_expr
|
||||
| EArith of arith_expr
|
||||
| EString of string_expr
|
||||
@ -507,6 +508,8 @@ and expr =
|
||||
| ETuple of tuple_expr
|
||||
| EPar of expr par reg
|
||||
|
||||
and annot_expr = (expr * type_expr)
|
||||
|
||||
and set_expr =
|
||||
SetInj of expr injection reg
|
||||
| SetMem of set_membership reg
|
||||
@ -587,17 +590,13 @@ and string_expr =
|
||||
and list_expr =
|
||||
Cons of cons bin_op reg
|
||||
| List of expr injection reg
|
||||
| Nil of nil par reg
|
||||
| Nil of nil
|
||||
|
||||
and nil = {
|
||||
nil : kwd_nil;
|
||||
colon : colon;
|
||||
list_type : type_expr
|
||||
}
|
||||
and nil = kwd_nil
|
||||
|
||||
and constr_expr =
|
||||
SomeApp of (c_Some * arguments) reg
|
||||
| NoneExpr of none_expr reg
|
||||
| NoneExpr of none_expr
|
||||
| ConstrApp of (constr * arguments) reg
|
||||
|
||||
and record_expr = field_assign reg injection reg
|
||||
@ -623,13 +622,7 @@ and tuple_expr =
|
||||
|
||||
and tuple_injection = (expr, comma) nsepseq par reg
|
||||
|
||||
and none_expr = typed_none_expr par
|
||||
|
||||
and typed_none_expr = {
|
||||
c_None : c_None;
|
||||
colon : colon;
|
||||
opt_type : type_expr
|
||||
}
|
||||
and none_expr = c_None
|
||||
|
||||
and fun_call = (fun_name * arguments) reg
|
||||
|
||||
@ -675,6 +668,7 @@ let rec expr_to_region = function
|
||||
| ELogic e -> logic_expr_to_region e
|
||||
| EArith e -> arith_expr_to_region e
|
||||
| EString e -> string_expr_to_region e
|
||||
| EAnnot e -> annot_expr_to_region e
|
||||
| EList e -> list_expr_to_region e
|
||||
| ESet e -> set_expr_to_region e
|
||||
| EConstr e -> constr_expr_to_region e
|
||||
@ -734,13 +728,15 @@ and string_expr_to_region = function
|
||||
Cat {region; _}
|
||||
| String {region; _} -> region
|
||||
|
||||
and annot_expr_to_region ({region; _}) = region
|
||||
|
||||
and list_expr_to_region = function
|
||||
Cons {region; _}
|
||||
| List {region; _}
|
||||
| Nil {region; _} -> region
|
||||
| Nil region -> region
|
||||
|
||||
and constr_expr_to_region = function
|
||||
NoneExpr {region; _}
|
||||
NoneExpr region
|
||||
| ConstrApp {region; _}
|
||||
| SomeApp {region; _} -> region
|
||||
|
||||
|
@ -474,7 +474,8 @@ and for_collect = {
|
||||
(* Expressions *)
|
||||
|
||||
and expr =
|
||||
ECase of expr case reg
|
||||
| ECase of expr case reg
|
||||
| EAnnot of annot_expr reg
|
||||
| ELogic of logic_expr
|
||||
| EArith of arith_expr
|
||||
| EString of string_expr
|
||||
@ -491,6 +492,8 @@ and expr =
|
||||
| ETuple of tuple_expr
|
||||
| EPar of expr par reg
|
||||
|
||||
and annot_expr = (expr * type_expr)
|
||||
|
||||
and set_expr =
|
||||
SetInj of expr injection reg
|
||||
| SetMem of set_membership reg
|
||||
@ -571,17 +574,13 @@ and string_expr =
|
||||
and list_expr =
|
||||
Cons of cons bin_op reg
|
||||
| List of expr injection reg
|
||||
| Nil of nil par reg
|
||||
| Nil of nil
|
||||
|
||||
and nil = {
|
||||
nil : kwd_nil;
|
||||
colon : colon;
|
||||
list_type : type_expr
|
||||
}
|
||||
and nil = kwd_nil
|
||||
|
||||
and constr_expr =
|
||||
SomeApp of (c_Some * arguments) reg
|
||||
| NoneExpr of none_expr reg
|
||||
| NoneExpr of none_expr
|
||||
| ConstrApp of (constr * arguments) reg
|
||||
|
||||
and record_expr = field_assign reg injection reg
|
||||
@ -607,13 +606,7 @@ and tuple_expr =
|
||||
|
||||
and tuple_injection = (expr, comma) nsepseq par reg
|
||||
|
||||
and none_expr = typed_none_expr par
|
||||
|
||||
and typed_none_expr = {
|
||||
c_None : c_None;
|
||||
colon : colon;
|
||||
opt_type : type_expr
|
||||
}
|
||||
and none_expr = c_None
|
||||
|
||||
and fun_call = (fun_name * arguments) reg
|
||||
|
||||
|
@ -438,24 +438,9 @@ unqualified_decl(OP):
|
||||
match $5 with
|
||||
`Expr e -> e, expr_to_region e
|
||||
| `EList kwd_nil ->
|
||||
let value = {
|
||||
nil = kwd_nil;
|
||||
colon = Region.ghost;
|
||||
list_type = $3} in
|
||||
let value = {
|
||||
lpar = Region.ghost;
|
||||
inside = value;
|
||||
rpar = Region.ghost} in
|
||||
EList (Nil {region=kwd_nil; value}), kwd_nil
|
||||
EList (Nil kwd_nil), kwd_nil
|
||||
| `ENone region ->
|
||||
let value = {
|
||||
lpar = Region.ghost;
|
||||
inside = {
|
||||
c_None = region;
|
||||
colon = Region.ghost;
|
||||
opt_type = $3};
|
||||
rpar = Region.ghost}
|
||||
in EConstr (NoneExpr {region; value}), region
|
||||
EConstr (NoneExpr region), region
|
||||
in $1, $2, $3, $4, init, region}
|
||||
|
||||
const_decl:
|
||||
@ -474,8 +459,6 @@ var_decl:
|
||||
|
||||
extended_expr:
|
||||
expr { `Expr $1 }
|
||||
| Nil { `EList $1 }
|
||||
| C_None { `ENone $1 }
|
||||
|
||||
instruction:
|
||||
single_instr { Single $1 }
|
||||
@ -724,7 +707,6 @@ assignment:
|
||||
|
||||
rhs:
|
||||
expr { Expr $1 }
|
||||
| C_None { NoneExpr $1 : rhs }
|
||||
|
||||
lhs:
|
||||
path { Path $1 }
|
||||
@ -786,8 +768,17 @@ interactive_expr:
|
||||
|
||||
expr:
|
||||
case(expr) { ECase ($1 expr_to_region) }
|
||||
| disj_expr { $1 }
|
||||
| annot_expr { $1 }
|
||||
|
||||
annot_expr:
|
||||
LPAR disj_expr COLON type_expr RPAR {
|
||||
let start = expr_to_region $2
|
||||
and stop = type_expr_to_region $4 in
|
||||
let region = cover start stop
|
||||
and value = ($2 , $4) in
|
||||
(EAnnot {region; value})
|
||||
}
|
||||
| disj_expr { $1 }
|
||||
|
||||
disj_expr:
|
||||
disj_expr Or conj_expr {
|
||||
@ -955,7 +946,7 @@ core_expr:
|
||||
| C_Unit { EUnit $1 }
|
||||
| tuple_expr { ETuple $1 }
|
||||
| list_expr { EList $1 }
|
||||
| none_expr { EConstr (NoneExpr $1) }
|
||||
| C_None { EConstr (NoneExpr $1) }
|
||||
| fun_call { ECall $1 }
|
||||
| map_expr { EMap $1 }
|
||||
| set_expr { ESet $1 }
|
||||
@ -1046,25 +1037,7 @@ arguments:
|
||||
|
||||
list_expr:
|
||||
injection(List,expr) { List $1 }
|
||||
| nil { Nil $1 }
|
||||
|
||||
nil:
|
||||
par(typed_empty_list) { $1 }
|
||||
|
||||
typed_empty_list:
|
||||
Nil COLON type_expr {
|
||||
{nil = $1;
|
||||
colon = $2;
|
||||
list_type = $3}}
|
||||
|
||||
none_expr:
|
||||
par(typed_none_expr) { $1 }
|
||||
|
||||
typed_none_expr:
|
||||
C_None COLON type_expr {
|
||||
{c_None = $1;
|
||||
colon = $2;
|
||||
opt_type = $3}}
|
||||
| Nil { Nil $1 }
|
||||
|
||||
(* Patterns *)
|
||||
|
||||
|
@ -411,6 +411,7 @@ and print_bind_to = function
|
||||
|
||||
and print_expr = function
|
||||
ECase {value;_} -> print_case_expr value
|
||||
| EAnnot {value;_} -> print_annot_expr value
|
||||
| ELogic e -> print_logic_expr e
|
||||
| EArith e -> print_arith_expr e
|
||||
| EString e -> print_string_expr e
|
||||
@ -427,6 +428,10 @@ and print_expr = function
|
||||
| ETuple e -> print_tuple_expr e
|
||||
| EPar e -> print_par_expr e
|
||||
|
||||
and print_annot_expr (expr , type_expr) =
|
||||
print_expr expr ;
|
||||
print_type_expr type_expr
|
||||
|
||||
and print_case_expr (node : expr case) =
|
||||
let {kwd_case; expr; opening;
|
||||
lead_vbar; cases; closing} = node in
|
||||
@ -625,23 +630,11 @@ and print_tuple_inj {value; _} =
|
||||
print_nsepseq "," print_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_nil {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
let {nil; colon; list_type} = inside in
|
||||
print_token lpar "(";
|
||||
print_token nil "nil";
|
||||
print_token colon ":";
|
||||
print_type_expr list_type;
|
||||
print_token rpar ")"
|
||||
and print_nil value =
|
||||
print_token value "nil";
|
||||
|
||||
and print_none_expr {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
let {c_None; colon; opt_type} = inside in
|
||||
print_token lpar "(";
|
||||
print_token c_None "None";
|
||||
print_token colon ":";
|
||||
print_type_expr opt_type;
|
||||
print_token rpar ")"
|
||||
and print_none_expr value =
|
||||
print_token value "None";
|
||||
|
||||
and print_fun_call {value; _} =
|
||||
let fun_name, arguments = value in
|
||||
|
@ -76,8 +76,8 @@ and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result
|
||||
let%bind lst = bind_list @@ List.map simpl_type_expression lst in
|
||||
ok @@ T_tuple lst
|
||||
|
||||
let rec simpl_expression (t:Raw.expr) : ae result =
|
||||
let return x = ok @@ make_e_a x in
|
||||
let rec simpl_expression ?te_annot (t:Raw.expr) : ae result =
|
||||
let return x = ok @@ make_e_a ?type_annotation:te_annot x in
|
||||
let simpl_projection = fun (p:Raw.projection) ->
|
||||
let var =
|
||||
let name = p.struct_name.value in
|
||||
@ -90,9 +90,19 @@ let rec simpl_expression (t:Raw.expr) : ae result =
|
||||
| Component index -> Access_tuple (Z.to_int (snd index.value))
|
||||
in
|
||||
List.map aux @@ npseq_to_list path in
|
||||
ok @@ make_e_a @@ E_accessor (var, path')
|
||||
return @@ E_accessor (var, path')
|
||||
in
|
||||
match t with
|
||||
| EAnnot a -> (
|
||||
let (expr , type_expr) = a.value in
|
||||
match te_annot with
|
||||
| None -> (
|
||||
let%bind te_annot = simpl_type_expression type_expr in
|
||||
let%bind expr' = simpl_expression ~te_annot expr in
|
||||
ok expr'
|
||||
)
|
||||
| Some _ -> simple_fail "no double annotation"
|
||||
)
|
||||
| EVar c -> (
|
||||
let c' = c.value in
|
||||
match List.assoc_opt c' constants with
|
||||
@ -113,20 +123,20 @@ let rec simpl_expression (t:Raw.expr) : ae result =
|
||||
match List.assoc_opt f constants with
|
||||
| None ->
|
||||
let%bind arg = simpl_tuple_expression args' in
|
||||
ok @@ make_e_a @@ E_application (make_e_a @@ E_variable f, arg)
|
||||
return @@ E_application (make_e_a @@ E_variable f, arg)
|
||||
| Some arity ->
|
||||
let%bind _arity =
|
||||
trace (simple_error "wrong arity for constants") @@
|
||||
Assert.assert_equal_int arity (List.length args') in
|
||||
let%bind lst = bind_map_list simpl_expression args' in
|
||||
ok @@ make_e_a @@ E_constant (f, lst)
|
||||
return @@ E_constant (f, lst)
|
||||
)
|
||||
| EPar x -> simpl_expression x.value.inside
|
||||
| EUnit _ -> ok @@ make_e_a @@ E_literal Literal_unit
|
||||
| EBytes x -> ok @@ make_e_a @@ E_literal (Literal_bytes (Bytes.of_string @@ fst x.value))
|
||||
| EPar x -> simpl_expression ?te_annot x.value.inside
|
||||
| EUnit _ -> return @@ E_literal Literal_unit
|
||||
| EBytes x -> return @@ E_literal (Literal_bytes (Bytes.of_string @@ fst x.value))
|
||||
| ETuple tpl ->
|
||||
let (Raw.TupleInj tpl') = tpl in
|
||||
simpl_tuple_expression
|
||||
simpl_tuple_expression ?te_annot
|
||||
@@ npseq_to_list tpl'.value.inside
|
||||
| ERecord r ->
|
||||
let%bind fields = bind_list
|
||||
@ -134,7 +144,7 @@ let rec simpl_expression (t:Raw.expr) : ae result =
|
||||
@@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
|
||||
@@ pseq_to_list r.value.elements in
|
||||
let aux prev (k, v) = SMap.add k v prev in
|
||||
ok @@ make_e_a @@ E_record (List.fold_left aux SMap.empty fields)
|
||||
return @@ E_record (List.fold_left aux SMap.empty fields)
|
||||
| EProj p' -> (
|
||||
let p = p'.value in
|
||||
simpl_projection p
|
||||
@ -144,42 +154,44 @@ let rec simpl_expression (t:Raw.expr) : ae result =
|
||||
let%bind arg =
|
||||
simpl_tuple_expression
|
||||
@@ npseq_to_list args.value.inside in
|
||||
ok @@ make_e_a @@ E_constructor (c.value, arg)
|
||||
return @@ E_constructor (c.value, arg)
|
||||
| EConstr (SomeApp a) ->
|
||||
let (_, args) = a.value in
|
||||
let%bind arg =
|
||||
simpl_tuple_expression
|
||||
@@ npseq_to_list args.value.inside in
|
||||
ok @@ make_e_a @@ E_constant ("SOME", [arg])
|
||||
| EConstr (NoneExpr n) ->
|
||||
let type_expr = n.value.inside.opt_type in
|
||||
let%bind type_expr' = simpl_type_expression type_expr in
|
||||
ok @@ make_e_a_full (E_constant ("NONE", [])) (Combinators.t_option type_expr')
|
||||
return @@ E_constant ("SOME", [arg])
|
||||
| EConstr (NoneExpr _) ->
|
||||
return @@ E_constant ("NONE" , [])
|
||||
| EArith (Add c) ->
|
||||
simpl_binop "ADD" c.value
|
||||
simpl_binop ?te_annot "ADD" c.value
|
||||
| EArith (Sub c) ->
|
||||
simpl_binop "SUB" c.value
|
||||
simpl_binop ?te_annot "SUB" c.value
|
||||
| EArith (Mult c) ->
|
||||
simpl_binop "TIMES" c.value
|
||||
simpl_binop ?te_annot "TIMES" c.value
|
||||
| EArith (Div c) ->
|
||||
simpl_binop "DIV" c.value
|
||||
simpl_binop ?te_annot "DIV" c.value
|
||||
| EArith (Mod c) ->
|
||||
simpl_binop "MOD" c.value
|
||||
simpl_binop ?te_annot "MOD" c.value
|
||||
| EArith (Int n) ->
|
||||
let n = Z.to_int @@ snd @@ n.value in
|
||||
ok @@ make_e_a @@ E_literal (Literal_int n)
|
||||
return @@ E_literal (Literal_int n)
|
||||
| EArith (Nat n) ->
|
||||
let n = Z.to_int @@ snd @@ n.value in
|
||||
ok @@ make_e_a @@ E_literal (Literal_nat n)
|
||||
return @@ E_literal (Literal_nat n)
|
||||
| EArith (Mtz n) ->
|
||||
let n = Z.to_int @@ snd @@ n.value in
|
||||
ok @@ make_e_a @@ E_literal (Literal_tez n)
|
||||
return @@ E_literal (Literal_tez n)
|
||||
| EArith _ -> simple_fail "arith: not supported yet"
|
||||
| EString (String s) ->
|
||||
ok @@ make_e_a @@ E_literal (Literal_string s.value)
|
||||
let s' =
|
||||
let s = s.value in
|
||||
String.(sub s 1 ((length s) - 2))
|
||||
in
|
||||
return @@ E_literal (Literal_string s')
|
||||
| EString _ -> simple_fail "string: not supported yet"
|
||||
| ELogic l -> simpl_logic_expression l
|
||||
| EList l -> simpl_list_expression l
|
||||
| ELogic l -> simpl_logic_expression ?te_annot l
|
||||
| EList l -> simpl_list_expression ?te_annot l
|
||||
| ESet _ -> simple_fail "set: not supported yet"
|
||||
| ECase c ->
|
||||
let%bind e = simpl_expression c.value.expr in
|
||||
@ -192,7 +204,7 @@ let rec simpl_expression (t:Raw.expr) : ae result =
|
||||
@@ List.map get_value
|
||||
@@ npseq_to_list c.value.cases.value in
|
||||
let%bind cases = simpl_cases lst in
|
||||
ok @@ make_e_a @@ E_matching (e, cases)
|
||||
return @@ E_matching (e, cases)
|
||||
| EMap (MapInj mi) ->
|
||||
let%bind lst =
|
||||
let lst = List.map get_value @@ pseq_to_list mi.value.elements in
|
||||
@ -210,62 +222,64 @@ let rec simpl_expression (t:Raw.expr) : ae result =
|
||||
let%bind index = simpl_expression lu.value.index.value.inside in
|
||||
return (E_look_up (path, index))
|
||||
|
||||
and simpl_logic_expression (t:Raw.logic_expr) : annotated_expression result =
|
||||
and simpl_logic_expression ?te_annot (t:Raw.logic_expr) : annotated_expression result =
|
||||
let return x = ok @@ make_e_a ?type_annotation:te_annot x in
|
||||
match t with
|
||||
| BoolExpr (False _) ->
|
||||
ok @@ make_e_a @@ E_literal (Literal_bool false)
|
||||
return @@ E_literal (Literal_bool false)
|
||||
| BoolExpr (True _) ->
|
||||
ok @@ make_e_a @@ E_literal (Literal_bool true)
|
||||
return @@ E_literal (Literal_bool true)
|
||||
| BoolExpr (Or b) ->
|
||||
simpl_binop "OR" b.value
|
||||
simpl_binop ?te_annot "OR" b.value
|
||||
| BoolExpr (And b) ->
|
||||
simpl_binop "AND" b.value
|
||||
simpl_binop ?te_annot "AND" b.value
|
||||
| BoolExpr (Not b) ->
|
||||
simpl_unop "NOT" b.value
|
||||
simpl_unop ?te_annot "NOT" b.value
|
||||
| CompExpr (Lt c) ->
|
||||
simpl_binop "LT" c.value
|
||||
simpl_binop ?te_annot "LT" c.value
|
||||
| CompExpr (Gt c) ->
|
||||
simpl_binop "GT" c.value
|
||||
simpl_binop ?te_annot "GT" c.value
|
||||
| CompExpr (Leq c) ->
|
||||
simpl_binop "LE" c.value
|
||||
simpl_binop ?te_annot "LE" c.value
|
||||
| CompExpr (Geq c) ->
|
||||
simpl_binop "GE" c.value
|
||||
simpl_binop ?te_annot "GE" c.value
|
||||
| CompExpr (Equal c) ->
|
||||
simpl_binop "EQ" c.value
|
||||
simpl_binop ?te_annot "EQ" c.value
|
||||
| CompExpr (Neq c) ->
|
||||
simpl_binop "NEQ" c.value
|
||||
simpl_binop ?te_annot "NEQ" c.value
|
||||
|
||||
and simpl_list_expression (t:Raw.list_expr) : annotated_expression result =
|
||||
and simpl_list_expression ?te_annot (t:Raw.list_expr) : annotated_expression result =
|
||||
let return x = ok @@ make_e_a ?type_annotation:te_annot x in
|
||||
match t with
|
||||
| Cons c ->
|
||||
simpl_binop "CONS" c.value
|
||||
simpl_binop ?te_annot "CONS" c.value
|
||||
| List lst ->
|
||||
let%bind lst' =
|
||||
bind_map_list simpl_expression @@
|
||||
pseq_to_list lst.value.elements in
|
||||
ok (make_e_a (E_list lst'))
|
||||
| Nil n ->
|
||||
let n' = n.value.inside in
|
||||
let%bind t' = simpl_type_expression n'.list_type in
|
||||
let e' = E_list [] in
|
||||
ok (make_e_a_full e' (t_list t'))
|
||||
return @@ E_list lst'
|
||||
| Nil _ ->
|
||||
return @@ E_list []
|
||||
|
||||
and simpl_binop (name:string) (t:_ Raw.bin_op) : annotated_expression result =
|
||||
and simpl_binop ?te_annot (name:string) (t:_ Raw.bin_op) : annotated_expression result =
|
||||
let return x = ok @@ make_e_a ?type_annotation:te_annot x in
|
||||
let%bind a = simpl_expression t.arg1 in
|
||||
let%bind b = simpl_expression t.arg2 in
|
||||
ok @@ make_e_a @@ E_constant (name, [a;b])
|
||||
return @@ E_constant (name, [a;b])
|
||||
|
||||
and simpl_unop (name:string) (t:_ Raw.un_op) : annotated_expression result =
|
||||
and simpl_unop ?te_annot (name:string) (t:_ Raw.un_op) : annotated_expression result =
|
||||
let return x = ok @@ make_e_a ?type_annotation:te_annot x in
|
||||
let%bind a = simpl_expression t.arg in
|
||||
ok @@ make_e_a @@ E_constant (name, [a])
|
||||
return @@ E_constant (name, [a])
|
||||
|
||||
and simpl_tuple_expression (lst:Raw.expr list) : annotated_expression result =
|
||||
and simpl_tuple_expression ?te_annot (lst:Raw.expr list) : annotated_expression result =
|
||||
let return x = ok @@ make_e_a ?type_annotation:te_annot x in
|
||||
match lst with
|
||||
| [] -> ok @@ make_e_a @@ E_literal Literal_unit
|
||||
| [hd] -> simpl_expression hd
|
||||
| [] -> return @@ E_literal Literal_unit
|
||||
| [hd] -> simpl_expression ?te_annot hd
|
||||
| lst ->
|
||||
let%bind lst = bind_list @@ List.map simpl_expression lst in
|
||||
ok @@ make_e_a @@ E_tuple lst
|
||||
return @@ E_tuple lst
|
||||
|
||||
and simpl_local_declaration (t:Raw.local_decl) : (instruction * named_expression) result =
|
||||
match t with
|
||||
@ -288,16 +302,14 @@ and simpl_data_declaration (t:Raw.data_decl) : (instruction * named_expression)
|
||||
let x = x.value in
|
||||
let name = x.name.value in
|
||||
let%bind t = simpl_type_expression x.var_type in
|
||||
let type_annotation = Some t in
|
||||
let%bind expression = simpl_expression x.init in
|
||||
return {name;annotated_expression={expression with type_annotation}}
|
||||
let%bind annotated_expression = simpl_expression ~te_annot:t x.init in
|
||||
return {name;annotated_expression}
|
||||
| LocalConst x ->
|
||||
let x = x.value in
|
||||
let name = x.name.value in
|
||||
let%bind t = simpl_type_expression x.const_type in
|
||||
let type_annotation = Some t in
|
||||
let%bind expression = simpl_expression x.init in
|
||||
return {name;annotated_expression={expression with type_annotation}}
|
||||
let%bind annotated_expression = simpl_expression ~te_annot:t x.init in
|
||||
return {name;annotated_expression}
|
||||
|
||||
|
||||
and simpl_param : Raw.param_decl -> named_type_expression result = fun t ->
|
||||
|
@ -99,7 +99,7 @@ let buy () =
|
||||
e_a_pair buy_action storage
|
||||
in
|
||||
let make_expected = fun n ->
|
||||
let ops = e_a_list [] t_operation in
|
||||
let ops = e_a_typed_list [] t_operation in
|
||||
let storage =
|
||||
let cards =
|
||||
cards_ez first_owner n @
|
||||
@ -138,7 +138,7 @@ let dispatch_buy () =
|
||||
e_a_pair action storage
|
||||
in
|
||||
let make_expected = fun n ->
|
||||
let ops = e_a_list [] t_operation in
|
||||
let ops = e_a_typed_list [] t_operation in
|
||||
let storage =
|
||||
let cards =
|
||||
cards_ez first_owner n @
|
||||
@ -177,7 +177,7 @@ let transfer () =
|
||||
e_a_pair transfer_action storage
|
||||
in
|
||||
let make_expected = fun n ->
|
||||
let ops = e_a_list [] t_operation in
|
||||
let ops = e_a_typed_list [] t_operation in
|
||||
let storage =
|
||||
let cards =
|
||||
let new_card = card_ez second_owner in
|
||||
|
@ -15,6 +15,19 @@ let function_ () : unit result =
|
||||
let make_expect = fun n -> n in
|
||||
expect_eq_n_int program "main" make_expect
|
||||
|
||||
let annotation () : unit result =
|
||||
let%bind program = type_file "./contracts/annotation.ligo" in
|
||||
let%bind () =
|
||||
expect_eq_evaluate program "lst" (e_a_list [])
|
||||
in
|
||||
let%bind () =
|
||||
expect_eq_evaluate program "address" (e_a_address "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")
|
||||
in
|
||||
let%bind () =
|
||||
expect_eq_evaluate program "address_2" (e_a_address "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")
|
||||
in
|
||||
ok ()
|
||||
|
||||
let complex_function () : unit result =
|
||||
let%bind program = type_file "./contracts/function-complex.ligo" in
|
||||
let make_expect = fun n -> (3 * n + 2) in
|
||||
@ -119,6 +132,10 @@ let unit_expression () : unit result =
|
||||
let%bind program = type_file "./contracts/unit.ligo" in
|
||||
expect_eq_evaluate program "u" e_a_unit
|
||||
|
||||
let string_expression () : unit result =
|
||||
let%bind program = type_file "./contracts/string.ligo" in
|
||||
expect_eq_evaluate program "s" (e_a_string "toto")
|
||||
|
||||
let include_ () : unit result =
|
||||
let%bind program = type_file "./contracts/includer.ligo" in
|
||||
expect_eq_evaluate program "bar" (e_a_int 144)
|
||||
@ -217,7 +234,7 @@ let option () : unit result =
|
||||
expect_eq_evaluate program "s" expected
|
||||
in
|
||||
let%bind () =
|
||||
let expected = e_a_none t_int in
|
||||
let expected = e_a_typed_none t_int in
|
||||
expect_eq_evaluate program "n" expected
|
||||
in
|
||||
ok ()
|
||||
@ -271,7 +288,7 @@ let list () : unit result =
|
||||
let%bind program = type_file "./contracts/list.ligo" in
|
||||
let ez lst =
|
||||
let lst' = List.map e_a_int lst in
|
||||
e_a_list lst' t_int
|
||||
e_a_typed_list lst' t_int
|
||||
in
|
||||
let%bind () =
|
||||
let make_input = fun n -> (ez @@ List.range n) in
|
||||
@ -330,7 +347,7 @@ let matching () : unit result =
|
||||
let aux n =
|
||||
let input = match n with
|
||||
| Some s -> e_a_some (e_a_int s)
|
||||
| None -> e_a_none t_int in
|
||||
| None -> e_a_typed_none t_int in
|
||||
let expected = e_a_int (match n with
|
||||
| Some s -> s
|
||||
| None -> 23) in
|
||||
@ -344,7 +361,7 @@ let matching () : unit result =
|
||||
let aux n =
|
||||
let input = match n with
|
||||
| Some s -> e_a_some (e_a_int s)
|
||||
| None -> e_a_none t_int in
|
||||
| None -> e_a_typed_none t_int in
|
||||
let expected = e_a_int (match n with
|
||||
| Some s -> s
|
||||
| None -> 42) in
|
||||
@ -377,7 +394,7 @@ let quote_declarations () : unit result =
|
||||
let counter_contract () : unit result =
|
||||
let%bind program = type_file "./contracts/counter.ligo" in
|
||||
let make_input = fun n-> e_a_pair (e_a_int n) (e_a_int 42) in
|
||||
let make_expected = fun n -> e_a_pair (e_a_list [] t_operation) (e_a_int (42 + n)) in
|
||||
let make_expected = fun n -> e_a_pair (e_a_typed_list [] t_operation) (e_a_int (42 + n)) in
|
||||
expect_eq_n program "main" make_input make_expected
|
||||
|
||||
let super_counter_contract () : unit result =
|
||||
@ -387,7 +404,7 @@ let super_counter_contract () : unit result =
|
||||
e_a_pair (e_a_constructor action (e_a_int n)) (e_a_int 42) in
|
||||
let make_expected = fun n ->
|
||||
let op = if n mod 2 = 0 then (+) else (-) in
|
||||
e_a_pair (e_a_list [] t_operation) (e_a_int (op 42 n)) in
|
||||
e_a_pair (e_a_typed_list [] t_operation) (e_a_int (op 42 n)) in
|
||||
expect_eq_n program "main" make_input make_expected
|
||||
|
||||
let dispatch_counter_contract () : unit result =
|
||||
@ -397,7 +414,7 @@ let dispatch_counter_contract () : unit result =
|
||||
e_a_pair (e_a_constructor action (e_a_int n)) (e_a_int 42) in
|
||||
let make_expected = fun n ->
|
||||
let op = if n mod 2 = 0 then (+) else (-) in
|
||||
e_a_pair (e_a_list [] t_operation) (e_a_int (op 42 n)) in
|
||||
e_a_pair (e_a_typed_list [] t_operation) (e_a_int (op 42 n)) in
|
||||
expect_eq_n program "main" make_input make_expected
|
||||
|
||||
let basic_mligo () : unit result =
|
||||
@ -408,13 +425,13 @@ let basic_mligo () : unit result =
|
||||
let counter_mligo () : unit result =
|
||||
let%bind program = mtype_file "./contracts/counter.mligo" in
|
||||
let make_input = fun n-> e_a_pair (e_a_int n) (e_a_int 42) in
|
||||
let make_expected = fun n -> e_a_pair (e_a_list [] t_operation) (e_a_int (42 + n)) in
|
||||
let make_expected = fun n -> e_a_pair (e_a_typed_list [] t_operation) (e_a_int (42 + n)) in
|
||||
expect_eq_n program "main" make_input make_expected
|
||||
|
||||
let guess_the_hash_mligo () : unit result =
|
||||
let%bind program = mtype_file "./contracts/new-syntax.mligo" in
|
||||
let make_input = fun n-> e_a_pair (e_a_int n) (e_a_int 42) in
|
||||
let make_expected = fun n -> e_a_pair (e_a_list [] t_operation) (e_a_int (42 + n)) in
|
||||
let make_expected = fun n -> e_a_pair (e_a_typed_list [] t_operation) (e_a_int (42 + n)) in
|
||||
expect_eq_n program "main" make_input make_expected
|
||||
|
||||
let main = "Integration (End to End)", [
|
||||
@ -426,10 +443,12 @@ let main = "Integration (End to End)", [
|
||||
test "record" record ;
|
||||
test "condition" condition ;
|
||||
test "shadow" shadow ;
|
||||
test "annotation" annotation ;
|
||||
test "multiple parameters" multiple_parameters ;
|
||||
test "bool" bool_expression ;
|
||||
test "arithmetic" arithmetic ;
|
||||
test "unit" unit_expression ;
|
||||
test "string" string_expression ;
|
||||
test "option" option ;
|
||||
test "map" map ;
|
||||
test "list" list ;
|
||||
|
@ -332,6 +332,7 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_value result =
|
||||
return (T_constant(cst, lst'))
|
||||
|
||||
and type_annotated_expression : environment -> I.annotated_expression -> O.annotated_expression result = fun e ae ->
|
||||
let module L = Logger.Stateful() in
|
||||
let%bind tv_opt = match ae.type_annotation with
|
||||
| None -> ok None
|
||||
| Some s -> let%bind r = evaluate_type e s in ok (Some r) in
|
||||
@ -341,7 +342,7 @@ and type_annotated_expression : environment -> I.annotated_expression -> O.annot
|
||||
ok @@ make_a_e expr type_annotation e in
|
||||
let main_error =
|
||||
let title () = "typing annotated_expression" in
|
||||
let content () = Format.asprintf "%a" I.PP.annotated_expression ae in
|
||||
let content () = Format.asprintf "Expression: %a\nLog: %s\n" I.PP.annotated_expression ae (L.get()) in
|
||||
error title content in
|
||||
trace main_error @@
|
||||
match ae.expression with
|
||||
@ -357,8 +358,9 @@ and type_annotated_expression : environment -> I.annotated_expression -> O.annot
|
||||
| E_literal Literal_unit ->
|
||||
return (E_literal (Literal_unit)) (t_unit ())
|
||||
| E_literal (Literal_string s) -> (
|
||||
L.log (Format.asprintf "literal_string option type: %a" PP_helpers.(option O.PP.type_value) tv_opt) ;
|
||||
match Option.map ~f:Ast_typed.get_type' tv_opt with
|
||||
| Some (T_constant ("address" , [])) -> return (E_literal (Literal_address s)) (t_string ())
|
||||
| Some (T_constant ("address" , [])) -> return (E_literal (Literal_address s)) (t_address ())
|
||||
| _ -> return (E_literal (Literal_string s)) (t_string ())
|
||||
)
|
||||
| E_literal (Literal_bytes s) ->
|
||||
|
Loading…
Reference in New Issue
Block a user