diff --git a/src/riddley/Riddley.cs b/src/riddley/Riddley.cs new file mode 100644 index 0000000..c3bd245 --- /dev/null +++ b/src/riddley/Riddley.cs @@ -0,0 +1,57 @@ +using System; +using clojure.lang; +using clojure.lang.CljCompiler.Ast; + +namespace Riddley +{ + public static class Util + { + public static LocalBinding LocalBinding(int num, Symbol sym, Symbol tag, object form) + { + return new LocalBinding(num, sym, tag, Compiler.Analyze(new ParserContext(RHC.Expression), form), typeof(object), false, false, false); + } + + public static LocalBinding LocalArgument(int num, Symbol sym, Symbol tag) + { + return new LocalBinding(num, sym, tag, null, typeof(object), false, true, false); + } + } + + public class ObjMethod : clojure.lang.CljCompiler.Ast.ObjMethod + { + public ObjMethod () : base(new ObjExpr(null), null) + { + + } + + public override bool IsVariadic + { + get { throw new NotImplementedException(); } + } + + public override int NumParams + { + get { throw new NotImplementedException(); } + } + + public override int RequiredArity + { + get { throw new NotImplementedException(); } + } + + public override string MethodName + { + get { throw new NotImplementedException(); } + } + + public override Type ReturnType + { + get { throw new NotImplementedException(); } + } + + public override Type[] ArgTypes + { + get { throw new NotImplementedException(); } + } + } +} \ No newline at end of file diff --git a/src/riddley/compiler.clj b/src/riddley/compiler.clj deleted file mode 100644 index 325e1a6..0000000 --- a/src/riddley/compiler.clj +++ /dev/null @@ -1,79 +0,0 @@ -(ns riddley.compiler - (:import - [clojure.lang - Var - Compiler - Compiler$ObjMethod - Compiler$ObjExpr] - [riddley - Util])) - -(defn- stub-method [] - (proxy [Compiler$ObjMethod] [(Compiler$ObjExpr. nil) nil])) - -(defn tag-of - "Returns a symbol representing the tagged class of the symbol, or `nil` if none exists." - [x] - (when-let [tag (-> x meta :tag)] - (let [sym (symbol - (if (instance? Class tag) - (.getName ^Class tag) - (name tag)))] - (when-not (= 'java.lang.Object sym) - sym)))) - -(let [n (atom 0)] - (defn- local-id [] - (swap! n inc))) - -(defn locals - "Returns the local binding map, equivalent to the value of `&env`." - [] - (when (.isBound Compiler/LOCAL_ENV) - @Compiler/LOCAL_ENV)) - -(defmacro with-base-env [& body] - `(binding [*warn-on-reflection* false] - (with-bindings (if (locals) - {} - {Compiler/LOCAL_ENV {}}) - ~@body))) - -(defmacro with-lexical-scoping - "Defines a lexical scope where new locals may be registered." - [& body] - `(with-bindings {Compiler/LOCAL_ENV (locals)} - ~@body)) - -(defmacro with-stub-vars [& body] - `(with-bindings {Compiler/CLEAR_SITES nil - Compiler/METHOD (stub-method)} - ~@body)) - -;; if we don't do this in Java, the checkcasts emitted by Clojure cause an -;; IllegalAccessError on Compiler$Expr. Whee. -(defn register-local - "Registers a locally bound variable `v`, which is being set to form `x`." - [v x] - (with-stub-vars - (.set ^Var Compiler/LOCAL_ENV - - ;; we want to allow metadata on the symbols to persist, so remove old symbols first - (-> (locals) - (dissoc v) - (assoc v (try - (Util/localBinding (local-id) v (tag-of v) x) - (catch Exception _ - ::analyze-failure))))))) - -(defn register-arg - "Registers a function argument `x`." - [x] - (with-stub-vars - (.set ^Var Compiler/LOCAL_ENV - (-> (locals) - (dissoc x) - (assoc x (Util/localArgument (local-id) x (tag-of x))))))) - - - diff --git a/src/riddley/compiler.cljc b/src/riddley/compiler.cljc new file mode 100644 index 0000000..eadab50 --- /dev/null +++ b/src/riddley/compiler.cljc @@ -0,0 +1,100 @@ +(ns riddley.compiler + (:import + [clojure.lang + Var + Compiler + #?@(:clj [Compiler$ObjMethod + Compiler$ObjExpr])] + #?(:clj [riddley Util] + :cljr [Riddley Util ObjMethod]))) + +(defn- stub-method [] + #?(:clj (proxy [Compiler$ObjMethod] [(Compiler$ObjExpr. nil) nil]) + :cljr (ObjMethod.))) + + +(defn tag-of + "Returns a symbol representing the tagged class of the symbol, or `nil` if none exists." + [x] + (when-let [tag (-> x meta :tag)] + (let [sym (symbol + #?(:clj (if (instance? Class tag) + (.getName ^Class tag) + (name tag)) + :cljr (if (instance? Type tag) + (.FullName ^Type tag) + (name tag)) + ))] + (when-not (= #?(:clj 'java.lang.Object + :cljr 'System.Object) + sym) + sym)))) + +(let [n (atom 0)] + (defn- local-id [] + (swap! n inc))) + +(defn locals + "Returns the local binding map, equivalent to the value of `&env`." + [] + #?(:clj (when (.isBound Compiler/LOCAL_ENV) + @Compiler/LOCAL_ENV) + :cljr (when (.isBound Compiler/LocalEnvVar) + @Compiler/LocalEnvVar))) + +(defmacro with-base-env [& body] + `(binding [*warn-on-reflection* false] + (with-bindings (if (locals) + {} + {#?(:clj Compiler/LOCAL_ENV + :cljr clojure.lang.Compiler/LocalEnvVar) {}}) + ~@body))) + +(defmacro with-lexical-scoping + "Defines a lexical scope where new locals may be registered." + [& body] + `(with-bindings {#?(:clj Compiler/LOCAL_ENV + :cljr clojure.lang.Compiler/LocalEnvVar) (locals)} + ~@body)) + +#?(:cljr (defn get-method-var [] + (let [field + (.GetField Compiler + "MethodVar" + (enum-or System.Reflection.BindingFlags/NonPublic + System.Reflection.BindingFlags/Static))] + (.GetValue field Compiler)))) + +(defmacro with-stub-vars [& body] + `(with-bindings #?(:clj {Compiler/CLEAR_SITES nil + Compiler/METHOD (stub-method)} + :cljr {(get-method-var) (stub-method)}) + ~@body)) + +;; if we don't do this in Java, the checkcasts emitted by Clojure cause an +;; IllegalAccessError on Compiler$Expr. Whee. +(defn register-local + "Registers a locally bound variable `v`, which is being set to form `x`." + [v x] + (with-stub-vars + (.set ^Var #?(:clj Compiler/LOCAL_ENV :cljr Compiler/LocalEnvVar) + + ;; we want to allow metadata on the symbols to persist, so remove old symbols first + (-> (locals) + (dissoc v) + (assoc v (try + (Util/LocalBinding (local-id) v (tag-of v) x) + (catch Exception _ + ::analyze-failure))))))) + +(defn register-arg + "Registers a function argument `x`." + [x] + (with-stub-vars + (.set ^Var #?(:clj Compiler/LOCAL_ENV :cljr Compiler/LocalEnvVar) + (-> (locals) + (dissoc x) + (assoc x (Util/LocalArgument (local-id) x (tag-of x))))))) + + + diff --git a/src/riddley/walk.clj b/src/riddley/walk.cljc similarity index 96% rename from src/riddley/walk.clj rename to src/riddley/walk.cljc index c93f437..76a3024 100644 --- a/src/riddley/walk.clj +++ b/src/riddley/walk.cljc @@ -190,7 +190,7 @@ (cmp/with-base-env (let [x (try (macroexpand x special-form?) - (catch ClassNotFoundException _ + (catch #?(:clj ClassNotFoundException :cljr TypeLoadException) _ x)) walk-exprs' (partial walk-exprs predicate handler special-form?) x' (cond @@ -222,10 +222,10 @@ #(doall (map %1 %2))) walk-exprs' x)) - (instance? java.util.Map$Entry x) - (clojure.lang.MapEntry. - (walk-exprs' (key x)) - (walk-exprs' (val x))) + #?@(:clj [(instance? java.util.Map$Entry x) + (clojure.lang.MapEntry. + (walk-exprs' (key x)) + (walk-exprs' (val x)))]) (or (set? x)