balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix bug in string; add address in expressions in pascaligo; add type annotations for expressions in pascaligo

Browse Source
This commit is contained in:
Galfour 2019-05-10 17:37:59 +00:00
parent 14ad75892c
commit 260c56ad58
14 changed files with 165 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/ligo/ast_simplified/combinators.ml
View File

@ -80,9 +80,11 @@ let e_variable v = E_variable v
let e_failwith v = E_failwith 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_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_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_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_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_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_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 let e_a_tez x = make_e_a_full (e_tez x) t_tez
@ -117,11 +119,11 @@ let e_a_some opt =
) in ) in
make_e_a ?type_annotation (e_some opt) 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 let type_annotation = t_option t_opt in
make_e_a ~type_annotation e_none 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) 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) 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
View File

@ -0,0 +1,5 @@
const lst : list(int) = list [] ;
const address : address = "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ;
const address_2 : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ;

2
src/ligo/contracts/counter.ligo
View File

@ -2,5 +2,5 @@ type some_type is int
function main (const p : int ; const s : some_type) : (list(operation) * int) is 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 block { skip } // skip is a do nothing instruction, needed for empty blocks
with ((nil : operation), p + s) with ((nil : list(operation)), p + s)

2
src/ligo/contracts/dispatch-counter.ligo
View File

@ -9,7 +9,7 @@ function decrement(const i : int ; const n : int) : int is
block { skip } with (i - n) block { skip } with (i - n)
function main (const p : action ; const s : int) : (list(operation) * int) is 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 case p of
| Increment n -> increment(s , n) | Increment n -> increment(s , n)
| Decrement n -> decrement(s , n) | Decrement n -> decrement(s , n)

1
src/ligo/contracts/string.ligo Normal file
View File

@ -0,0 +1 @@
const s : string = "toto"

2
src/ligo/contracts/super-counter.ligo
View File

@ -3,7 +3,7 @@ type action is
| Decrement of int | Decrement of int
function main (const p : action ; const s : int) : (list(operation) * int) is 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 case p of
| Increment n -> s + n | Increment n -> s + n
| Decrement n -> s - n | Decrement n -> s - n

28
src/ligo/parser/pascaligo/AST.ml
View File

