Merge branch '92-map_update-key_hash-is-not-comparable' into 'dev'

Resolve "map_update: key_hash is not comparable"

Closes #92

See merge request ligolang/ligo!310

src/bin/expect_tests/contract_tests.ml

@@ -939,7 +939,7 @@ let%expect_test _ =
 
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; contract "bad_address_format.religo" ; "main" ] ;
-  [%expect {| ligo: in file "bad_address_format.religo", line 2, characters 25-47. Badly formatted address "KT1badaddr":  {"location":"in file \"bad_address_format.religo\", line 2, characters 25-47"} |}]
+  [%expect {| ligo: in file "bad_address_format.religo", line 2, characters 25-47. Badly formatted literal: address "KT1badaddr" {"location":"in file \"bad_address_format.religo\", line 2, characters 25-47"} |}]
 
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; contract "bad_timestamp.ligo" ; "main" ] ;

src/passes/3-self_ast_simplified/literals.ml

@@ -3,23 +3,32 @@ open Trace
 open Proto_alpha_utils
 
 module Errors = struct
-  let bad_literal_address s_addr loc () =
-    let title = (thunk ("Badly formatted address \""^s_addr^"\"")) in
-    let message () = "" in
+
+  let bad_format e () =
+    let title = (thunk ("Badly formatted literal")) in
+    let message () = Format.asprintf "%a" Ast_simplified.PP.expression e in
     let data = [
-      ("location" , fun () -> Format.asprintf "%a" Location.pp loc)
+      ("location" , fun () -> Format.asprintf "%a" Location.pp e.location)
     ] in
     error ~data title message ()
+
 end
 open Errors
 
 let peephole_expression : expression -> expression result = fun e ->
   let return expression = ok { e with expression } in
   match e.expression with
+  | E_literal (Literal_key_hash s) as l -> (
+    let open Tezos_crypto in
+    let%bind (_pkh:Crypto.Signature.public_key_hash) =
+      Trace.trace_tzresult (bad_format e) @@
+      Signature.Public_key_hash.of_b58check s in
+    return l
+    )
   | E_literal (Literal_address s) as l -> (
     let open Memory_proto_alpha in
     let%bind (_contract:Protocol.Alpha_context.Contract.t) = 
-      Trace.trace_alpha_tzresult (bad_literal_address s e.location) @@
+      Trace.trace_alpha_tzresult (bad_format e) @@
       Protocol.Alpha_context.Contract.of_b58check s in
     return l
     )

src/passes/3-self_ast_simplified/tezos_type_annotation.ml

@@ -17,6 +17,7 @@ let peephole_expression : expression -> expression result = fun e ->
   match e.expression with
   | E_ascription (e' , t) as e -> (
       match (e'.expression , t.type_expression') with
+      | (E_literal (Literal_string s) , T_constant (TC_key_hash)) -> return @@ E_literal (Literal_key_hash s)
       | (E_literal (Literal_int i) , T_constant (TC_timestamp)) -> return @@ E_literal (Literal_timestamp i)
       | (E_literal (Literal_string str) , T_constant (TC_timestamp)) ->
         let%bind time =

src/passes/8-compiler/compiler_type.ml

@@ -15,6 +15,7 @@ module Ty = struct
   let tez_k = Mutez_key None
   let int_k = Int_key None
   let string_k = String_key None
+  let key_hash_k = Key_hash_key None
   let address_k = Address_key None
   let timestamp_k = Timestamp_key None
   let bytes_k = Bytes_key None
@@ -72,7 +73,7 @@ module Ty = struct
     | Base_operation -> fail (not_comparable "operation")
     | Base_signature -> fail (not_comparable "signature")
     | Base_key -> fail (not_comparable "key")
-    | Base_key_hash -> fail (not_comparable "key_hash")
+    | Base_key_hash -> return key_hash_k
     | Base_chain_id -> fail (not_comparable "chain_id")
 
   let comparable_type : type_value -> ex_comparable_ty result = fun tv ->

src/stages/common/PP.ml

@@ -190,12 +190,12 @@ let literal ppf (l:literal) = match l with
   | Literal_mutez n -> fprintf ppf "%dmutez" n
   | Literal_string s -> fprintf ppf "%S" s
   | Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
-  | Literal_address s -> fprintf ppf "@%S" s
+  | Literal_address s -> fprintf ppf "address %S" s
   | Literal_operation _ -> fprintf ppf "Operation(...bytes)"
   | Literal_key s      -> fprintf ppf "key %s" s
   | Literal_key_hash s -> fprintf ppf "key_hash %s" s
-  | Literal_signature s -> fprintf ppf "Signature %s" s
-  | Literal_chain_id s -> fprintf ppf "Chain_id %s" s
+  | Literal_signature s -> fprintf ppf "signature %s" s
+  | Literal_chain_id s -> fprintf ppf "chain_id %s" s
 
 let%expect_test _ =
   Format.printf "%a" literal (Literal_bytes (Bytes.of_string "foo")) ;

src/test/multisig_tests.ml

@@ -17,10 +17,10 @@ let get_program =
       )
 
 let compile_main () = 
-  let%bind simplified      = Ligo.Compile.Of_source.compile "./contracts/multisig.ligo" (Syntax_name "pascaligo") in
-  let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
-  let%bind mini_c_prg      = Ligo.Compile.Of_typed.compile typed_prg in
-  let%bind michelson_prg   = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
+  let%bind simplified    = Ligo.Compile.Of_source.compile "./contracts/multisig.ligo" (Syntax_name "pascaligo") in
+  let%bind typed_prg,_   = Ligo.Compile.Of_simplified.compile simplified in
+  let%bind mini_c_prg    = Ligo.Compile.Of_typed.compile typed_prg in
+  let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
   let%bind (_contract: Tezos_utils.Michelson.michelson) =
     (* fails if the given entry point is not a valid contract *)
     Ligo.Compile.Of_michelson.build_contract michelson_prg in