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

added tuples

Browse Source
This commit is contained in:
Galfour 2019-03-29 19:44:14 +00:00
parent f5d9fa8266
commit 0e8ba13660
10 changed files with 95 additions and 184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/ligo/ast_typed.ml
View File

@ -416,7 +416,6 @@ module Combinators = struct
let aux prev (k, v) = SMap.add k v prev in
let map = List.fold_left aux SMap.empty lst in
type_value (Type_record map) None
let make_t_record m = t_record m None
let make_t_record_ez lst =
let m = SMap.of_list lst in
@ -478,7 +477,8 @@ module Combinators = struct
let a_int n = annotated_expression (int n) make_t_int
let a_bool b = annotated_expression (bool b) make_t_bool
let a_pair a b = annotated_expression (pair a b) (make_t_pair a.type_annotation b.type_annotation)
let a_record r = annotated_expression (record r) (make_t_record (SMap.map (fun x -> x.type_annotation) r))
let a_tuple lst = annotated_expression (Tuple lst) (make_t_tuple (List.map get_type_annotation lst))
let a_record r = annotated_expression (record r) (make_t_record (SMap.map get_type_annotation r))
let a_record_ez r = annotated_expression (record_ez r) (make_t_record_ez (List.map (fun (x, y) -> x, y.type_annotation) r))
let a_map lst k v = annotated_expression (map lst) (make_t_map k v)

1
src/ligo/contracts/heap.ligo
View File

@ -1,3 +1,4 @@
type heap_element is int * string
type heap is record
heap_content : map(int, heap_element) ;

12
src/ligo/contracts/tuple.ligo Normal file
View File

@ -0,0 +1,12 @@
type foobar is (int * int)
const fb : foobar = (0, 0)
function projection (const tpl : foobar) : int is
begin
skip
end with tpl.0 + tpl.1
type big_tuple is (int * int * int * int * int)
const br : big_tuple = (23, 23, 23, 23, 23)

3
src/ligo/ligo-parser/ligo_parser.ml
View File

@ -1,3 +1,4 @@
module Parser = Parser
module Lexer = Lexer.Make(LexToken)
module AST = AST
module Lexer = Lexer
module LexToken = LexToken

33
src/ligo/ligo.ml
View File

@ -15,7 +15,8 @@ let parse_file (source:string) : AST_Raw.t result =
generic_try (simple_error "error opening file") @@
(fun () -> open_in source) in
let lexbuf = Lexing.from_channel channel in
let Lexer.{read ; _} =
let module Lexer = Lexer.Make(LexToken) in
let Lexer.{read ; close} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
@ -29,12 +30,17 @@ let parse_file (source:string) : AST_Raw.t result =
simple_error str
)
| _ -> simple_error "unrecognized parse_ error"
) @@ (fun () -> Parser.contract read lexbuf) >>? fun program_cst ->
ok program_cst
) @@ (fun () ->
let raw = Parser.contract read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
let parse (s:string) : AST_Raw.t result =
let lexbuf = Lexing.from_string s in
let Lexer.{read ; _} =
let module Lexer = Lexer.Make(LexToken) in
let Lexer.{read ; close} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
@ -48,12 +54,17 @@ let parse (s:string) : AST_Raw.t result =
simple_error str
)
| _ -> simple_error "unrecognized parse_ error"
) @@ (fun () -> Parser.contract read lexbuf) >>? fun program_cst ->
ok program_cst
) @@ (fun () ->
let raw = Parser.contract read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
let parse_expression (s:string) : AST_Raw.expr result =
let lexbuf = Lexing.from_string s in
let Lexer.{read ; _} =
let module Lexer = Lexer.Make(LexToken) in
let Lexer.{read ; close} =
Lexer.open_token_stream None in
specific_try (function
| Parser.Error -> (
@ -67,8 +78,12 @@ let parse_expression (s:string) : AST_Raw.expr result =
simple_error str
)
| _ -> simple_error "unrecognized parse_ error"
) @@ (fun () -> Parser.interactive_expr read lexbuf) >>? fun expr ->
ok expr
) @@ (fun () ->
let raw = Parser.interactive_expr read lexbuf in
close () ;
raw
) >>? fun raw ->
ok raw
let simplify (p:AST_Raw.t) : Ast_simplified.program result = AST_Simplified.Simplify.simpl_program p
let simplify_expr (e:AST_Raw.expr) : Ast_simplified.annotated_expression result = AST_Simplified.Simplify.simpl_expression e

