From f057e3cdd7490faeba824920d8b48b80aac69a87 Mon Sep 17 00:00:00 2001
From: Mike Fikes <mike@fikesfarm.com>
Date: Sat, 20 Feb 2016 12:18:37 -0500
Subject: [PATCH] CLJS-1582: Type-hint extend-type first arg for primitives

If extending boolean or number to a protocol, propagate type hint to
first arg of fns.

This is done by walking the code in the impl-map, and associng the
passed type-sym as the :tag meta for the first argument of all fns.
---
 src/main/clojure/cljs/core.cljc | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

diff --git a/src/main/clojure/cljs/core.cljc b/src/main/clojure/cljs/core.cljc
index 7d40fe079e..494ee849fc 100644
--- a/src/main/clojure/cljs/core.cljc
+++ b/src/main/clojure/cljs/core.cljc
@@ -1470,6 +1470,34 @@
               (recur (conj seen fname) (next methods)))))
         (recur (conj protos proto) impls)))))
 
+(core/defn- type-hint-first-arg
+  [type-sym argv]
+  (assoc argv 0 (vary-meta (argv 0) assoc :tag type-sym)))
+
+(core/defn- type-hint-single-arity-sig
+  [type-sym sig]
+  (list* (first sig) (type-hint-first-arg type-sym (second sig)) (nnext sig)))
+
+(core/defn- type-hint-multi-arity-sig
+  [type-sym sig]
+  (list* (type-hint-first-arg type-sym (first sig)) (next sig)))
+
+(core/defn- type-hint-multi-arity-sigs
+  [type-sym sigs]
+  (list* (first sigs) (map (partial type-hint-multi-arity-sig type-sym) (rest sigs))))
+
+(core/defn- type-hint-sigs
+  [type-sym sig]
+  (if (vector? (second sig))
+    (type-hint-single-arity-sig type-sym sig)
+    (type-hint-multi-arity-sigs type-sym sig)))
+
+(core/defn- type-hint-impl-map
+  [type-sym impl-map]
+  (reduce-kv (core/fn [m proto sigs]
+               (assoc m proto (map (partial type-hint-sigs type-sym) sigs)))
+    {} impl-map))
+
 (core/defmacro extend-type
   "Extend a type to a series of protocols. Useful when you are
   supplying the definitions explicitly inline. Propagates the
@@ -1500,6 +1528,9 @@
              _ (validate-impls env impls)
              resolve (partial resolve-var env)
              impl-map (->impl-map impls)
+             impl-map (if ('#{boolean number} type-sym)
+                        (type-hint-impl-map type-sym impl-map)
+                        impl-map)
              [type assign-impls] (core/if-let [type (base-type type-sym)]
                                    [type base-assign-impls]
                                    [(resolve type-sym) proto-assign-impls])]