WIP

Author: hhugo

compiler/lib/primitive.ml

@@ -99,7 +99,7 @@ let register p k kargs arity =
   | k' when kind_equal k k' -> ()
   | k' ->
       Warning.warn
-        `Other
+        `Overriding_primitives_purity
         "overriding the purity of the primitive %s: %s -> %s@."
         p
         (string_of_kind k')

compiler/lib/warning.ml

@@ -14,6 +14,7 @@ type t =
   | `Missing_deps
   | `Deprecated_joo_global_object
   | `Overriding_primitives
+  | `Overriding_primitives_purity
   | `Deprecated_primitives
   | `Unused_js_variable
   | `Free_variables_in_primitives
@@ -46,7 +47,8 @@ let default = function
   | `Missing_primitives | `Missing_defined | `Missing_deps | `Free_variables_in_primitives
     -> true
   | `Deprecated_joo_global_object -> true
-  | `Overriding_primitives | `Deprecated_primitives -> true
+  | `Overriding_primitives | `Overriding_primitives_purity -> true
+  | `Deprecated_primitives -> true
   | `Unused_js_variable -> false
 
 let all =
@@ -63,6 +65,7 @@ let all =
   ; `Missing_deps
   ; `Deprecated_joo_global_object
   ; `Overriding_primitives
+  ; `Overriding_primitives_purity
   ; `Deprecated_primitives
   ; `Unused_js_variable
   ; `Free_variables_in_primitives
@@ -84,6 +87,7 @@ let name = function
   | `Free_variables_in_primitives -> "free-variables"
   | `Deprecated_joo_global_object -> "deprecated-joo-global-object"
   | `Overriding_primitives -> "overriding-primitive"
+  | `Overriding_primitives_purity -> "overriding-primitive-purity"
   | `Deprecated_primitives -> "deprecated-primitive"
   | `Unused_js_variable -> "unused-js-vars"
 
@@ -107,22 +111,13 @@ let werror = ref false
 
 let warnings = ref 0
 
-let warn (t : [ t | `Other ]) fmt =
+let warn (t : t) fmt =
   Format.kasprintf
     (fun s ->
-      if
-        (match t with
-        | `Other -> true
-        | #t as t -> enabled t)
-        && not !quiet
+      if enabled t && not !quiet
       then (
         incr warnings;
-        Format.eprintf
-          "Warning%s: %s%!"
-          (match t with
-          | `Other -> ""
-          | #t as t -> Printf.sprintf " [%s]" (name t))
-          s))
+        Format.eprintf "Warning%s: %s%!" (Printf.sprintf " [%s]" (name t)) s))
     fmt
 
 let process_warnings () =

compiler/lib/warning.mli

@@ -13,6 +13,7 @@ type t =
   | `Free_variables_in_primitives
   | `Deprecated_joo_global_object
   | `Overriding_primitives
+  | `Overriding_primitives_purity
   | `Deprecated_primitives
   | `Unused_js_variable
   ]
@@ -31,6 +32,6 @@ val quiet : bool ref
 
 val werror : bool ref
 
-val warn : [ t | `Other ] -> ('a, Format.formatter, unit, unit) format4 -> 'a
+val warn : t -> ('a, Format.formatter, unit, unit) format4 -> 'a
 
 val process_warnings : unit -> unit