more error messages; various fixes

src/ast_typed/combinators.ml

@@ -20,6 +20,7 @@ let t_address ?s () : type_value = make_t (T_constant ("address", [])) s
 let t_operation ?s () : type_value = make_t (T_constant ("operation", [])) s
 let t_nat ?s () : type_value = make_t (T_constant ("nat", [])) s
 let t_tez ?s () : type_value = make_t (T_constant ("tez", [])) s
+let t_timestamp ?s () : type_value = make_t (T_constant ("timestamp", [])) s
 let t_unit ?s () : type_value = make_t (T_constant ("unit", [])) s
 let t_option o ?s () : type_value = make_t (T_constant ("option", [o])) s
 let t_tuple lst ?s () : type_value = make_t (T_tuple lst) s

src/bin/cli.ml

@@ -6,7 +6,9 @@ let error_pp out (e : error) =
   let message =
     let opt = e |> member "message" |> string in
     let msg = Option.unopt ~default:"" opt in
-    ": " ^ msg in
+    if msg = ""
+    then ""
+    else ": " ^ msg in
   let error_code =
     let error_code = e |> member "error_code" in
     match error_code with
@@ -20,7 +22,12 @@ let error_pp out (e : error) =
     match data with
     | `Null -> ""
     | _ -> " " ^ (J.to_string data) ^ "\n" in
-  Format.fprintf out "%s%s%s.\n%s" title error_code message data
+  let infos =
+    let infos = e |> member "infos" in
+    match infos with
+    | `Null -> ""
+    | _ -> " " ^ (J.to_string infos) ^ "\n" in
+  Format.fprintf out "%s%s%s.\n%s%s" title error_code message data infos
 
 
 let toplevel x =
@@ -71,7 +78,7 @@ let compile_file =
     let%bind contract =
       trace (simple_info "compiling contract to michelson") @@
       Ligo.Run.compile_contract_file source entry_point syntax in
-    Format.printf "Contract:\n%s\n" contract ;
+    Format.printf "%s\n" contract ;
     ok ()
   in
   let term =
@@ -86,7 +93,7 @@ let compile_parameter =
     let%bind value =
       trace (simple_error "compile-input") @@
       Ligo.Run.compile_contract_parameter source entry_point expression syntax in
-    Format.printf "Input:\n%s\n" value;
+    Format.printf "%s\n" value;
     ok ()
   in
   let term =
@@ -101,7 +108,7 @@ let compile_storage =
     let%bind value =
       trace (simple_error "compile-storage") @@
       Ligo.Run.compile_contract_storage source entry_point expression syntax in
-    Format.printf "Storage:\n%s\n" value;
+    Format.printf "%s\n" value;
     ok ()
   in
   let term =

src/compiler/compiler_type.ml

@@ -22,6 +22,7 @@ module Ty = struct
     | Base_int -> return int_k
     | Base_string -> return string_k
     | Base_address -> return address_k
+    | Base_timestamp -> return timestamp_k
     | Base_bytes -> return bytes_k
     | Base_operation -> fail (not_comparable "operation")
 
@@ -48,6 +49,7 @@ module Ty = struct
     | Base_tez -> return tez
     | Base_string -> return string
     | Base_address -> return address
+    | Base_timestamp -> return timestamp
     | Base_bytes -> return bytes
     | Base_operation -> return operation
 
@@ -117,6 +119,7 @@ let base_type : type_base -> O.michelson result =
   | Base_tez -> ok @@ O.prim T_mutez
   | Base_string -> ok @@ O.prim T_string
   | Base_address -> ok @@ O.prim T_address
+  | Base_timestamp -> ok @@ O.prim T_timestamp
   | Base_bytes -> ok @@ O.prim T_bytes
   | Base_operation -> ok @@ O.prim T_operation
 

src/mini_c/PP.ml

@@ -16,6 +16,7 @@ let type_base ppf : type_base -> _ = function
   | Base_tez -> fprintf ppf "tez"
   | Base_string -> fprintf ppf "string"
   | Base_address -> fprintf ppf "address"
+  | Base_timestamp -> fprintf ppf "timestamp"
   | Base_bytes -> fprintf ppf "bytes"
   | Base_operation -> fprintf ppf "operation"
 

src/mini_c/types.ml

@@ -4,6 +4,7 @@ type type_base =
   | Base_unit
   | Base_bool
   | Base_int | Base_nat | Base_tez
+  | Base_timestamp
   | Base_string | Base_bytes | Base_address
   | Base_operation
 

src/operators/operators.ml

@@ -42,6 +42,7 @@ module Simplify = struct
     ("bool" , "bool") ;
     ("operation" , "operation") ;
     ("address" , "address") ;
+    ("timestamp" , "timestamp") ;
     ("contract" , "contract") ;
     ("list" , "list") ;
     ("option" , "option") ;
@@ -60,8 +61,10 @@ module Simplify = struct
       ("int" , "INT") ;
       ("abs" , "ABS") ;
       ("amount" , "AMOUNT") ;
+      ("now" , "NOW") ;
       ("unit" , "UNIT") ;
       ("source" , "SOURCE") ;
+      ("sender" , "SENDER") ;
       ("failwith" , "FAILWITH") ;
     ]
 
@@ -169,14 +172,15 @@ module Typer = struct
     | Some t -> ok t
 
   let sub = typer_2 "SUB" @@ fun a b ->
