added tuples

src/ligo/ast_typed.ml

@@ -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)
 

src/ligo/contracts/heap.ligo

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

src/ligo/contracts/tuple.ligo

@@ -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)

src/ligo/ligo-parser/ligo_parser.ml

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

src/ligo/ligo.ml

@@ -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 ->
+    ) @@ (fun () ->
-  ok program_cst
+      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 ->
+    ) @@ (fun () ->
-  ok program_cst
+      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 ->
+    ) @@ (fun () ->
-  ok expr
+      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

src/ligo/test/heap_tests.ml

@@ -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 ;

src/ligo/test/integration_tests.ml

@@ -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 ;

src/ligo/test/test.ml

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

src/ligo/transpiler.ml

@@ -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' = translate_annotated_expression env tpl in
-      let%bind tpl_tv = get_t_tuple ae.type_annotation in
+      let%bind tpl_tv = get_t_tuple tpl.type_annotation in
-      let node_tv = Append_tree.of_list @@ List.mapi (fun i a -> (a, i)) tpl_tv in
+      let node_tv = Append_tree.of_list @@ List.mapi (fun i a -> (i, a)) tpl_tv in
-      let%bind ae' =
+      let leaf (i, _) : expression result =
-        let leaf (tv, i) : (expression' option * type_value) result =
+        if i = ind then (
-          let%bind tv = translate_type tv in
+          ok tpl'
-          if i = ind then (
+        ) else (
-            ok (Some (tpl'_expr), tv)
+          simple_fail "bad leaf"
-          ) else (
+        ) in
-            ok (None, tv)
+      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 expr =
-          let%bind a = a in
+        trace_strong (simple_error "bad index in tuple (shouldn't happen here)") @@
-          let%bind b = b in
+        Append_tree.fold_ne leaf node node_tv in
-          match (a, b) with
+      ok expr
-          | (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'
   | Record m ->
       let node = Append_tree.of_list @@ list_of_map m in
       let aux a b : expression result =

src/ligo/typer.ml

@@ -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 *)