Michelson: mv typechecking error definitions to a separate file

src/proto_alpha/lib_client/client_proto_programs.ml

@@ -110,7 +110,7 @@ let print_typecheck_result
     let type_map, errs = match res with
       | Ok type_map -> type_map, []
       | Error (Environment.Ecoproto_error
-                 (Script_ir_translator.Ill_typed_contract (_, type_map ) :: _)
+                 (Script_tc_errors.Ill_typed_contract (_, type_map ) :: _)
                :: _ as errs) ->
           type_map, errs
       | Error errs ->

src/proto_alpha/lib_client/client_proto_programs.mli

@@ -66,13 +66,13 @@ val typecheck_program :
   Michelson_v1_parser.parsed ->
   Client_proto_rpcs.block ->
   #Client_rpcs.ctxt ->
-  Script_ir_translator.type_map tzresult Lwt.t
+  Script_tc_errors.type_map tzresult Lwt.t
 
 val print_typecheck_result :
   emacs:bool ->
   show_types:bool ->
   print_source_on_error:bool ->
   Michelson_v1_parser.parsed ->
-  (Script_ir_translator.type_map, error list) result ->
+  (Script_tc_errors.type_map, error list) result ->
   #Client_commands.logger ->
   unit tzresult Lwt.t

src/proto_alpha/lib_client/client_proto_rpcs.mli

@@ -169,7 +169,7 @@ module Helpers : sig
      (Script.location * Gas.t * Script.expr list) list) tzresult Lwt.t
   val typecheck_code:
     #Client_rpcs.ctxt ->
-    block -> Script.expr -> Script_ir_translator.type_map tzresult Lwt.t
+    block -> Script.expr -> Script_tc_errors.type_map tzresult Lwt.t
   val typecheck_data:
     #Client_rpcs.ctxt ->
     block -> Script.expr * Script.expr -> unit tzresult Lwt.t

src/proto_alpha/lib_client/michelson_v1_emacs.ml

@@ -35,7 +35,7 @@ let print_expr ppf expr =
   Format.fprintf ppf "@[<h>%a@]" print_expr root
 
 open Micheline_parser
-open Script_ir_translator
+open Script_tc_errors
 
 let print_type_map ppf (parsed, type_map) =
   let rec print_expr_types ppf = function

src/proto_alpha/lib_client/michelson_v1_emacs.mli

@@ -16,7 +16,7 @@ val print_expr :
   unit
 val print_type_map :
   Format.formatter ->
-  Michelson_v1_parser.parsed * Script_ir_translator.type_map ->
+  Michelson_v1_parser.parsed * Script_tc_errors.type_map ->
   unit
 val report_errors :
   Format.formatter ->

src/proto_alpha/lib_client/michelson_v1_error_reporter.ml

@@ -11,6 +11,7 @@ open Proto_alpha
 open Tezos_context
 open Tezos_micheline
 open Script_typed_ir
+open Script_tc_errors
 open Script_ir_translator
 open Script_interpreter
 open Michelson_v1_printer

src/proto_alpha/lib_client/michelson_v1_printer.mli

@@ -20,12 +20,12 @@ val print_expr_unwrapped :
 (** Insert the type map returned by the typechecker as comments in a
     printable Micheline AST. *)
 val inject_types :
-  Script_ir_translator.type_map ->
+  Script_tc_errors.type_map ->
   Michelson_v1_parser.parsed ->
   Micheline_printer.node
 
 (** Unexpand the macros and produce the result of parsing an
     intermediate pretty printed source. Useful when working with
     contracts extracted from the blockchain and not local files. *)
-val unparse_toplevel : ?type_map: Script_ir_translator.type_map -> Script.expr -> Michelson_v1_parser.parsed
+val unparse_toplevel : ?type_map: Script_tc_errors.type_map -> Script.expr -> Michelson_v1_parser.parsed
 val unparse_expression : Script.expr -> Michelson_v1_parser.parsed

src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL

@@ -47,6 +47,7 @@
 
         "Script_typed_ir",
         "Gas",
+	"Script_tc_errors",
         "Script_ir_translator",
         "Script_interpreter",
 

src/proto_alpha/lib_protocol/src/script_interpreter.ml

@@ -10,6 +10,7 @@
 open Tezos_context
 open Script
 open Script_typed_ir
+open Script_tc_errors
 open Script_ir_translator
 
 let dummy_code_fee = Tez.fifty_cents

src/proto_alpha/lib_protocol/src/script_ir_translator.ml

@@ -11,56 +11,7 @@ open Tezos_context
 open Micheline
 open Script
 open Script_typed_ir
