Skip to content

Commit

Permalink
defn: fully support primitive hints
Browse files Browse the repository at this point in the history 
Fixes #35
  • Loading branch information
@vemv
vemv committed May 14, 2019
1 parent 733b67e commit 0142226
Show file tree
Hide file tree
Showing 4 changed files with 248 additions and 48 deletions.
10 changes: 7 additions & 3 deletions src/nedap/utils/spec/impl/defn.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
:cljs [cljs.core.specs.alpha :as specs])
[nedap.utils.spec.api #?(:clj :refer :cljs :refer-macros) [check!]]
[nedap.utils.spec.impl.parsing :refer [extract-specs-from-metadata fntails]]
[nedap.utils.spec.impl.type-hinting :refer [type-hint type-hint? strip-extraneous-type-hints]]))
[nedap.utils.spec.impl.type-hinting :refer [type-hint type-hint? strip-extraneous-type-hints primitive?]]))

(defn add-prepost [tails ret-spec clj?]
(->> tails
Expand Down Expand Up @@ -35,7 +35,9 @@
args-check-form (->> args-sigs
(filter :spec)
(map (fn [{:keys [spec arg]}]
[spec arg]))
[spec
;; Avoid "Can't type hint a primitive local" error:
(vary-meta arg dissoc :tag)]))
(apply concat)
(apply list `check!))
prepost (cond-> (when has-prepost?
Expand Down Expand Up @@ -150,7 +152,9 @@
tails (maybe-tag-tails name-ann tails)
_ (assert (consistent-tagging? name-ann tails clj?)
"Type hints/specs must have the same type across arities, and between arities and the defn's name metadata.")
name (if (type-hint? name-ann clj?)
name (if (and (type-hint? name-ann clj?)
;; 'int would become #'int after compilation, that's how the compiler works. Avoid that:
(not (primitive? name-ann clj?)))
(vary-meta name assoc :tag name-ann)
(vary-meta name dissoc :tag))]
(apply list `clojure.core/defn (cons name (concat docstring-and-meta tails)))))
92 changes: 61 additions & 31 deletions src/nedap/utils/spec/impl/parsing.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
(:require
#?(:clj [clojure.spec.alpha :as spec] :cljs [cljs.spec.alpha :as spec])
[nedap.utils.spec.impl.check #?(:clj :refer :cljs :refer-macros) [check!]]
[nedap.utils.spec.impl.type-hinting :refer [type-hint?]]
[nedap.utils.spec.impl.type-hinting :refer [type-hint? primitives primitive?]]
[nedap.utils.spec.specs :as specs]))

