Commit 3140f6e5 authored by Benjamin Canou's avatar Benjamin Canou

Michelson: allow multiple annotations

parent a51c9127
......@@ -10,8 +10,8 @@
type ('l, 'p) node =
| Int of 'l * Z.t
| String of 'l * string
| Prim of 'l * 'p * ('l, 'p) node list * string option
| Seq of 'l * ('l, 'p) node list * string option
| Prim of 'l * 'p * ('l, 'p) node list * string list
| Seq of 'l * ('l, 'p) node list
type canonical_location = int
......@@ -32,14 +32,14 @@ let canonical_location_encoding =
let location = function
| Int (loc, _) -> loc
| String (loc, _) -> loc
| Seq (loc, _, _) -> loc
| Seq (loc, _) -> loc
| Prim (loc, _, _, _) -> loc
let annotation = function
| Int (_, _) -> None
| String (_, _) -> None
| Seq (_, _, annot) -> annot
| Prim (_, _, _, annot) -> annot
let annotations = function
| Int (_, _) -> []
| String (_, _) -> []
| Seq (_, _) -> []
| Prim (_, _, _, annots) -> annots
let root (Canonical expr) = expr
......@@ -53,10 +53,10 @@ let strip_locations root =
Int (id, v)
| String (_, v) ->
String (id, v)
| Seq (_, seq, annot) ->
Seq (id, List.map strip_locations seq, annot)
| Prim (_, name, seq, annot) ->
Prim (id, name, List.map strip_locations seq, annot) in
| Seq (_, seq) ->
Seq (id, List.map strip_locations seq)
| Prim (_, name, seq, annots) ->
Prim (id, name, List.map strip_locations seq, annots) in
Canonical (strip_locations root)
let extract_locations root =
......@@ -71,12 +71,12 @@ let extract_locations root =
| String (loc, v) ->
loc_table := (id, loc) :: !loc_table ;
String (id, v)
| Seq (loc, seq, annot) ->
| Seq (loc, seq) ->
loc_table := (id, loc) :: !loc_table ;
Seq (id, List.map strip_locations seq, annot)
| Prim (loc, name, seq, annot) ->
Seq (id, List.map strip_locations seq)
| Prim (loc, name, seq, annots) ->
loc_table := (id, loc) :: !loc_table ;
Prim (id, name, List.map strip_locations seq, annot) in
Prim (id, name, List.map strip_locations seq, annots) in
let stripped = strip_locations root in
Canonical stripped, List.rev !loc_table
......@@ -87,19 +87,19 @@ let inject_locations lookup (Canonical root) =
Int (lookup loc, v)
| String (loc, v) ->
String (lookup loc, v)
| Seq (loc, seq, annot) ->
Seq (lookup loc, List.map inject_locations seq, annot)
| Prim (loc, name, seq, annot) ->
Prim (lookup loc, name, List.map inject_locations seq, annot) in
| Seq (loc, seq) ->
Seq (lookup loc, List.map inject_locations seq)
| Prim (loc, name, seq, annots) ->
Prim (lookup loc, name, List.map inject_locations seq, annots) in
inject_locations root
let map f (Canonical expr) =
let rec map_node f = function
| Int _ | String _ as node -> node
| Seq (loc, seq, annot) ->
Seq (loc, List.map (map_node f) seq, annot)
| Prim (loc, name, seq, annot) ->
Prim (loc, f name, List.map (map_node f) seq, annot) in
| Seq (loc, seq) ->
Seq (loc, List.map (map_node f) seq)
| Prim (loc, name, seq, annots) ->
Prim (loc, f name, List.map (map_node f) seq, annots) in
Canonical (map_node f expr)
let rec map_node fl fp = function
......@@ -107,10 +107,10 @@ let rec map_node fl fp = function
Int (fl loc, v)
| String (loc, v) ->
String (fl loc, v)
| Seq (loc, seq, annot) ->
Seq (fl loc, List.map (map_node fl fp) seq, annot)
| Prim (loc, name, seq, annot) ->
Prim (fl loc, fp name, List.map (map_node fl fp) seq, annot)
| Seq (loc, seq) ->
Seq (fl loc, List.map (map_node fl fp) seq)
| Prim (loc, name, seq, annots) ->
Prim (fl loc, fp name, List.map (map_node fl fp) seq, annots)
let canonical_encoding ~variant prim_encoding =
let open Data_encoding in
......@@ -131,18 +131,18 @@ let canonical_encoding ~variant prim_encoding =
let seq_encoding tag expr_encoding =
case tag (list expr_encoding)
~title:"Sequence"
(function Seq (_, v, _annot) -> Some v | _ -> None)
(fun args -> Seq (0, args, None)) in
(function Seq (_, v) -> Some v | _ -> None)
(fun args -> Seq (0, args)) in
let byte_string = Bounded.string 255 in
let application_encoding tag expr_encoding =
case tag
~title:"Generic prim (any number of args with or without annot)"
(obj3 (req "prim" prim_encoding)
(req "args" (list expr_encoding))
(opt "annot" byte_string))
(function Prim (_, prim, args, annot) -> Some (prim, args, annot)
(dft "args" (list expr_encoding) [])
(dft "annots" (list byte_string) []))
(function Prim (_, prim, args, annots) -> Some (prim, args, annots)
| _ -> None)
(fun (prim, args, annot) -> Prim (0, prim, args, annot)) in
(fun (prim, args, annots) -> Prim (0, prim, args, annots)) in
let node_encoding = mu ("micheline." ^ variant ^ ".expression") (fun expr_encoding ->
splitted
~json:(union ~tag_size:`Uint8
......@@ -158,37 +158,37 @@ let canonical_encoding ~variant prim_encoding =
case (Tag 3)
~title:"Prim (no args, annot)"
(obj1 (req "prim" prim_encoding))
(function Prim (_, v, [], None) -> Some v
(function Prim (_, v, [], []) -> Some v
| _ -> None)
(fun v -> Prim (0, v, [], None)) ;
(* No args, with annot *)
(fun v -> Prim (0, v, [], [])) ;
(* No args, with annots *)
case (Tag 4)
~title:"Prim (no args + annot)"
(obj2 (req "prim" prim_encoding)
(req "annot" byte_string))
(req "annots" (list byte_string)))
(function
| Prim (_, v, [], Some annot) -> Some (v, annot)
| Prim (_, v, [], annots) -> Some (v, annots)
| _ -> None)
(function (prim, annot) -> Prim (0, prim, [], Some annot)) ;
(function (prim, annots) -> Prim (0, prim, [], annots)) ;
(* Single arg, no annot *)
case (Tag 5)
~title:"Prim (1 arg, no annot)"
(obj2 (req "prim" prim_encoding)
(req "arg" expr_encoding))
(function
| Prim (_, v, [ arg ], None) -> Some (v, arg)
| Prim (_, v, [ arg ], []) -> Some (v, arg)
| _ -> None)
(function (prim, arg) -> Prim (0, prim, [ arg ], None)) ;
(function (prim, arg) -> Prim (0, prim, [ arg ], [])) ;
(* Single arg, with annot *)
case (Tag 6)
~title:"Prim (1 arg + annot)"
(obj3 (req "prim" prim_encoding)
(req "arg" expr_encoding)
(req "annot" byte_string))
(req "annots" (list byte_string)))
(function
| Prim (_, prim, [ arg ], Some annot) -> Some (prim, arg, annot)
| Prim (_, prim, [ arg ], annots) -> Some (prim, arg, annots)
| _ -> None)
(fun (prim, arg, annot) -> Prim (0, prim, [ arg ], Some annot)) ;
(fun (prim, arg, annots) -> Prim (0, prim, [ arg ], annots)) ;
(* Two args, no annot *)
case (Tag 7)
~title:"Prim (2 args, no annot)"
......@@ -196,20 +196,20 @@ let canonical_encoding ~variant prim_encoding =
(req "arg1" expr_encoding)
(req "arg2" expr_encoding))
(function
| Prim (_, prim, [ arg1 ; arg2 ], None) -> Some (prim, arg1, arg2)
| Prim (_, prim, [ arg1 ; arg2 ], []) -> Some (prim, arg1, arg2)
| _ -> None)
(fun (prim, arg1, arg2) -> Prim (0, prim, [ arg1 ; arg2 ], None)) ;
(* Two args, with annot *)
(fun (prim, arg1, arg2) -> Prim (0, prim, [ arg1 ; arg2 ], [])) ;
(* Two args, with annots *)
case (Tag 8)
~title:"Prim (2 args + annot)"
(obj4 (req "prim" prim_encoding)
(req "arg1" expr_encoding)
(req "arg2" expr_encoding)
(req "annot" byte_string))
(req "annots" (list byte_string)))
(function
| Prim (_, prim, [ arg1 ; arg2 ], Some annot) -> Some (prim, arg1, arg2, annot)
| Prim (_, prim, [ arg1 ; arg2 ], annots) -> Some (prim, arg1, arg2, annots)
| _ -> None)
(fun (prim, arg1, arg2, annot) -> Prim (0, prim, [ arg1 ; arg2 ], Some annot)) ;
(fun (prim, arg1, arg2, annots) -> Prim (0, prim, [ arg1 ; arg2 ], annots)) ;
(* General case *)
application_encoding (Tag 9) expr_encoding ]))
in
......
......@@ -13,8 +13,8 @@
type ('l, 'p) node =
| Int of 'l * Z.t
| String of 'l * string
| Prim of 'l * 'p * ('l, 'p) node list * string option
| Seq of 'l * ('l, 'p) node list * string option
| Prim of 'l * 'p * ('l, 'p) node list * string list
| Seq of 'l * ('l, 'p) node list
(** Encoding for expressions, as their {!canonical} encoding.
Locations are stored in a side table.
......@@ -33,8 +33,8 @@ val erased_encoding : variant:string ->
(** Extract the location of the node. *)
val location : ('l, 'p) node -> 'l
(** Extract the annotation of the node. *)
val annotation : ('l, 'p) node -> string option
(** Extract the annotations of the node. *)
val annotations : ('l, 'p) node -> string list
(** Expression form using canonical integer numbering as
locations. The root has number zero, and each node adds one in the
......
......@@ -152,7 +152,7 @@ let tokenize source =
| `Uchar c, start ->
begin match uchar_to_char c with
| Some ('a'..'z' | 'A'..'Z') -> ident acc start (fun s _ -> Ident s)
| Some '@' ->
| Some ('@' | ':' | '$' | '&' | '%' | '!' | '?') ->
ident acc start
(fun str stop ->
if String.length str > max_annot_length
......@@ -366,7 +366,7 @@ let min_point : node list -> point = function
| Int ({ start }, _) :: _
| String ({ start }, _) :: _
| Prim ({ start }, _, _, _) :: _
| Seq ({ start }, _, _) :: _ -> start
| Seq ({ start }, _) :: _ -> start
(* End of a sequence of consecutive primitives *)
let rec max_point : node list -> point = function
......@@ -375,7 +375,7 @@ let rec max_point : node list -> point = function
| Int ({ stop }, _) :: []
| String ({ stop }, _) :: []
| Prim ({ stop }, _, _, _) :: []
| Seq ({ stop }, _, _) :: [] -> stop
| Seq ({ stop }, _) :: [] -> stop
(* An item in the parser's state stack.
Not every value of type [mode list] is a valid parsing context.
......@@ -388,9 +388,9 @@ let rec max_point : node list -> point = function
type mode =
| Toplevel of node list
| Expression of node option
| Sequence of token * node list * string option
| Unwrapped of location * string * node list * string option
| Wrapped of token * string * node list * string option
| Sequence of token * node list
| Unwrapped of location * string * node list * string list
| Wrapped of token * string * node list * string list
(* Enter a new parsing state. *)
let push_mode mode stack =
......@@ -413,8 +413,8 @@ let fill_mode result = function
Expression (Some result) :: []
| Toplevel exprs :: [] ->
Toplevel (result :: exprs) :: []
| Sequence (token, exprs, annot) :: rest ->
Sequence (token, result :: exprs, annot) :: rest
| Sequence (token, exprs) :: rest ->
Sequence (token, result :: exprs) :: rest
| Wrapped (token, name, exprs, annot) :: rest ->
Wrapped (token, name, result :: exprs, annot) :: rest
| Unwrapped (start, name, exprs, annot) :: rest ->
......@@ -426,6 +426,12 @@ type error += Extra of token
type error += Misaligned of node
type error += Empty
let rec annots = function
| { token = Annot annot } :: rest ->
let annots, rest = annots rest in
annot :: annots, rest
| rest -> [], rest
let rec parse ?(check = true) errors tokens stack =
(* Two steps:
- 1. parse without checking indentation [parse]
......@@ -451,8 +457,8 @@ let rec parse ?(check = true) errors tokens stack =
| Expression None :: _, [] ->
let errors = Empty :: errors in
let ghost = { start = point_zero ; stop = point_zero} in
[ Seq (ghost, [], None) ], List.rev errors
| Toplevel [ Seq (_, exprs, _) as expr ] :: [],
[ Seq (ghost, []) ], List.rev errors
| Toplevel [ Seq (_, exprs) as expr ] :: [],
[] ->
let errors = if check then do_check ~toplevel: false errors expr else errors in
exprs, List.rev errors
......@@ -460,7 +466,7 @@ let rec parse ?(check = true) errors tokens stack =
[] ->
let exprs = List.rev exprs in
let loc = { start = min_point exprs ; stop = max_point exprs } in
let expr = Seq (loc, exprs, None) in
let expr = Seq (loc, exprs) in
let errors = if check then do_check ~toplevel: true errors expr else errors in
exprs, List.rev errors
(* Ignore comments *)
......@@ -517,19 +523,20 @@ let rec parse ?(check = true) errors tokens stack =
let fake = { token with token = Close_paren } in
let tokens = (* insert *) fake :: tokens in
parse ~check errors tokens stack
| (Sequence (token, _, _) :: _ | Unwrapped _ :: Sequence (token, _, _) :: _), [] ->
| (Sequence (token, _) :: _ | Unwrapped _ :: Sequence (token, _) :: _), [] ->
let errors = Unclosed token :: errors in
let fake = { token with token = Close_brace } in
let tokens = (* insert *) fake :: tokens in
parse ~check errors tokens stack
(* Valid states *)
| (Toplevel _ | Sequence (_, _, _)) :: _ ,
{ token = Ident name ; loc } :: { token = Annot annot } :: rest ->
let mode = Unwrapped (loc, name, [], Some annot) in
| (Toplevel _ | Sequence (_, _)) :: _ ,
{ token = Ident name ; loc } :: ({ token = Annot _ } :: _ as rest) ->
let annots, rest = annots rest in
let mode = Unwrapped (loc, name, [], annots) in
parse ~check errors rest (push_mode mode stack)
| (Expression None | Toplevel _ | Sequence (_, _, _)) :: _ ,
| (Expression None | Toplevel _ | Sequence (_, _)) :: _ ,
{ token = Ident name ; loc } :: rest ->
let mode = Unwrapped (loc, name, [], None) in
let mode = Unwrapped (loc, name, [], []) in
parse ~check errors rest (push_mode mode stack)
| (Unwrapped _ | Wrapped _) :: _,
{ token = Int value ; loc } :: rest
......@@ -545,10 +552,10 @@ let rec parse ?(check = true) errors tokens stack =
let expr : node = String (loc, contents) in
let errors = if check then do_check ~toplevel: false errors expr else errors in
parse ~check errors rest (fill_mode expr stack)
| Sequence ({ loc = { start } }, exprs, annot) :: _ ,
| Sequence ({ loc = { start } }, exprs) :: _ ,
{ token = Close_brace ; loc = { stop } } :: rest ->
let exprs = List.rev exprs in
let expr = Micheline.Seq ({ start ; stop }, exprs, annot) in
let expr = Micheline.Seq ({ start ; stop }, exprs) in
let errors = if check then do_check ~toplevel: false errors expr else errors in
parse ~check errors rest (fill_mode expr (pop_mode stack))
| (Sequence _ | Toplevel _) :: _ ,
......@@ -568,34 +575,31 @@ let rec parse ?(check = true) errors tokens stack =
let errors = if check then do_check ~toplevel: false errors expr else errors in
parse ~check errors rest (fill_mode expr (pop_mode stack))
| (Wrapped _ | Unwrapped _) :: _ ,
({ token = Open_paren } as token) :: { token = Ident name } :: { token = Annot annot } :: rest ->
let mode = Wrapped (token, name, [], Some annot) in
({ token = Open_paren } as token) :: { token = Ident name } :: ({ token = Annot _ } :: _ as rest) ->
let annots, rest = annots rest in
let mode = Wrapped (token, name, [], annots) in
parse ~check errors rest (push_mode mode stack)
| (Wrapped _ | Unwrapped _) :: _ ,
({ token = Open_paren } as token) :: { token = Ident name } :: rest ->
let mode = Wrapped (token, name, [], None) in
let mode = Wrapped (token, name, [], []) in
parse ~check errors rest (push_mode mode stack)
| (Wrapped _ | Unwrapped _) :: _ ,
{ token = Ident name ; loc } :: rest ->
let expr = Micheline.Prim (loc, name, [], None) in
let expr = Micheline.Prim (loc, name, [], []) in
let errors = if check then do_check ~toplevel: false errors expr else errors in
parse ~check errors rest (fill_mode expr stack)
| (Wrapped _ | Unwrapped _ | Toplevel _ | Sequence _ | Expression None) :: _ ,
({ token = Open_brace } as token) :: { token = Annot annot } :: rest ->
let mode = Sequence (token, [], Some annot) in
parse ~check errors rest (push_mode mode stack)
| (Wrapped _ | Unwrapped _ | Toplevel _ | Sequence _ | Expression None) :: _ ,
({ token = Open_brace } as token) :: rest ->
let mode = Sequence (token, [], None) in
let mode = Sequence (token, []) in
parse ~check errors rest (push_mode mode stack)
(* indentation checker *)
and do_check ?(toplevel = false) errors = function
| Seq ({ start ; stop }, [], _) as expr ->
| Seq ({ start ; stop }, []) as expr ->
if start.column >= stop.column then
Misaligned expr :: errors
else errors
| Prim ({ start ; stop }, _, first :: rest, _)
| Seq ({ start ; stop }, first :: rest, _) as expr ->
| Seq ({ start ; stop }, first :: rest) as expr ->
let { column = first_column ; line = first_line } =
min_point [ first ] in
if start.column >= stop.column then
......@@ -623,11 +627,12 @@ and do_check ?(toplevel = false) errors = function
let parse_expression ?check tokens =
let result = match tokens with
| ({ token = Open_paren } as token) :: { token = Ident name } :: { token = Annot annot } :: rest ->
let mode = Wrapped (token, name, [], Some annot) in
| ({ token = Open_paren } as token) :: { token = Ident name } :: { token = Annot _ } :: rest ->
let annots, rest = annots rest in
let mode = Wrapped (token, name, [], annots) in
parse ?check [] rest [ mode ; Expression None ]
| ({ token = Open_paren } as token) :: { token = Ident name } :: rest ->
let mode = Wrapped (token, name, [], None) in
let mode = Wrapped (token, name, [], []) in
parse ?check [] rest [ mode ; Expression None ]
| _ ->
parse ?check [] tokens [ Expression None ] in
......
......@@ -42,9 +42,9 @@ let preformat root =
(false, 0)
| { comment = Some text } ->
(String.contains text '\n', String.length text + 1) in
let preformat_annot = function
| None -> 0
| Some annot -> String.length annot + 2 in
let preformat_annots = function
| [] -> 0
| annots -> String.length (String.concat " " annots) + 2 in
let rec preformat_expr = function
| Int (loc, value) ->
let cml, csz = preformat_loc loc in
......@@ -52,9 +52,9 @@ let preformat root =
| String (loc, value) ->
let cml, csz = preformat_loc loc in
String ((cml, String.length value + csz, loc), value)
| Prim (loc, name, items, annot) ->
| Prim (loc, name, items, annots) ->
let cml, csz = preformat_loc loc in
let asz = preformat_annot annot in
let asz = preformat_annots annots in
let items = List.map preformat_expr items in
let ml, sz =
List.fold_left
......@@ -63,26 +63,25 @@ let preformat root =
(tml || ml, tsz + 1 + sz))
(cml, String.length name + csz + asz)
items in
Prim ((ml, sz, loc), name, items, annot)
| Seq (loc, items, annot) ->
Prim ((ml, sz, loc), name, items, annots)
| Seq (loc, items) ->
let cml, csz = preformat_loc loc in
let asz = preformat_annot annot in
let items = List.map preformat_expr items in
let ml, sz =
List.fold_left
(fun (tml, tsz) e ->
let (ml, sz, _) = location e in
(tml || ml, tsz + 3 + sz))
(cml, 4 + csz + asz)
(cml, 4 + csz)
items in
Seq ((ml, sz, loc), items, annot) in
Seq ((ml, sz, loc), items) in
preformat_expr root
let rec print_expr_unwrapped ppf = function
| Prim ((ml, s, { comment }), name, args, annot) ->
let name = match annot with
| None -> name
| Some annot -> Format.asprintf "%s %s" name annot in
| [] -> name
| annots -> Format.asprintf "%s @[<h>%a@]" name (Format.pp_print_list Format.pp_print_string) annots in
if not ml && s < 80 then begin
if args = [] then
Format.fprintf ppf "%s" name
......@@ -114,18 +113,13 @@ let rec print_expr_unwrapped ppf = function
| None -> print_string ppf value
| Some comment -> Format.fprintf ppf "%a@ %a" print_string value print_comment comment
end
| Seq ((_, _, { comment = None }), [], None) ->
| Seq ((_, _, { comment = None }), []) ->
Format.fprintf ppf "{}"
| Seq ((ml, s, { comment }), items, annot) ->
| Seq ((ml, s, { comment }), items) ->
if not ml && s < 80 then
Format.fprintf ppf "{ @[<h 0>"
else
Format.fprintf ppf "{ @[<v 0>" ;
begin match annot, comment, items with
| None, _, _ -> ()
| Some annot, None, [] -> Format.fprintf ppf "%s" annot
| Some annot, _, _ -> Format.fprintf ppf "%s@ " annot
end ;
begin match comment, items with
| None, _ -> ()
| Some comment, [] -> Format.fprintf ppf "%a" print_comment comment
......@@ -139,7 +133,7 @@ let rec print_expr_unwrapped ppf = function
and print_expr ppf = function
| Prim (_, _, _ :: _, _)
| Prim (_, _, [], Some _) as expr ->
| Prim (_, _, [], _ :: _) as expr ->
Format.fprintf ppf "(%a)" print_expr_unwrapped expr
| expr -> print_expr_unwrapped ppf expr
......
......@@ -10,8 +10,8 @@
type ('l, 'p) node =
| Int of 'l * Z.t
| String of 'l * string
| Prim of 'l * 'p * ('l, 'p) node list * string option
| Seq of 'l * ('l, 'p) node list * string option
| Prim of 'l * 'p * ('l, 'p) node list * string list
| Seq of 'l * ('l, 'p) node list
type 'p canonical
type canonical_location = int
......@@ -23,7 +23,7 @@ val erased_encoding : variant:string -> 'l -> 'p Data_encoding.encoding -> ('l,
val table_encoding : variant:string -> 'l Data_encoding.encoding -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding
val location : ('l, 'p) node -> 'l
val annotation : ('l, 'p) node -> string option
val annotations : ('l, 'p) node -> string list
val strip_locations : (_, 'p) node -> 'p canonical
val extract_locations : ('l, 'p) node -> 'p canonical * (canonical_location * 'l) list
......
......@@ -13,17 +13,16 @@ open Micheline
let print_expr ppf expr =
let print_annot ppf = function
| None -> ()
| Some annot -> Format.fprintf ppf " %s" annot in
| [] -> ()
| annots -> Format.fprintf ppf " %s" (String.concat " " annots) in
let rec print_expr ppf = function
| Int (_, value) -> Format.fprintf ppf "%s" (Z.to_string value)
| String (_, value) -> Micheline_printer.print_string ppf value
| Seq (_, items, annot) ->
Format.fprintf ppf "(seq%a %a)"
print_annot annot
| Seq (_, items) ->
Format.fprintf ppf "(seq %a)"
(Format.pp_print_list ~pp_sep:Format.pp_print_space print_expr)
items
| Prim (_, name, [], None) ->
| Prim (_, name, [], []) ->
Format.fprintf ppf "%s" name
| Prim (_, name, items, annot) ->
Format.fprintf ppf "(%s%a%s%a)"
......@@ -39,12 +38,12 @@ open Script_tc_errors
let print_type_map ppf (parsed, type_map) =
let rec print_expr_types ppf = function
| Seq (loc, [], _)
| Seq (loc, [])
| Prim (loc, _, [], _)
| Int (loc, _)
| String (loc, _) ->
print_item ppf loc
| Seq (loc, items, _)
| Seq (loc, items)
| Prim (loc, _, items, _) ->
print_item ppf loc ;
List.iter (print_expr_types ppf) items
......
......@@ -148,7 +148,7 @@ let report_errors ~details ~show_source ?parsed ppf errs =
| Some s -> Format.fprintf ppf "%s " s)
name
print_source (parsed, hilights)
print_ty (None, ty) ;
print_ty ([], ty) ;
if rest <> [] then Format.fprintf ppf "@," ;
print_trace (parsed_locations parsed) rest
| Alpha_environment.Ecoproto_error (Ill_formed_type (_, expr, loc)) :: rest ->
......@@ -325,21 +325,21 @@ let report_errors ~details ~show_source ?parsed ppf errs =
@[<hov 2>and@ %a.@]@]"
print_loc loc
(Michelson_v1_primitives.string_of_prim name)
print_ty (None, tya)
print_ty (None, tyb)
print_ty ([], tya)
print_ty ([], tyb)
| Undefined_unop (loc, name, ty) ->
Format.fprintf ppf
"@[<hov 0>@[<hov 2>%aoperator %s is undefined on@ %a@]@]"
print_loc loc
(Michelson_v1_primitives.string_of_prim name)
print_ty (None, ty)
print_ty ([], ty)
| Bad_return (loc, got, exp) ->
Format.fprintf ppf
"@[<v 2>%awrong stack type at end of body:@,\
- @[<v 0>expected return stack type:@ %a,@]@,\
- @[<v 0>actual stack type:@ %a.@]@]"
print_loc loc
(fun ppf -> print_stack_ty ppf) (Item_t (exp, Empty_t, None))
(fun ppf -> print_stack_ty ppf) (Item_t (exp, Empty_t, []))
(fun ppf -> print_stack_ty ppf) got
| Bad_stack (loc, name, depth, sty) ->
Format.fprintf ppf
......@@ -358,17 +358,18 @@ let report_errors ~details ~show_source ?parsed ppf errs =
| Inconsistent_annotations (annot1, annot2) ->
Format.fprintf ppf
"@[<v 2>The two annotations do not match:@,\
- @[<hov>%s@]@,\
- @[<hov>%s@]"
annot1 annot2
- @[<v>%a@]@,\
- @[<v>%a@]@]"
(Format.pp_print_list Format.pp_print_string) annot1
(Format.pp_print_list Format.pp_print_string) annot2
| Inconsistent_type_annotations (loc, ty1, ty2) ->
Format.fprintf ppf
"@[<v 2>%athe two types contain incompatible annotations:@,\
- @[<hov>%a@]@,\
- @[<hov>%a@]"
- @[<hov>%a@]@]"
print_loc loc
print_ty (None, ty1)
print_ty (None, ty2)
print_ty ([], ty1)
print_ty ([], ty2)
| Unexpected_annotation loc ->
Format.fprintf ppf
"@[<v 2>%aunexpected annotation."
......@@ -395,7 +396,7 @@ let report_errors ~details ~show_source ?parsed ppf errs =
@[<hov 2>is invalid for type@ %a.@]@]"
print_loc loc
print_expr got
print_ty (None, exp)
print_ty ([], exp)
| Invalid_contract (loc, contract) ->
Format.fprintf ppf
"%ainvalid contract %a."
......@@ -404,13 +405,13 @@ let report_errors ~details ~show_source ?parsed ppf errs =
Format.fprintf ppf "%acomparable type expected."
print_loc loc ;
Format.fprintf ppf "@[<hov 0>@[<hov 2>Type@ %a@]@ is not comparable.@]"
print_ty (None, ty)
print_ty ([], ty)
| Inconsistent_types (tya, tyb) ->
Format.fprintf ppf
"@[<hov 0>@[<hov 2>Type@ %a@]@ \
@[<hov 2>is not compatible with type@ %a.@]@]"
print_ty (None, tya)
print_ty (None, tyb)
print_ty ([], tya)
print_ty ([], tyb)
| Reject loc ->
Format.fprintf ppf "%ascript reached FAIL instruction"
print_loc loc
......
......@@ -54,7 +54,7 @@ let expand_all source ast errors =
errors @ expansion_errors
| Error errs ->