-
+open Script_tc_errors
-(* ---- Error definitions ---------------------------------------------------*)
-
-(* Auxiliary types for error documentation *)
-type namespace = Type_namespace | Constant_namespace | Instr_namespace | Keyword_namespace
-type kind = Int_kind | String_kind | Prim_kind | Seq_kind
-type type_map = (int * (Script.expr list * Script.expr list)) list
-
-(* Structure errors *)
-type error += Invalid_arity of Script.location * prim * int * int
-type error += Invalid_namespace of Script.location * prim * namespace * namespace
-type error += Invalid_primitive of Script.location * prim list * prim
-type error += Invalid_kind of Script.location * kind list * kind
-type error += Missing_field of prim
-type error += Duplicate_field of Script.location * prim
-
-(* Instruction typing errors *)
-type error += Fail_not_in_tail_position of Script.location
-type error += Undefined_binop : Script.location * prim * _ ty * _ ty -> error
-type error += Undefined_unop : Script.location * prim * _ ty -> error
-type error += Bad_return : Script.location * _ stack_ty * _ ty -> error
-type error += Bad_stack : Script.location * prim * int * _ stack_ty -> error
-type error += Unmatched_branches : Script.location * _ stack_ty * _ stack_ty -> error
-type error += Transfer_in_lambda of Script.location
-type error += Transfer_in_dip of Script.location
-type error += Self_in_lambda of Script.location
-type error += Bad_stack_length
-type error += Bad_stack_item of int
-type error += Inconsistent_annotations of string * string
-type error += Inconsistent_type_annotations : Script.location * _ ty * _ ty -> error
-type error += Unexpected_annotation of Script.location
-type error += Invalid_map_body : Script.location * _ stack_ty -> error
-type error += Invalid_map_block_fail of Script.location
-type error += Invalid_iter_body : Script.location * _ stack_ty * _ stack_ty -> error
-type error += Type_too_large : Script.location * int * int -> error
-
-(* Value typing errors *)
-type error += Invalid_constant : Script.location * Script.expr * _ ty -> error
-type error += Invalid_contract of Script.location * Contract.t
-type error += Comparable_type_expected : Script.location * _ ty -> error
-type error += Inconsistent_types : _ ty * _ ty -> error
-type error += Unordered_map_keys of Script.location * Script.expr
-type error += Unordered_set_values of Script.location * Script.expr
-type error += Duplicate_map_keys of Script.location * Script.expr
-type error += Duplicate_set_values of Script.location * Script.expr
-
-(* Toplevel errors *)
-type error += Ill_typed_data : string option * Script.expr * _ ty -> error
-type error += Ill_formed_type of string option * Script.expr * Script.location
-type error += Ill_typed_contract : Script.expr * type_map -> error
 
 type ex_comparable_ty = Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty
 type ex_ty = Ex_ty : 'a ty -> ex_ty

src/proto_alpha/lib_protocol/src/script_ir_translator.mli

@@ -8,6 +8,7 @@
 (**************************************************************************)
 
 open Tezos_context
+open Script_tc_errors
 
 type ('ta, 'tb) eq = Eq : ('same, 'same) eq
 