-    let%bind () =
+    if (eq_2 (a , b) (t_int ()))
-      trace_strong (simple_error "Types a and b aren't numbers") @@
+    then ok @@ t_int () else
-      Assert.assert_true @@
+    if (eq_2 (a , b) (t_nat ()))
-      List.exists (eq_2 (a , b)) [
+    then ok @@ t_int () else
-        t_int () ;
+    if (eq_2 (a , b) (t_timestamp ()))
-        t_nat () ;
+    then ok @@ t_int () else
-      ] in
+    if (eq_2 (a , b) (t_tez ()))
-    ok @@ t_int ()
+    then ok @@ t_tez () else
+      fail (simple_error "Typing substraction, bad parameters.")
 
   let some = typer_1 "SOME" @@ fun a -> ok @@ t_option a ()
 
@@ -232,6 +236,8 @@ module Typer = struct
 
   let amount = constant "AMOUNT" @@ t_tez ()
 
+  let now = constant "NOW" @@ t_timestamp ()
+
   let transaction = typer_3 "CALL" @@ fun param amount contract ->
     let%bind () = assert_t_tez amount in
     let%bind contract_param = get_t_contract contract in
@@ -264,6 +270,8 @@ module Typer = struct
     then ok @@ t_nat () else
     if eq_2 (a , b) (t_int ())
     then ok @@ t_int () else
+    if eq_1 a (t_tez ()) && eq_1 b (t_nat ())
+    then ok @@ t_tez () else
       simple_fail "Dividing with wrong types"
 
   let mod_ = typer_2 "MOD" @@ fun a b ->
@@ -276,9 +284,11 @@ module Typer = struct
     then ok @@ t_nat () else
     if eq_2 (a , b) (t_int ())
     then ok @@ t_int () else
+    if eq_2 (a , b) (t_tez ())
+    then ok @@ t_tez () else
     if (eq_1 a (t_nat ()) && eq_1 b (t_int ())) || (eq_1 b (t_nat ()) && eq_1 a (t_int ()))
     then ok @@ t_int () else
-      simple_fail "Adding with wrong types"
+      simple_fail "Adding with wrong types. Expected nat, int or tez."
 
   let constant_typers = Map.String.of_list [
       add ;
@@ -312,6 +322,7 @@ module Typer = struct
       transaction ;
       get_contract ;
       abs ;
+      now ;
     ]
 
 end
@@ -364,6 +375,7 @@ module Compiler = struct
     ("CONS" , simple_binary @@ prim I_CONS) ;
     ("UNIT" , simple_constant @@ prim I_UNIT) ;
     ("AMOUNT" , simple_constant @@ prim I_AMOUNT) ;
+    ("NOW" , simple_constant @@ prim I_NOW) ;
     ("CALL" , simple_ternary @@ prim I_TRANSFER_TOKENS) ;
     ("SOURCE" , simple_constant @@ prim I_SOURCE) ;
     ("SENDER" , simple_constant @@ prim I_SENDER) ;

src/simplify/pascaligo.ml

@@ -346,7 +346,7 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
 
 and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result =
   match lst with
-  | [] -> assert false
+  | [] -> ok @@ t_unit
   | [hd] -> simpl_type_expression hd
   | lst ->
       let%bind lst = bind_list @@ List.map simpl_type_expression lst in

src/transpiler/transpiler.ml

@@ -93,6 +93,7 @@ let rec translate_type (t:AST.type_value) : type_value result =
   | T_constant ("tez", []) -> ok (T_base Base_tez)
   | T_constant ("string", []) -> ok (T_base Base_string)
   | T_constant ("address", []) -> ok (T_base Base_address)
+  | T_constant ("timestamp", []) -> ok (T_base Base_timestamp)
   | T_constant ("unit", []) -> ok (T_base Base_unit)
   | T_constant ("operation", []) -> ok (T_base Base_operation)
   | T_constant ("contract", [x]) ->

src/typer/typer.ml

@@ -206,6 +206,13 @@ module Errors = struct
     ] in
     error ~data title message ()
 
+  let constant_error loc =
+    let title () = "typing constant" in
+    let message () = "" in
+    let data = [
+      ("location" , fun () -> Format.asprintf "%a" Location.pp loc ) ;
+    ] in
+    error ~data title message
 end
 open Errors
 
@@ -377,14 +384,13 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
     ok @@ make_a_e ~location expr tv e in
   let main_error =
     let title () = "typing expression" in
-    let content () =
+    let content () = "" in
-      match L.get () with
+    let data = [
-      | "" ->
+      ("expression" , fun () -> Format.asprintf "%a" I.PP.expression ae) ;
-        Format.asprintf "Expression: %a\n" I.PP.expression ae
+      ("location" , fun () -> Format.asprintf "%a" Location.pp @@ Location.get_location ae) ;
-      | l ->
+      ("misc" , fun () -> L.get ()) ;
-        Format.asprintf "Expression: %a\nLog: %s\n" I.PP.expression ae l
+    ] in
-    in
+    error ~data title content in
-    error title content in
   trace main_error @@
   match Location.unwrap ae with
   (* Basic *)
@@ -563,7 +569,8 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
   | E_constant (name, lst) ->
       let%bind lst' = bind_list @@ List.map (type_expression e) lst in
       let tv_lst = List.map get_type_annotation lst' in
-      let%bind (name', tv) = type_constant name tv_lst tv_opt ae.location in
+      let%bind (name', tv) =
+        type_constant name tv_lst tv_opt ae.location in
       return (E_constant (name' , lst')) tv
   | E_application (f, arg) ->
       let%bind f' = type_expression e f in
@@ -731,6 +738,7 @@ and type_constant (name:string) (lst:O.type_value list) (tv_opt:O.type_value opt
   let%bind typer =
     trace_option (unrecognized_constant name loc) @@
     Map.String.find_opt name ct in
+  trace (constant_error loc) @@
   typer lst tv_opt
 
 let untype_type_value (t:O.type_value) : (I.type_expression) result =