(defn proper-spec-metadata? [metadata-map extracted-specs]
Expand All @@ -18,19 +18,22 @@
(def spec-directive? (comp spec-directives first))

(defn and-spec [clj? & xs]
(apply list
(if clj?
'clojure.spec.alpha/and
'cljs.spec.alpha/and)
xs))
(let [specs (->> xs distinct (remove nil?))
pred (if clj?
'clojure.spec.alpha/and
'cljs.spec.alpha/and)]
(if (#{1} (count specs))
(first specs)
(apply list pred specs))))

(defn instance-spec [clj? class]
(list 'fn ['x]
(list (if clj?
'clojure.core/instance?
'cljs.core/instance?)
class
'x)))
(when-not (primitive? class clj?)
(list 'fn ['x]
(list (if clj?
'clojure.core/instance?
'cljs.core/instance?)
class
'x))))

(def clj-class-mapping
(->> {`boolean? `Boolean
Expand All @@ -54,26 +57,53 @@
[[k v]
[(-> k name symbol) v]]))
(apply concat)
(into {})))
(into {})
(merge (primitives true))))

(def cljs-class-mapping
{'string 'js/String
'string? 'js/String
'cljs.core.string? 'js/String

'boolean 'js/Boolean
'boolean? 'js/Boolean
'cljs.core/boolean? 'js/Boolean

'number 'js/Number
'number? 'js/Number
'cljs.core/number? 'js/Number})

(defn class-mapping [clj?]
(if clj?
clj-class-mapping
{'string 'js/String
'string? 'js/String
'cljs.core.string? 'js/String
cljs-class-mapping))

'boolean 'js/Boolean
'boolean? 'js/Boolean
'cljs.core/boolean? 'js/Boolean
(defn fail [& _]
(assert false))

'number 'js/Number
'number? 'js/Number
'cljs.core/number? 'js/Number}))
(defn array-class-expr [class]
{:pre [(symbol? class)
(#?(:clj resolve :cljs fail) class)]}
`(class (make-array ~class 0)))

(defn spec-mapping [clj?]
(if clj?
{}
{'int (instance-spec clj? `Integer)
'ints (instance-spec clj? (array-class-expr `Integer))
'long (instance-spec clj? `Long)
'longs (instance-spec clj? (array-class-expr `Long))
'float (instance-spec clj? `Float)
'floats (instance-spec clj? (array-class-expr `Float))
'double (instance-spec clj? `Double)
'doubles (instance-spec clj? (array-class-expr `Double))
'short (instance-spec clj? `Short)
'shorts (instance-spec clj? (array-class-expr `Short))
'boolean (instance-spec clj? `Boolean)
'booleans (instance-spec clj? (array-class-expr `Boolean))
'byte (instance-spec clj? `Byte)
'bytes (instance-spec clj? (array-class-expr `Byte))
'char (instance-spec clj? `Character)
'chars (instance-spec clj? (array-class-expr `Character))}
{'string 'cljs.core/string?
'string? 'cljs.core/string?
'cljs.core/string? 'cljs.core/string?
Expand All @@ -86,11 +116,9 @@
'number? 'cljs.core/number?
'cljs.core/number? 'cljs.core/number?}))

(defn fail [& _]
(assert false))

(defn infer-spec-from-symbol [clj? s]
(defn infer-spec-from-symbol
"For a few selected cases, one can derive a type hint out of symbol metatata."
[clj? s]
(let [class-mapping (class-mapping clj?)
spec-mapping (spec-mapping clj?)
spec (get spec-mapping
Expand All @@ -105,9 +133,10 @@
(and-spec clj?
spec
(instance-spec clj? inferred-class)))
:type-annotation (cond-> inferred-class
clj? #?(:clj resolve
:cljs fail))})))
:type-annotation (cond
(primitive? inferred-class clj?) inferred-class
clj? (#?(:clj resolve :cljs fail) inferred-class)
true inferred-class)})))

(defn extract-specs-from-metadata [metadata-map clj?]
{:post [(check! #{0 1} (->> metadata-map
Expand All @@ -119,7 +148,8 @@
(remove spec-directive?)
(map (fn [[k v]]
(let [symbol-inferred-type (and (#{:tag} k)
(not (type-hint? v))
(or (not (type-hint? v))
(primitive? v clj?))
(infer-spec-from-symbol clj? v))]
(cond
symbol-inferred-type
Expand Down
39 changes: 37 additions & 2 deletions src/nedap/utils/spec/impl/type_hinting.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,11 +4,46 @@

(def this-ns *ns*)

(def clj-primitives-map
{'int 'int
'ints 'ints
'long 'long
'longs 'longs
'float 'float
'floats 'floats
'double 'double
'doubles 'doubles
'short 'short
'shorts 'shorts
'boolean 'boolean
'booleans 'booleans
'byte 'byte
'bytes 'bytes
'char 'char
'chars 'chars})

(def cljs-primitives-map
{'string 'string
'boolean 'boolean
'number 'number})

(defn primitives [clj?]
(if clj?
clj-primitives-map
cljs-primitives-map))

(defn primitive? [s clj?]
(-> (primitives clj?)
(keys)
(set)
(contains? s)))

(defn clj-type-hint? [x]
(or (class? x)
(and (symbol? x)
(class? #?(:clj (resolve x)
:cljs (assert false))))))
(or (class? #?(:clj (resolve x)
:cljs (assert false)))
(primitive? x true)))))

(defn cljs-type-hint? [x]
(or (and (symbol? x)
Expand Down
Loading

0 comments on commit 0142226

Please sign in to comment.