Print numeric records as tuples, better typer error messages for records & tuples

gitlab-pages/docs/intro/installation.md

@@ -20,7 +20,7 @@ If this is your first time using Docker, you probably want to set up a global LI
 
 ### Setting up a globally available `ligo` executable
 
-> You can install additional ligo versions by replacing `next` with the required version number
+> You can install additional ligo versions by replacing `next` with the desired version number
 
 Download the latest binaries here: https://gitlab.com/ligolang/ligo/pipelines/85536879/builds or get the latest pre-release:
 

scripts/test_cli.sh

@@ -7,7 +7,7 @@ dry_run_output=$(./scripts/ligo_ci.sh dry-run src/test/contracts/website2.ligo m
 
 expected_compiled_parameter="(Right 1)";
 expected_compiled_storage=1;
-expected_dry_run_output="( [] , 2 )";
+expected_dry_run_output="( list[] , 2 )";
 
 if [ "$compiled_storage" != "$expected_compiled_storage" ]; then
     echo "Expected $expected_compiled_storage as compile-storage output, got $compiled_storage instead";

src/bin/expect_tests/contract_tests.ml

@@ -1092,11 +1092,11 @@ let%expect_test _ =
 
 let%expect_test _ =
     run_ligo_good [ "dry-run" ; contract "redeclaration.ligo" ; "main" ; "unit" ; "0" ] ;
-    [%expect {|record[0 -> list[] , 1 -> 0] |}]
+    [%expect {|( list[] , 0 ) |}]
 
 let%expect_test _ =
     run_ligo_good [ "dry-run" ; contract "double_main.ligo" ; "main" ; "unit" ; "0" ] ;
-    [%expect {|record[0 -> list[] , 1 -> 2] |}]
+    [%expect {|( list[] , 2 ) |}]
 
 let%expect_test _ =
   run_ligo_good [ "compile-contract" ; contract "subtle_nontail_fail.mligo" ; "main" ] ;

src/bin/expect_tests/typer_error_tests.ml

@@ -41,7 +41,7 @@ let%expect_test _ =
 
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_3.mligo" ; "main" ] ;
   [%expect {|
-    ligo: in file "error_typer_3.mligo", line 3, characters 34-53. records have different sizes: Expected these two types to be the same, but they're different (both are records, but with a different number of arguments) {"a":"record[0 -> int , 1 -> string , 2 -> bool]","b":"record[0 -> int , 1 -> string]"}
+    ligo: in file "error_typer_3.mligo", line 3, characters 34-53. tuples have different sizes: Expected these two types to be the same, but they're different (both are tuples, but with a different number of arguments) {"a":"( int * string * bool )","b":"( int * string )"}
 
 
      If you're not sure how to fix this error, you can
@@ -54,7 +54,7 @@ let%expect_test _ =
 
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_4.mligo" ; "main" ] ;
   [%expect {|
-    ligo: in file "error_typer_4.mligo", line 4, characters 17-56. different keys in record:  {"key_a":"d","key_b":"c"}
+    ligo: in file "error_typer_4.mligo", line 4, characters 17-56. different keys in records:  {"key_a":"c","key_b":"b","a":"record[a -> int , c -> bool , d -> string]","b":"record[a -> int , b -> string , c -> bool]"}
 
 
      If you're not sure how to fix this error, you can

src/stages/ast_simplified/PP.ml

@@ -24,7 +24,7 @@ let rec expression ppf (e : expression) =
       fprintf ppf "%a(%a)" constant c.cons_name (list_sep_d expression)
         c.arguments
   | E_record m ->
-      fprintf ppf "record[%a]" (lmap_sep expression (const " , ")) m
+      fprintf ppf "%a" (tuple_or_record_sep_expr expression) m
   | E_record_accessor ra ->
       fprintf ppf "%a.%a" expression ra.expr label ra.label
   | E_record_update {record; path; update} ->

src/stages/ast_typed/PP.ml

@@ -24,7 +24,7 @@ let rec expression ppf (e : expression) =
       fprintf ppf "%a(%a)" constant c.cons_name (list_sep_d expression)
         c.arguments
   | E_record m ->
-      fprintf ppf "record[%a]" (lmap_sep expression (const " , ")) m
+      fprintf ppf "%a" (tuple_or_record_sep_expr expression) m
   | E_record_accessor ra ->
       fprintf ppf "%a.%a" expression ra.expr label ra.label
   | E_record_update {record; path; update} ->

src/stages/ast_typed/misc.ml

@@ -43,29 +43,49 @@ module Errors = struct
     ] in
     error ~data title message ()
 
-  let different_size_type name a b () =
+  let different_size_type names a b () =
-    let title () = name ^ " have different sizes" in
+    let title () = names ^ " have different sizes" in
-    let message () = "Expected these two types to be the same, but they're different (both are " ^ name ^ ", but with a different number of arguments)" in
+    let message () = "Expected these two types to be the same, but they're different (both are " ^ names ^ ", but with a different number of arguments)" in
     let data = [
       ("a" , fun () -> Format.asprintf "%a" PP.type_expression a) ;
-      ("b" , fun () -> Format.asprintf "%a" PP.type_expression b )
+      ("b" , fun () -> Format.asprintf "%a" PP.type_expression b)
     ] in
     error ~data title message ()
 
-  let different_props_in_record ka kb () =
+  let different_props_in_record a b ra rb ka kb () =
-    let title () = "different keys in record" in
+    let names () = if Stage_common.Helpers.is_tuple_lmap ra && Stage_common.Helpers.is_tuple_lmap rb then "tuples" else "records" in
+    let title () = "different keys in " ^ (names ()) in
     let message () = "" in
     let data = [
       ("key_a" , fun () -> Format.asprintf "%s" ka) ;
-      ("key_b" , fun () -> Format.asprintf "%s" kb )
+      ("key_b" , fun () -> Format.asprintf "%s" kb ) ;
+      ("a" , fun () -> Format.asprintf "%a" PP.type_expression a) ;
+      ("b" , fun () -> Format.asprintf "%a" PP.type_expression b ) ;
     ] in
     error ~data title message ()
 
+  let different_kind_record_tuple a b ra rb () =
+    let name_a () = if Stage_common.Helpers.is_tuple_lmap ra then "tuple" else "record" in
+    let name_b () = if Stage_common.Helpers.is_tuple_lmap rb then "tuple" else "record" in
+    let title () = "different keys in " ^ (name_a ()) ^ " and " ^ (name_b ()) in
+    let message () = "Expected these two types to be the same, but they're different (one is a " ^ (name_a ()) ^ " and the other is a " ^ (name_b ()) ^ ")" in
+    let data = [
+      ("a" , fun () -> Format.asprintf "%a" PP.type_expression a) ;
+      ("b" , fun () -> Format.asprintf "%a" PP.type_expression b ) ;
+    ] in
+    error ~data title message ()
+
+
   let _different_size_constants = different_size_type "type constructors"
 
   let different_size_sums = different_size_type "sums"
 
-  let different_size_records = different_size_type "records"
+  let different_size_records_tuples a b ra rb =
+    different_size_type
+      (if Stage_common.Helpers.is_tuple_lmap ra && Stage_common.Helpers.is_tuple_lmap rb
+       then "tuples"
+       else "records")
+      a b
 
   let different_types name a b () =
     let title () = name ^ " are different" in
@@ -348,20 +368,25 @@ let rec assert_type_expression_eq (a, b: (type_expression * type_expression)) :
       bind_list_iter aux (List.combine sa' sb')
     )
   | T_sum _, _ -> fail @@ different_kinds a b
+  | T_record ra, T_record rb
+       when Stage_common.Helpers.is_tuple_lmap ra <> Stage_common.Helpers.is_tuple_lmap rb -> (
+    fail @@ different_kind_record_tuple a b ra rb
+  )
   | T_record ra, T_record rb -> (
-      let ra' = LMap.to_kv_list ra in
+      let sort_lmap r' = List.sort (fun (Label a,_) (Label b,_) -> String.compare a b) r' in
-      let rb' = LMap.to_kv_list rb in
+      let ra' = sort_lmap @@ LMap.to_kv_list ra in
+      let rb' = sort_lmap @@ LMap.to_kv_list rb in
       let aux ((ka, va), (kb, vb)) =
         let%bind _ =
           trace (different_types "records" a b) @@
           let Label ka = ka in
           let Label kb = kb in
-          trace_strong (different_props_in_record ka kb) @@
+          trace_strong (different_props_in_record a b ra rb ka kb) @@
           Assert.assert_true (ka = kb) in
         assert_type_expression_eq (va, vb)
       in
       let%bind _ =
-        trace_strong (different_size_records a b)
+        trace_strong (different_size_records_tuples a b ra rb)
         @@ Assert.assert_list_same_size ra' rb' in
       trace (different_types "record type" a b)
       @@ bind_list_iter aux (List.combine ra' rb')

src/stages/ast_typed/misc.mli

@@ -46,6 +46,7 @@ module Errors : sig
   val different_size_tuples : type_expression -> type_expression -> unit -> error
   val different_size_sums : type_expression -> type_expression -> unit -> error
   val different_size_records : type_expression -> type_expression -> unit -> error
+  val different_size_tuples : type_expression -> type_expression -> unit -> error
   val different_types : name -> type_expression -> type_expression -> unit -> error
   val different_literals : name -> literal -> literal -> unit -> error
   val different_values : name -> value -> value -> unit -> error

src/stages/common/PP.ml

@@ -2,7 +2,6 @@ open Types
 open Format
 open PP_helpers
 
-
 let constructor ppf (c:constructor') : unit =
   let Constructor c = c in fprintf ppf "%s" c
 
@@ -15,15 +14,31 @@ let cmap_sep value sep ppf m =
   let new_pp ppf (k, v) = fprintf ppf "%a -> %a" constructor k value v in
   fprintf ppf "%a" (list_sep new_pp sep) lst
 
-let lmap_sep value sep ppf m =
+let record_sep value sep ppf (m : 'a label_map) =
   let lst = LMap.to_kv_list m in
   let lst = List.sort (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
   let new_pp ppf (k, v) = fprintf ppf "%a -> %a" label k value v in
   fprintf ppf "%a" (list_sep new_pp sep) lst
 
+let tuple_sep value sep ppf m =
+  assert (Helpers.is_tuple_lmap m);
+  let lst = LMap.to_kv_list m in
+  let lst = List.sort (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
+  let new_pp ppf (_k, v) = fprintf ppf "%a" value v in
+  fprintf ppf "%a" (list_sep new_pp sep) lst
+
+(* Prints records which only contain the consecutive fields
+   0..(cardinal-1) as tuples *)
+let tuple_or_record_sep value format_record sep_record format_tuple sep_tuple ppf m =
+  if Helpers.is_tuple_lmap m then
+    fprintf ppf format_tuple (tuple_sep value (const sep_tuple)) m
+  else
+    fprintf ppf format_record (record_sep value (const sep_record)) m
+
 let list_sep_d x = list_sep x (const " , ")
 let cmap_sep_d x = cmap_sep x (const " , ")
-let lmap_sep_d x = lmap_sep x (const " , ")
+let tuple_or_record_sep_expr value = tuple_or_record_sep value "record[%a]" " , " "( %a )" " , "
+let tuple_or_record_sep_type value = tuple_or_record_sep value "record[%a]" " , " "( %a )" " * "
 
 let constant ppf : constant' -> unit = function
   | C_INT                   -> fprintf ppf "INT"
@@ -183,7 +198,7 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | T_sum m ->
         fprintf ppf "sum[%a]" (cmap_sep_d f) m
     | T_record m ->
-        fprintf ppf "record[%a]" (lmap_sep_d f) m
+        fprintf ppf "%a" (tuple_or_record_sep_type f) m
     | T_arrow a ->
         fprintf ppf "%a -> %a" f a.type1 f a.type2
     | T_variable tv ->

src/stages/common/helpers.ml

@@ -28,3 +28,13 @@ let bind_fold_lmap f init (lmap:_ LMap.t) =
 
 let bind_map_lmap f map = bind_lmap (LMap.map f map)
 let bind_map_cmap f map = bind_cmap (CMap.map f map)
+
+let range i j =
+  let rec aux i j acc = if i >= j then acc else aux i (j-1) (j-1 :: acc) in
+  aux i j []
+
+let label_range i j =
+  List.map (fun i -> Label (string_of_int i)) @@ range i j
+
+let is_tuple_lmap m =
+  List.for_all (fun i -> LMap.mem i m) @@ (label_range 0 (LMap.cardinal m))

src/stages/common/helpers.mli

@@ -0,0 +1,18 @@
+val bind_lmap :
+  ('a * 'b list, 'c) result Types.label_map ->
+  ('a Types.label_map * 'b list, 'c) result
+val bind_cmap :
+  ('a * 'b list, 'c) result Types.constructor_map ->
+  ('a Types.constructor_map * 'b list, 'c) result
+val bind_fold_lmap :
+  ('a -> Types.label -> 'b -> ('a * 'c list, 'd) result) ->
+  ('a * 'c list, 'd) result ->
+  'b Types.label_map -> ('a * 'c list, 'd) result
+val bind_map_lmap :
+  ('a -> ('b * 'c list, 'd) result) ->
+  'a Types.label_map -> ('b Types.label_map * 'c list, 'd) result
+val bind_map_cmap :
+  ('a -> ('b * 'c list, 'd) result) ->
+  'a Types.constructor_map ->
+  ('b Types.constructor_map * 'c list, 'd) result
+val is_tuple_lmap : 'a Types.label_map -> bool