@@ -16,58 +17,6 @@ type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty
 type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty
 type ex_script = Ex_script : ('a, 'b, 'c) Script_typed_ir.script -> ex_script
 
-(* ---- Error definitions ---------------------------------------------------*)
-
-(* Auxiliary types for error documentation *)
-type namespace = Type_namespace | Constant_namespace | Instr_namespace | Keyword_namespace
-type kind = Int_kind | String_kind | Prim_kind | Seq_kind
-type type_map = (int * (Script.expr list * Script.expr list)) list
-
-(* Structure errors *)
-type error += Invalid_arity of Script.location * Script.prim * int * int
-type error += Invalid_namespace of Script.location * Script.prim * namespace * namespace
-type error += Invalid_primitive of Script.location * Script.prim list * Script.prim
-type error += Invalid_kind of Script.location * kind list * kind
-type error += Missing_field of Script.prim
-type error += Type_too_large : Script.location * int * int -> error
-type error += Duplicate_field of Script.location * Script.prim
-
-(* Instruction typing errors *)
-type error += Fail_not_in_tail_position of Script.location
-type error += Undefined_binop : Script.location * Script.prim * _ Script_typed_ir.ty * _ Script_typed_ir.ty -> error
-type error += Undefined_unop : Script.location * Script.prim * _ Script_typed_ir.ty -> error
-type error += Bad_return : Script.location * _ Script_typed_ir.stack_ty * _ Script_typed_ir.ty -> error
-type error += Bad_stack : Script.location * Script.prim * int * _ Script_typed_ir.stack_ty -> error
-type error += Unmatched_branches : Script.location * _ Script_typed_ir.stack_ty * _ Script_typed_ir.stack_ty -> error
-
-type error += Inconsistent_annotations of string * string
-type error += Inconsistent_type_annotations :
-                Script.location * _ Script_typed_ir.ty * _ Script_typed_ir.ty -> error
-type error += Unexpected_annotation of Script.location
-
-type error += Transfer_in_lambda of Script.location
-type error += Transfer_in_dip of Script.location
-type error += Self_in_lambda of Script.location
-type error += Bad_stack_length
-type error += Bad_stack_item of int
-type error += Invalid_map_body : Script.location * _ Script_typed_ir.stack_ty -> error
-type error += Invalid_map_block_fail of Script.location
-type error += Invalid_iter_body : Script.location * _ Script_typed_ir.stack_ty * _ Script_typed_ir.stack_ty -> error
-
-(* Value typing errors *)
-type error += Invalid_constant : Script.location * Script.expr * _ Script_typed_ir.ty -> error
-type error += Invalid_contract of Script.location * Contract.t
-type error += Comparable_type_expected : Script.location * _ Script_typed_ir.ty -> error
-type error += Inconsistent_types : _ Script_typed_ir.ty * _ Script_typed_ir.ty -> error
-type error += Unordered_map_keys of Script.location * Script.expr
-type error += Unordered_set_values of Script.location * Script.expr
-type error += Duplicate_map_keys of Script.location * Script.expr
-type error += Duplicate_set_values of Script.location * Script.expr
-
-(* Toplevel errors *)
-type error += Ill_typed_data : string option * Script.expr * _ Script_typed_ir.ty -> error
-type error += Ill_formed_type of string option * Script.expr * Script.location
-type error += Ill_typed_contract : Script.expr * type_map -> error
 
 (* ---- Sets and Maps -------------------------------------------------------*)
 

src/proto_alpha/lib_protocol/src/script_tc_errors.ml

@@ -0,0 +1,63 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Tezos_context
+open Script
+open Script_typed_ir
+
+
+(* ---- Error definitions ---------------------------------------------------*)
+
+(* Auxiliary types for error documentation *)
+type namespace = Type_namespace | Constant_namespace | Instr_namespace | Keyword_namespace
+type kind = Int_kind | String_kind | Prim_kind | Seq_kind
+type type_map = (int * (Script.expr list * Script.expr list)) list
+
+(* Structure errors *)
+type error += Invalid_arity of Script.location * prim * int * int
+type error += Invalid_namespace of Script.location * prim * namespace * namespace
+type error += Invalid_primitive of Script.location * prim list * prim
+type error += Invalid_kind of Script.location * kind list * kind
+type error += Missing_field of prim
+type error += Duplicate_field of Script.location * prim
+
+(* Instruction typing errors *)
+type error += Fail_not_in_tail_position of Script.location
+type error += Undefined_binop : Script.location * prim * _ ty * _ ty -> error
+type error += Undefined_unop : Script.location * prim * _ ty -> error
+type error += Bad_return : Script.location * _ stack_ty * _ ty -> error
+type error += Bad_stack : Script.location * prim * int * _ stack_ty -> error
+type error += Unmatched_branches : Script.location * _ stack_ty * _ stack_ty -> error
+type error += Transfer_in_lambda of Script.location
+type error += Transfer_in_dip of Script.location
+type error += Self_in_lambda of Script.location
+type error += Bad_stack_length
+type error += Bad_stack_item of int
+type error += Inconsistent_annotations of string * string
+type error += Inconsistent_type_annotations : Script.location * _ ty * _ ty -> error
+type error += Unexpected_annotation of Script.location
+type error += Invalid_map_body : Script.location * _ stack_ty -> error
+type error += Invalid_map_block_fail of Script.location
+type error += Invalid_iter_body : Script.location * _ stack_ty * _ stack_ty -> error
+type error += Type_too_large : Script.location * int * int -> error
+
+(* Value typing errors *)
+type error += Invalid_constant : Script.location * Script.expr * _ ty -> error
+type error += Invalid_contract of Script.location * Contract.t
+type error += Comparable_type_expected : Script.location * _ ty -> error
+type error += Inconsistent_types : _ ty * _ ty -> error
+type error += Unordered_map_keys of Script.location * Script.expr
+type error += Unordered_set_values of Script.location * Script.expr
+type error += Duplicate_map_keys of Script.location * Script.expr
+type error += Duplicate_set_values of Script.location * Script.expr
+
+(* Toplevel errors *)
+type error += Ill_typed_data : string option * Script.expr * _ ty -> error
+type error += Ill_formed_type of string option * Script.expr * Script.location
+type error += Ill_typed_contract : Script.expr * type_map -> error

test/proto_alpha_isolate_helpers/helpers_assert.ml

@@ -121,13 +121,13 @@ let economic_error ~msg f =
 
 let ill_typed_data_error ~msg =
   let aux = function
-    | Proto_alpha.Script_ir_translator.Ill_typed_data _ -> true
+    | Proto_alpha.Script_tc_errors.Ill_typed_data _ -> true
     | _ -> false in
   economic_error ~msg aux
 
 let ill_typed_return_error ~msg =
   let aux = function
-    | Proto_alpha.Script_ir_translator.Bad_return _ -> true
+    | Proto_alpha.Script_tc_errors.Bad_return _ -> true
     | _ -> false in
   economic_error ~msg aux