@ -491,6 +491,7 @@ and for_collect = {
and expr = and expr =
| ECase of expr case reg | ECase of expr case reg
| EAnnot of annot_expr reg
| ELogic of logic_expr | ELogic of logic_expr
| EArith of arith_expr | EArith of arith_expr
| EString of string_expr | EString of string_expr
@ -507,6 +508,8 @@ and expr =
| ETuple of tuple_expr | ETuple of tuple_expr
| EPar of expr par reg | EPar of expr par reg
and annot_expr = (expr * type_expr)
and set_expr = and set_expr =
SetInj of expr injection reg SetInj of expr injection reg
| SetMem of set_membership reg | SetMem of set_membership reg
@ -587,17 +590,13 @@ and string_expr =
and list_expr = and list_expr =
Cons of cons bin_op reg Cons of cons bin_op reg
| List of expr injection reg | List of expr injection reg
| Nil of nil par reg | Nil of nil
and nil = { and nil = kwd_nil
nil : kwd_nil;
colon : colon;
list_type : type_expr
}
and constr_expr = and constr_expr =
SomeApp of (c_Some * arguments) reg SomeApp of (c_Some * arguments) reg
| NoneExpr of none_expr reg | NoneExpr of none_expr
| ConstrApp of (constr * arguments) reg | ConstrApp of (constr * arguments) reg
and record_expr = field_assign reg injection 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 tuple_injection = (expr, comma) nsepseq par reg
and none_expr = typed_none_expr par and none_expr = c_None
and typed_none_expr = {
c_None : c_None;
colon : colon;
opt_type : type_expr
}
and fun_call = (fun_name * arguments) reg and fun_call = (fun_name * arguments) reg
@ -675,6 +668,7 @@ let rec expr_to_region = function
| ELogic e -> logic_expr_to_region e | ELogic e -> logic_expr_to_region e
| EArith e -> arith_expr_to_region e | EArith e -> arith_expr_to_region e
| EString e -> string_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 | EList e -> list_expr_to_region e
| ESet e -> set_expr_to_region e | ESet e -> set_expr_to_region e
| EConstr e -> constr_expr_to_region e | EConstr e -> constr_expr_to_region e
@ -734,13 +728,15 @@ and string_expr_to_region = function
Cat {region; _} Cat {region; _}
| String {region; _} -> region | String {region; _} -> region
and annot_expr_to_region ({region; _}) = region
and list_expr_to_region = function and list_expr_to_region = function
Cons {region; _} Cons {region; _}
| List {region; _} | List {region; _}
| Nil {region; _} -> region | Nil region -> region
and constr_expr_to_region = function and constr_expr_to_region = function
NoneExpr {region; _} NoneExpr region
| ConstrApp {region; _} | ConstrApp {region; _}
| SomeApp {region; _} -> region | SomeApp {region; _} -> region

23
src/ligo/parser/pascaligo/AST.mli
View File

@ -474,7 +474,8 @@ and for_collect = {
(* Expressions *) (* Expressions *)
and expr = and expr =
ECase of expr case reg | ECase of expr case reg
| EAnnot of annot_expr reg
| ELogic of logic_expr | ELogic of logic_expr
| EArith of arith_expr | EArith of arith_expr
| EString of string_expr | EString of string_expr
@ -491,6 +492,8 @@ and expr =
| ETuple of tuple_expr | ETuple of tuple_expr
| EPar of expr par reg | EPar of expr par reg
and annot_expr = (expr * type_expr)
and set_expr = and set_expr =
SetInj of expr injection reg SetInj of expr injection reg
| SetMem of set_membership reg | SetMem of set_membership reg
@ -571,17 +574,13 @@ and string_expr =
and list_expr = and list_expr =
Cons of cons bin_op reg Cons of cons bin_op reg
| List of expr injection reg | List of expr injection reg
| Nil of nil par reg | Nil of nil
and nil = { and nil = kwd_nil
nil : kwd_nil;
colon : colon;
list_type : type_expr
}
and constr_expr = and constr_expr =
SomeApp of (c_Some * arguments) reg SomeApp of (c_Some * arguments) reg
| NoneExpr of none_expr reg | NoneExpr of none_expr
| ConstrApp of (constr * arguments) reg | ConstrApp of (constr * arguments) reg
and record_expr = field_assign reg injection 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 tuple_injection = (expr, comma) nsepseq par reg
and none_expr = typed_none_expr par and none_expr = c_None
and typed_none_expr = {
c_None : c_None;
colon : colon;
opt_type : type_expr
}
and fun_call = (fun_name * arguments) reg and fun_call = (fun_name * arguments) reg

55
src/ligo/parser/pascaligo/Parser.mly
View File

@ -438,24 +438,9 @@ unqualified_decl(OP):
match $5 with match $5 with
`Expr e -> e, expr_to_region e `Expr e -> e, expr_to_region e
| `EList kwd_nil -> | `EList kwd_nil ->
let value = { EList (Nil kwd_nil), kwd_nil
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
| `ENone region -> | `ENone region ->
let value = { EConstr (NoneExpr region), region
lpar = Region.ghost;
inside = {
c_None = region;
colon = Region.ghost;
opt_type = $3};
rpar = Region.ghost}
in EConstr (NoneExpr {region; value}), region
in $1, $2, $3, $4, init, region} in $1, $2, $3, $4, init, region}
const_decl: const_decl:
@ -474,8 +459,6 @@ var_decl:
extended_expr: extended_expr:
expr { `Expr $1 } expr { `Expr $1 }
| Nil { `EList $1 }
| C_None { `ENone $1 }
instruction: instruction:
single_instr { Single $1 } single_instr { Single $1 }
@ -724,7 +707,6 @@ assignment:
rhs: rhs:
expr { Expr $1 } expr { Expr $1 }
| C_None { NoneExpr $1 : rhs }
lhs: lhs:
path { Path $1 } path { Path $1 }
@ -786,8 +768,17 @@ interactive_expr:
expr: expr:
case(expr) { ECase ($1 expr_to_region) } 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:
disj_expr Or conj_expr { disj_expr Or conj_expr {
@ -955,7 +946,7 @@ core_expr:
| C_Unit { EUnit $1 } | C_Unit { EUnit $1 }
| tuple_expr { ETuple $1 } | tuple_expr { ETuple $1 }
| list_expr { EList $1 } | list_expr { EList $1 }
| none_expr { EConstr (NoneExpr $1) } | C_None { EConstr (NoneExpr $1) }
| fun_call { ECall $1 } | fun_call { ECall $1 }
| map_expr { EMap $1 } | map_expr { EMap $1 }
| set_expr { ESet $1 } | set_expr { ESet $1 }
@ -1046,25 +1037,7 @@ arguments:
list_expr: list_expr:
injection(List,expr) { List $1 } injection(List,expr) { List $1 }
| nil { Nil $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}}
(* Patterns *) (* Patterns *)

25
src/ligo/parser/pascaligo/ParserLog.ml
View File

@ -411,6 +411,7 @@ and print_bind_to = function
and print_expr = function and print_expr = function
ECase {value;_} -> print_case_expr value ECase {value;_} -> print_case_expr value
| EAnnot {value;_} -> print_annot_expr value
| ELogic e -> print_logic_expr e | ELogic e -> print_logic_expr e
| EArith e -> print_arith_expr e | EArith e -> print_arith_expr e
| EString e -> print_string_expr e | EString e -> print_string_expr e
@ -427,6 +428,10 @@ and print_expr = function
| ETuple e -> print_tuple_expr e | ETuple e -> print_tuple_expr e
| EPar e -> print_par_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) = and print_case_expr (node : expr case) =
let {kwd_case; expr; opening; let {kwd_case; expr; opening;
lead_vbar; cases; closing} = node in lead_vbar; cases; closing} = node in
@ -625,23 +630,11 @@ and print_tuple_inj {value; _} =
print_nsepseq "," print_expr inside; print_nsepseq "," print_expr inside;
print_token rpar ")" print_token rpar ")"
and print_nil {value; _} = and print_nil value =
let {lpar; inside; rpar} = value in print_token value "nil";
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_none_expr {value; _} = and print_none_expr value =
let {lpar; inside; rpar} = value in print_token value "None";
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_fun_call {value; _} = and print_fun_call {value; _} =
let fun_name, arguments = value in let fun_name, arguments = value in

136
src/ligo/simplify/pascaligo.ml
View File

@ -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 let%bind lst = bind_list @@ List.map simpl_type_expression lst in
ok @@ T_tuple lst ok @@ T_tuple lst
let rec simpl_expression (t:Raw.expr) : ae result = let rec simpl_expression ?te_annot (t:Raw.expr) : ae result =
let return x = ok @@ make_e_a x in let return x = ok @@ make_e_a ?type_annotation:te_annot x in
let simpl_projection = fun (p:Raw.projection) -> let simpl_projection = fun (p:Raw.projection) ->
let var = let var =
let name = p.struct_name.value in 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)) | Component index -> Access_tuple (Z.to_int (snd index.value))
in in
List.map aux @@ npseq_to_list path in List.map aux @@ npseq_to_list path in
ok @@ make_e_a @@ E_accessor (var, path') return @@ E_accessor (var, path')
in in
match t with 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 -> ( | EVar c -> (
let c' = c.value in let c' = c.value in
match List.assoc_opt c' constants with 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 match List.assoc_opt f constants with
| None -> | None ->
let%bind arg = simpl_tuple_expression args' in 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 -> | Some arity ->
let%bind _arity = let%bind _arity =
trace (simple_error "wrong arity for constants") @@ trace (simple_error "wrong arity for constants") @@
Assert.assert_equal_int arity (List.length args') in Assert.assert_equal_int arity (List.length args') in
let%bind lst = bind_map_list simpl_expression 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 | EPar x -> simpl_expression ?te_annot x.value.inside
| EUnit _ -> ok @@ make_e_a @@ E_literal Literal_unit | EUnit _ -> return @@ E_literal Literal_unit
| EBytes x -> ok @@ make_e_a @@ E_literal (Literal_bytes (Bytes.of_string @@ fst x.value)) | EBytes x -> return @@ E_literal (Literal_bytes (Bytes.of_string @@ fst x.value))
| ETuple tpl -> | ETuple tpl ->
let (Raw.TupleInj tpl') = tpl in let (Raw.TupleInj tpl') = tpl in
simpl_tuple_expression simpl_tuple_expression ?te_annot
@@ npseq_to_list tpl'.value.inside @@ npseq_to_list tpl'.value.inside
| ERecord r -> | ERecord r ->
let%bind fields = bind_list 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)) @@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
@@ pseq_to_list r.value.elements in @@ pseq_to_list r.value.elements in
let aux prev (k, v) = SMap.add k v prev 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' -> ( | EProj p' -> (
let p = p'.value in let p = p'.value in
simpl_projection p simpl_projection p
@ -144,42 +154,44 @@ let rec simpl_expression (t:Raw.expr) : ae result =
let%bind arg = let%bind arg =
simpl_tuple_expression simpl_tuple_expression
@@ npseq_to_list args.value.inside in @@ 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) -> | EConstr (SomeApp a) ->
let (_, args) = a.value in let (_, args) = a.value in
let%bind arg = let%bind arg =
simpl_tuple_expression simpl_tuple_expression
@@ npseq_to_list args.value.inside in @@ npseq_to_list args.value.inside in
ok @@ make_e_a @@ E_constant ("SOME", [arg]) return @@ E_constant ("SOME", [arg])
| EConstr (NoneExpr n) -> | EConstr (NoneExpr _) ->
let type_expr = n.value.inside.opt_type in return @@ E_constant ("NONE" , [])
let%bind type_expr' = simpl_type_expression type_expr in
ok @@ make_e_a_full (E_constant ("NONE", [])) (Combinators.t_option type_expr')
| EArith (Add c) -> | EArith (Add c) ->
simpl_binop "ADD" c.value simpl_binop ?te_annot "ADD" c.value
| EArith (Sub c) -> | EArith (Sub c) ->
simpl_binop "SUB" c.value simpl_binop ?te_annot "SUB" c.value
| EArith (Mult c) -> | EArith (Mult c) ->
simpl_binop "TIMES" c.value simpl_binop ?te_annot "TIMES" c.value
| EArith (Div c) -> | EArith (Div c) ->
simpl_binop "DIV" c.value simpl_binop ?te_annot "DIV" c.value
| EArith (Mod c) -> | EArith (Mod c) ->
simpl_binop "MOD" c.value simpl_binop ?te_annot "MOD" c.value
| EArith (Int n) -> | EArith (Int n) ->
let n = Z.to_int @@ snd @@ n.value in 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) -> | EArith (Nat n) ->
let n = Z.to_int @@ snd @@ n.value in 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) -> | EArith (Mtz n) ->
let n = Z.to_int @@ snd @@ n.value in 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" | EArith _ -> simple_fail "arith: not supported yet"
| EString (String s) -> | 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" | EString _ -> simple_fail "string: not supported yet"
| ELogic l -> simpl_logic_expression l | ELogic l -> simpl_logic_expression ?te_annot l
| EList l -> simpl_list_expression l | EList l -> simpl_list_expression ?te_annot l
| ESet _ -> simple_fail "set: not supported yet" | ESet _ -> simple_fail "set: not supported yet"
| ECase c -> | ECase c ->
let%bind e = simpl_expression c.value.expr in 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 @@ List.map get_value
@@ npseq_to_list c.value.cases.value in @@ npseq_to_list c.value.cases.value in
let%bind cases = simpl_cases lst in let%bind cases = simpl_cases lst in
ok @@ make_e_a @@ E_matching (e, cases) return @@ E_matching (e, cases)
| EMap (MapInj mi) -> | EMap (MapInj mi) ->
let%bind lst = let%bind lst =
let lst = List.map get_value @@ pseq_to_list mi.value.elements in 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 let%bind index = simpl_expression lu.value.index.value.inside in
return (E_look_up (path, index)) 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 match t with
| BoolExpr (False _) -> | BoolExpr (False _) ->
ok @@ make_e_a @@ E_literal (Literal_bool false) return @@ E_literal (Literal_bool false)
| BoolExpr (True _) -> | BoolExpr (True _) ->
ok @@ make_e_a @@ E_literal (Literal_bool true) return @@ E_literal (Literal_bool true)
| BoolExpr (Or b) -> | BoolExpr (Or b) ->
simpl_binop "OR" b.value simpl_binop ?te_annot "OR" b.value
| BoolExpr (And b) -> | BoolExpr (And b) ->
simpl_binop "AND" b.value simpl_binop ?te_annot "AND" b.value
| BoolExpr (Not b) -> | BoolExpr (Not b) ->
simpl_unop "NOT" b.value simpl_unop ?te_annot "NOT" b.value
| CompExpr (Lt c) -> | CompExpr (Lt c) ->
simpl_binop "LT" c.value simpl_binop ?te_annot "LT" c.value
| CompExpr (Gt c) -> | CompExpr (Gt c) ->
simpl_binop "GT" c.value simpl_binop ?te_annot "GT" c.value
| CompExpr (Leq c) -> | CompExpr (Leq c) ->
simpl_binop "LE" c.value simpl_binop ?te_annot "LE" c.value
| CompExpr (Geq c) -> | CompExpr (Geq c) ->
simpl_binop "GE" c.value simpl_binop ?te_annot "GE" c.value
| CompExpr (Equal c) -> | CompExpr (Equal c) ->
simpl_binop "EQ" c.value simpl_binop ?te_annot "EQ" c.value
| CompExpr (Neq c) -> | 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 match t with
| Cons c -> | Cons c ->
simpl_binop "CONS" c.value simpl_binop ?te_annot "CONS" c.value
| List lst -> | List lst ->
let%bind lst' = let%bind lst' =
bind_map_list simpl_expression @@ bind_map_list simpl_expression @@
pseq_to_list lst.value.elements in pseq_to_list lst.value.elements in
ok (make_e_a (E_list lst')) return @@ E_list lst'
| Nil n -> | Nil _ ->
let n' = n.value.inside in return @@ E_list []
let%bind t' = simpl_type_expression n'.list_type in
let e' = E_list [] in
ok (make_e_a_full e' (t_list t'))
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 a = simpl_expression t.arg1 in
let%bind b = simpl_expression t.arg2 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 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 match lst with
| [] -> ok @@ make_e_a @@ E_literal Literal_unit | [] -> return @@ E_literal Literal_unit
| [hd] -> simpl_expression hd | [hd] -> simpl_expression ?te_annot hd
| lst -> | lst ->
let%bind lst = bind_list @@ List.map simpl_expression lst in 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 = and simpl_local_declaration (t:Raw.local_decl) : (instruction * named_expression) result =
match t with match t with
@ -288,16 +302,14 @@ and simpl_data_declaration (t:Raw.data_decl) : (instruction * named_expression)
let x = x.value in let x = x.value in
let name = x.name.value in let name = x.name.value in
let%bind t = simpl_type_expression x.var_type in let%bind t = simpl_type_expression x.var_type in
let type_annotation = Some t in let%bind annotated_expression = simpl_expression ~te_annot:t x.init in
let%bind expression = simpl_expression x.init in return {name;annotated_expression}
return {name;annotated_expression={expression with type_annotation}}
| LocalConst x -> | LocalConst x ->
let x = x.value in let x = x.value in
let name = x.name.value in let name = x.name.value in
let%bind t = simpl_type_expression x.const_type in let%bind t = simpl_type_expression x.const_type in
let type_annotation = Some t in let%bind annotated_expression = simpl_expression ~te_annot:t x.init in
let%bind expression = simpl_expression x.init in return {name;annotated_expression}
return {name;annotated_expression={expression with type_annotation}}
and simpl_param : Raw.param_decl -> named_type_expression result = fun t -> and simpl_param : Raw.param_decl -> named_type_expression result = fun t ->

6
src/ligo/test/coase_tests.ml
View File

@ -99,7 +99,7 @@ let buy () =
e_a_pair buy_action storage e_a_pair buy_action storage
in in
let make_expected = fun n -> 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 storage =
let cards = let cards =
cards_ez first_owner n @ cards_ez first_owner n @
@ -138,7 +138,7 @@ let dispatch_buy () =
e_a_pair action storage e_a_pair action storage
in in
let make_expected = fun n -> 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 storage =
let cards = let cards =
cards_ez first_owner n @ cards_ez first_owner n @
@ -177,7 +177,7 @@ let transfer () =
e_a_pair transfer_action storage e_a_pair transfer_action storage
in in
let make_expected = fun n -> 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 storage =
let cards = let cards =
let new_card = card_ez second_owner in let new_card = card_ez second_owner in

37
src/ligo/test/integration_tests.ml
View File

@ -15,6 +15,19 @@ let function_ () : unit result =
let make_expect = fun n -> n in let make_expect = fun n -> n in
expect_eq_n_int program "main" make_expect 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 complex_function () : unit result =
let%bind program = type_file "./contracts/function-complex.ligo" in let%bind program = type_file "./contracts/function-complex.ligo" in
let make_expect = fun n -> (3 * n + 2) 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 let%bind program = type_file "./contracts/unit.ligo" in
expect_eq_evaluate program "u" e_a_unit 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 include_ () : unit result =
let%bind program = type_file "./contracts/includer.ligo" in let%bind program = type_file "./contracts/includer.ligo" in
expect_eq_evaluate program "bar" (e_a_int 144) expect_eq_evaluate program "bar" (e_a_int 144)
@ -217,7 +234,7 @@ let option () : unit result =
expect_eq_evaluate program "s" expected expect_eq_evaluate program "s" expected
in in
let%bind () = 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 expect_eq_evaluate program "n" expected
in in
ok () ok ()
@ -271,7 +288,7 @@ let list () : unit result =
let%bind program = type_file "./contracts/list.ligo" in let%bind program = type_file "./contracts/list.ligo" in
let ez lst = let ez lst =
let lst' = List.map e_a_int lst in let lst' = List.map e_a_int lst in
e_a_list lst' t_int e_a_typed_list lst' t_int
in in
let%bind () = let%bind () =
let make_input = fun n -> (ez @@ List.range n) in let make_input = fun n -> (ez @@ List.range n) in
@ -330,7 +347,7 @@ let matching () : unit result =
let aux n = let aux n =
let input = match n with let input = match n with
| Some s -> e_a_some (e_a_int s) | 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 let expected = e_a_int (match n with
| Some s -> s | Some s -> s
| None -> 23) in | None -> 23) in
@ -344,7 +361,7 @@ let matching () : unit result =
let aux n = let aux n =
let input = match n with let input = match n with
| Some s -> e_a_some (e_a_int s) | 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 let expected = e_a_int (match n with
| Some s -> s | Some s -> s
| None -> 42) in | None -> 42) in
@ -377,7 +394,7 @@ let quote_declarations () : unit result =
let counter_contract () : unit result = let counter_contract () : unit result =
let%bind program = type_file "./contracts/counter.ligo" in 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_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 expect_eq_n program "main" make_input make_expected
let super_counter_contract () : unit result = 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 e_a_pair (e_a_constructor action (e_a_int n)) (e_a_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
let dispatch_counter_contract () : unit result = 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 e_a_pair (e_a_constructor action (e_a_int n)) (e_a_int 42) in
let make_expected = fun n -> let make_expected = fun n ->
let op = if n mod 2 = 0 then (+) else (-) in 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 expect_eq_n program "main" make_input make_expected
let basic_mligo () : unit result = let basic_mligo () : unit result =
@ -408,13 +425,13 @@ let basic_mligo () : unit result =
let counter_mligo () : unit result = let counter_mligo () : unit result =
let%bind program = mtype_file "./contracts/counter.mligo" in 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_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 expect_eq_n program "main" make_input make_expected
let guess_the_hash_mligo () : unit result = let guess_the_hash_mligo () : unit result =
let%bind program = mtype_file "./contracts/new-syntax.mligo" in 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_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 expect_eq_n program "main" make_input make_expected
let main = "Integration (End to End)", [ let main = "Integration (End to End)", [
@ -426,10 +443,12 @@ let main = "Integration (End to End)", [
test "record" record ; test "record" record ;
test "condition" condition ; test "condition" condition ;
test "shadow" shadow ; test "shadow" shadow ;
test "annotation" annotation ;
test "multiple parameters" multiple_parameters ; test "multiple parameters" multiple_parameters ;
test "bool" bool_expression ; test "bool" bool_expression ;
test "arithmetic" arithmetic ; test "arithmetic" arithmetic ;
test "unit" unit_expression ; test "unit" unit_expression ;
test "string" string_expression ;
test "option" option ; test "option" option ;
test "map" map ; test "map" map ;
test "list" list ; test "list" list ;

6
src/ligo/typer/typer.ml
View File

@ -332,6 +332,7 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_value result =
return (T_constant(cst, lst')) return (T_constant(cst, lst'))
and type_annotated_expression : environment -> I.annotated_expression -> O.annotated_expression result = fun e ae -> 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 let%bind tv_opt = match ae.type_annotation with
| None -> ok None | None -> ok None
| Some s -> let%bind r = evaluate_type e s in ok (Some r) in | 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 ok @@ make_a_e expr type_annotation e in
let main_error = let main_error =
let title () = "typing annotated_expression" in 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 error title content in
trace main_error @@ trace main_error @@
match ae.expression with match ae.expression with
@ -357,8 +358,9 @@ and type_annotated_expression : environment -> I.annotated_expression -> O.annot
| E_literal Literal_unit -> | E_literal Literal_unit ->
return (E_literal (Literal_unit)) (t_unit ()) return (E_literal (Literal_unit)) (t_unit ())
| E_literal (Literal_string s) -> ( | 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 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 ()) | _ -> return (E_literal (Literal_string s)) (t_string ())
) )
| E_literal (Literal_bytes s) -> | E_literal (Literal_bytes s) ->