/
impl.clj
67 lines (59 loc) · 2.2 KB
/
impl.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
; Copyright (c) Shantanu Kumar. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file LICENSE at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.
(ns bract.core.impl
(:require
[clojure.main :refer [demunge]]
[keypin.util :as kputil]
[bract.core.echo :as echo]
[bract.core.type :as type]
[bract.core.util :as util])
(:import
[java.util List Map]
[clojure.lang Fn Symbol Keyword Var]))
(def ^:dynamic *lookup-key* "no-key")
(defmacro with-lookup-key
[lookup-key & body]
`(binding [*lookup-key* ~lookup-key]
(echo/echo "Looking up inducer-list at key" ~lookup-key)
~@body))
(extend-protocol type/IFunction
Fn
(ifunc [this] this)
(iname [this] (let [fname (str this)]
(if-some [tokens (re-matches #"([A-Za-z\.\_]+\$[A-Za-z\.\_]+)@[0-9a-f]+" fname)]
(demunge (last tokens))
fname)))
(iargs [this] [])
String
(ifunc [this] (do
(echo/echo (format "Looking up inducer `%s`" this))
(kputil/str->var->deref *lookup-key* this)))
(iname [this] this)
(iargs [this] [])
Symbol
(ifunc [this] (do
(echo/echo (format "Looking up inducer `%s`" this))
(kputil/str->var->deref *lookup-key* this)))
(iname [this] (name this))
(iargs [this] [] [])
List
(ifunc [this] (do
(util/expected seq "non-empty collection" this)
(type/ifunc (first this))))
(iname [this] (type/iname (first this)))
(iargs [this] (vec (rest this)))
Map
(ifunc [this] (do
(util/expected #(contains? % :inducer) "map with :inducer key" this)
(type/ifunc (get this :inducer))))
(iname [this] (or (:name this) (type/iname (get this :inducer))))
(iargs [this] (vec (get this :args)))
Var
(ifunc [this] this)
(iname [this] (str (.-ns ^Var this) \/ (.-sym ^Var this)))
(iargs [this] []))