147
src/ligo/test/heap_tests.ml
View File

@ -46,153 +46,6 @@ let is_empty () : unit result =
@@ [0 ; 2 ; 42 ; 163 ; -1] in
ok ()
let bool_expression () : unit result =
let%bind program = type_file "./contracts/boolean_operators.ligo" in
let aux (name, f) =
let aux b =
let open AST_Typed.Combinators in
let input = a_bool b in
let%bind result = easy_run_typed name program input in
let%bind result' =
trace (simple_error "bad result") @@
get_a_bool result in
Assert.assert_equal_bool (f b) result'
in
let%bind _ = bind_list
@@ List.map aux [true;false] in
ok ()
in
let%bind _ = bind_list
@@ List.map aux
@@ [
("or_true", fun b -> b || true) ;
("or_false", fun b -> b || false) ;
("and_true", fun b -> b && true) ;
("and_false", fun b -> b && false) ;
] in
ok ()
let unit_expression () : unit result =
let%bind program = type_file "./contracts/unit.ligo" in
let open AST_Typed.Combinators in
let%bind result = easy_evaluate_typed "u" program in
let%bind () =
trace (simple_error "result isn't unit") @@
get_a_unit result in
ok ()
let record_ez_int names n =
let open AST_Typed.Combinators in
a_record_ez @@ List.map (fun x -> x, a_int n) names
let multiple_parameters () : unit result =
let%bind program = type_file "./contracts/multiple-parameters.ligo" in
let inputs = [0 ; 2 ; 42 ; 163 ; -1] in
let aux (name, input_f, output_f) =
let aux n =
let input = input_f n in
let%bind result = easy_run_typed name program input in
let%bind result' = AST_Typed.Combinators.get_a_int result in
let expected = output_f n in
let%bind _ = Assert.assert_equal_int expected result' in
ok ()
in
let%bind _ = bind_list @@ List.map aux inputs in
ok ()
in
let%bind _ = bind_list @@ List.map aux [
("ab", record_ez_int ["a";"b"], fun n -> 2 * n) ;
("abcd", record_ez_int ["a";"b";"c";"d"], fun n -> 4 * n + 2) ;
("abcde", record_ez_int ["a";"b";"c";"d";"e"], fun n -> 2 * n + 3) ;
] in
ok ()
let record () : unit result =
let%bind program = type_file "./contracts/record.ligo" in
let%bind _foobar =
let%bind result = easy_evaluate_typed "fb" program in
let expect = record_ez_int ["foo";"bar"] 0 in
AST_Typed.assert_value_eq (expect, result)
in
let%bind _projection =
let aux n =
let input = record_ez_int ["foo";"bar"] n in
let%bind result = easy_run_typed "projection" program input in
let expect = AST_Typed.Combinators.a_int (2 * n) in
AST_Typed.assert_value_eq (expect, result)
in
bind_list @@ List.map aux [0 ; -42 ; 144]
in
let%bind _big =
let%bind result = easy_evaluate_typed "br" program in
let expect = record_ez_int ["a";"b";"c";"d";"e"] 23 in
AST_Typed.assert_value_eq (expect, result)
in
ok ()
let condition () : unit result =
let%bind program = type_file "./contracts/condition.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@
get_a_int result in
Assert.assert_equal_int (if n = 2 then 42 else 0) result'
in
let%bind _ = bind_list
@@ List.map aux
@@ [0 ; 2 ; 42 ; 163 ; -1] in
ok ()
let declarations () : unit result =
let%bind program = type_file "./contracts/declarations.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@
get_a_int result in
Assert.assert_equal_int (42 + n) result'
in
let%bind _ = bind_list
@@ List.map aux
@@ [0 ; 2 ; 42 ; 163 ; -1] in
ok ()
let quote_declaration () : unit result =
let%bind program = type_file "./contracts/quote-declaration.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@
get_a_int result in
Assert.assert_equal_int result' (42 + 2 * n)
in
let%bind _ = bind_list
@@ List.map aux
@@ [0 ; 2 ; 42 ; 163 ; -1] in
ok ()
let quote_declarations () : unit result =
let%bind program = type_file "./contracts/quote-declarations.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@
get_a_int result in
Assert.assert_equal_int result' (74 + 2 * n)
in
let%bind _ = bind_list
@@ List.map aux
@@ [0 ; 2 ; 42 ; 163 ; -1] in
ok ()
let main = "Heap (End to End)", [
test "is_empty" is_empty ;

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

@ -125,6 +125,35 @@ let record () : unit result =
in
ok ()
let tuple () : unit result =
let%bind program = type_file "./contracts/tuple.ligo" in
let ez n =
let open AST_Typed.Combinators in
a_tuple (List.map a_int n) in
let%bind _foobar =
trace (simple_error "foobar") (
let%bind result = easy_evaluate_typed "fb" program in
let expect = ez [0 ; 0] in
AST_Typed.assert_value_eq (expect, result)
)
in
let%bind _projection = trace (simple_error "projection") (
let aux n =
let input = ez [n ; n] in
let%bind result = easy_run_typed "projection" program input in
let expect = AST_Typed.Combinators.a_int (2 * n) in
AST_Typed.assert_value_eq (expect, result)
in
bind_list @@ List.map aux [0 ; -42 ; 144]
)
in
let%bind _big =
let%bind result = easy_evaluate_typed "br" program in
let expect = ez [23 ; 23 ; 23 ; 23 ; 23] in
AST_Typed.assert_value_eq (expect, result)
in
ok ()
let condition () : unit result =
let%bind program = type_file "./contracts/condition.ligo" in
let aux n =
@ -196,6 +225,7 @@ let main = "Integration (End to End)", [
test "bool" bool_expression ;
test "unit" unit_expression ;
test "record" record ;
test "tuple" tuple ;
test "multiple parameters" multiple_parameters ;
test "condition" condition ;
test "declarations" declarations ;

2
src/ligo/test/test.ml
View File

@ -7,6 +7,6 @@ let () =
Compiler_tests.main ;
Transpiler_tests.main ;
Typer_tests.main ;
Heap_tests.main ;
(* Heap_tests.main ; *)
] ;
()

46
src/ligo/transpiler.ml
View File

@ -136,31 +136,29 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
in
Append_tree.fold_ne (translate_annotated_expression env) aux node
| Tuple_accessor (tpl, ind) ->
let%bind (tpl'_expr, _, _) = translate_annotated_expression env tpl in
let%bind tpl_tv = get_t_tuple ae.type_annotation in
let node_tv = Append_tree.of_list @@ List.mapi (fun i a -> (a, i)) tpl_tv in
let%bind ae' =
let leaf (tv, i) : (expression' option * type_value) result =
let%bind tv = translate_type tv in
if i = ind then (
ok (Some (tpl'_expr), tv)
) else (
ok (None, tv)
let%bind tpl' = translate_annotated_expression env tpl in
let%bind tpl_tv = get_t_tuple tpl.type_annotation in
let node_tv = Append_tree.of_list @@ List.mapi (fun i a -> (i, a)) tpl_tv in
let leaf (i, _) : expression result =
if i = ind then (
ok tpl'
) else (
simple_fail "bad leaf"
) in
let node a b : expression result =
match%bind bind_lr (a, b) with
| `Left ((_, t, env) as ex) -> (
let%bind (a, _) = get_t_pair t in
ok (Predicate ("CAR", [ex]), a, env)
)
| `Right ((_, t, env) as ex) -> (
let%bind (_, b) = get_t_pair t in
ok (Predicate ("CDR", [ex]), b, env)
) in
let node a b : (expression' option * type_value) result =
let%bind a = a in
let%bind b = b in
match (a, b) with
| (None, a), (None, b) -> ok (None, `Pair (a, b))
| (Some _, _), (Some _, _) -> simple_fail "several identical indexes in the same tuple (shouldn't happen here)"
| (Some v, a), (None, b) -> ok (Some (Predicate ("CAR", [v, a, env])), `Pair (a, b))
| (None, a), (Some v, b) -> ok (Some (Predicate ("CDR", [v, b, env])), `Pair (a, b))
in
let%bind (ae_opt, tv) = Append_tree.fold_ne leaf node node_tv in
let%bind ae = trace_option (simple_error "bad index in tuple (shouldn't happen here)")
ae_opt in
ok (ae, tv, env) in
ok ae'
let%bind expr =
trace_strong (simple_error "bad index in tuple (shouldn't happen here)") @@
Append_tree.fold_ne leaf node node_tv in
ok expr
| Record m ->
let node = Append_tree.of_list @@ list_of_map m in
let aux a b : expression result =

1
src/ligo/typer.ml
View File

@ -297,6 +297,7 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an
ok O.{expression = O.Record_accessor (prev, property) ; type_annotation }
)
in
trace (simple_error "accessing") @@
bind_fold_list aux e' path
(* Sum *)