Skip to content

Commit

Permalink
protocols gen interface of same name, e.g. my.ns/Protocol gens my.ns.…
Browse files Browse the repository at this point in the history
…Protocol interface

names get munged
reify, deftype, protocol callsites and . calling munge
gen-interface is dynamic (undocumented as yet, interface TBD)
  • Loading branch information
richhickey committed Nov 30, 2009
1 parent 9fc3598 commit 77173bb
Show file tree
Hide file tree
Showing 4 changed files with 35 additions and 15 deletions.
2 changes: 1 addition & 1 deletion src/clj/clojure/core.clj
Expand Up @@ -4552,8 +4552,8 @@
(alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language")
(load "core_proxy")
(load "core_print")
(load "core_deftype")
(load "genclass")
(load "core_deftype")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;;
(defn future-call
Expand Down
26 changes: 22 additions & 4 deletions src/clj/clojure/core_deftype.clj
Expand Up @@ -13,6 +13,9 @@
(defn hash-combine [x y]
(clojure.lang.Util/hashCombine x (clojure.lang.Util/hash y)))

(defn munge [s]
((if (symbol? s) symbol str) (clojure.lang.Compiler/munge (str s))))

(defn- emit-deftype*
"Do not use this directly - use deftype"
[tagname name fields interfaces methods]
Expand Down Expand Up @@ -185,6 +188,14 @@

;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;;

(defn dtype
"Returns the dynamic type of x, or its Class if none"
[x]
(if (instance? clojure.lang.IDynamicType x)
(let [x #^ clojure.lang.IDynamicType x]
(.getDynamicType x))
(class x)))

(defn- expand-method-impl-cache [#^clojure.lang.MethodImplCache cache c f]
(let [cs (into {} (remove (fn [[c f]] (nil? f)) (map vec (partition 2 (.table cache)))))
cs (assoc cs c f)
Expand All @@ -205,7 +216,7 @@
(defn find-protocol-impl [protocol x]
(if (and (:on protocol) (instance? (:on protocol) x))
x
(let [t (type x)
(let [t (dtype x)
c (class x)
impl #(get (:impls protocol) %)]
(or (impl t)
Expand Down Expand Up @@ -288,8 +299,9 @@
(str "function " (.sym v)))))))))

(defn- emit-protocol [name opts+sigs]
(let [[opts sigs]
(loop [opts {:on nil} sigs opts+sigs]
(let [iname (symbol (str (munge *ns*) "." (munge name)))
[opts sigs]
(loop [opts {:on iname} sigs opts+sigs]
(condp #(%1 %2) (first sigs)
string? (recur (assoc opts :doc (first sigs)) (next sigs))
keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs))
Expand All @@ -307,9 +319,15 @@
{:name (vary-meta mname assoc :doc doc :arglists arglists)
:arglists arglists
:doc doc}))))
{} sigs)]
{} sigs)
meths (mapcat (fn [sig]
(let [m (munge (:name sig))]
(map #(vector m (vec (repeat (dec (count %))'Object)) 'Object)
(:arglists sig))))
(vals sigs))]
`(do
(defonce ~name {})
(gen-interface :name ~iname :methods ~meths)
(alter-meta! (var ~name) assoc :doc ~(:doc opts))
(#'assert-same-protocol (var ~name) '~(map :name (vals sigs)))
(alter-var-root (var ~name) merge
Expand Down
6 changes: 4 additions & 2 deletions src/clj/clojure/genclass.clj
Expand Up @@ -660,10 +660,12 @@
here."

[& options]
(when *compile-files*
(let [options-map (apply hash-map options)
[cname bytecode] (generate-interface options-map)]
(clojure.lang.Compiler/writeClassFile cname bytecode))))
(if *compile-files*
(clojure.lang.Compiler/writeClassFile cname bytecode)
(.defineClass #^DynamicClassLoader (deref clojure.lang.Compiler/LOADER)
(str (:name options-map)) bytecode))))

(comment

Expand Down
16 changes: 8 additions & 8 deletions src/jvm/clojure/lang/Compiler.java
Expand Up @@ -768,18 +768,18 @@ public Expr parse(C context, Object frm) throws Exception{
{
Symbol sym = (Symbol) RT.third(form);
if(c != null)
maybeField = Reflector.getMethods(c, 0, sym.name, true).size() == 0;
maybeField = Reflector.getMethods(c, 0, munge(sym.name), true).size() == 0;
else if(instance != null && instance.hasJavaClass() && instance.getJavaClass() != null)
maybeField = Reflector.getMethods(instance.getJavaClass(), 0, sym.name, false).size() == 0;
maybeField = Reflector.getMethods(instance.getJavaClass(), 0, munge(sym.name), false).size() == 0;
}
if(maybeField) //field
{
Symbol sym = (Symbol) RT.third(form);
Symbol tag = tagOf(form);
if(c != null) {
return new StaticFieldExpr(line, c, sym.name, tag);
return new StaticFieldExpr(line, c, munge(sym.name), tag);
} else
return new InstanceFieldExpr(line, instance, sym.name, tag);
return new InstanceFieldExpr(line, instance, munge(sym.name), tag);
}
else
{
Expand All @@ -792,9 +792,9 @@ else if(instance != null && instance.hasJavaClass() && instance.getJavaClass() !
for(ISeq s = RT.next(call); s != null; s = s.next())
args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first()));
if(c != null)
return new StaticMethodExpr(source, line, tag, c, sym.name, args);
return new StaticMethodExpr(source, line, tag, c, munge(sym.name), args);
else
return new InstanceMethodExpr(source, line, tag, instance, sym.name, args);
return new InstanceMethodExpr(source, line, tag, instance, munge(sym.name), args);
}
}
}
Expand Down Expand Up @@ -2773,7 +2773,7 @@ public InvokeExpr(String source, int line, Symbol tag, Expr fexpr, IPersistentVe
if(this.protocolOn != null)
{
IPersistentMap mmap = (IPersistentMap) RT.get(pvar.get(), methodMapKey);
String mname = ((Keyword) mmap.valAt(Keyword.intern(fvar.sym))).sym.toString();
String mname = munge(((Keyword) mmap.valAt(Keyword.intern(fvar.sym))).sym.toString());
List methods = Reflector.getMethods(protocolOn, args.count() - 1, mname, false);
if(methods.size() != 1)
throw new IllegalArgumentException(
Expand Down Expand Up @@ -6157,7 +6157,7 @@ static NewInstanceMethod parse(ObjExpr objx, ISeq form, Symbol thistag,
Symbol dotname = (Symbol)RT.first(form);
if(!dotname.name.startsWith("."))
throw new IllegalArgumentException("Method names must begin with '.': " + dotname);
Symbol name = (Symbol) Symbol.intern(null,dotname.name.substring(1)).withMeta(RT.meta(dotname));
Symbol name = (Symbol) Symbol.intern(null,munge(dotname.name.substring(1))).withMeta(RT.meta(dotname));
IPersistentVector parms = (IPersistentVector) RT.second(form);
ISeq body = RT.next(RT.next(form));
try
Expand Down

0 comments on commit 77173bb

Please sign in to comment.