Skip to content

Instantly share code, notes, and snippets.

@oranenj
Created August 7, 2009 14:13
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save oranenj/163921 to your computer and use it in GitHub Desktop.
Save oranenj/163921 to your computer and use it in GitHub Desktop.
; 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 epl-v10.html 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.
(def *splice-allowed* false)
(def *sq-gensyms* nil)
(defn is-call? [operator form]
(and (seq? form) (= (first form) operator)))
(defn maybe-resolve [sym]
(let [dot-end (.endsWith (name sym) ".")
sym (if dot-end
(symbol (subs (name sym) 0 (dec (count (name sym)))))
sym)
res (resolve sym)]
(cond
(var? res) (symbol (str (.ns res)) (str (.sym res)))
(class? res) (symbol (str (.getName res) (when (.endsWith (str sym) ".") ".")))
(.startsWith (name sym) ".") sym
:else (symbol (str (ns-name *ns*)) (str (name sym))))))
(defn syntax-quote*
[form]
(letfn [(w
([form]
(list 'clojure.core/list form))
([quote? form]
(list 'clojure.core/list (list 'quote form))))
(process-seq
[form & splicable?]
(binding [*splice-allowed* splicable?]
(list* 'clojure.core/concat (map syntax-quote* form))))
(process-sym
[sym]
(if-not (.endsWith (name sym) "#")
(maybe-resolve sym)
(if-let [auto (*sq-gensyms* (name sym))]
auto
(let [new-sym
(gensym (apply str (concat (butlast (name sym)) "__auto__")))]
(alter-var-root #'*sq-gensyms* assoc (name sym) new-sym)
new-sym))))]
(cond
(is-call? 'clojure.core/unquote form)
, (w (second form))
(is-call? 'clojure.core/unquote-splicing form)
, (if *splice-allowed*
(list* 'do (rest form))
(throw (IllegalStateException. "Splice not in sequential collection")))
(is-call? 'syntax-quote form) (w :q form)
(symbol? form) (w :q (process-sym form))
(vector? form) (w (list 'clojure.core/vec (process-seq form :splicable)))
(map? form) (w (list 'clojure.core/apply 'clojure.core/hash-map
(process-seq (apply concat (seq form)))))
(set? form) (w (list 'clojure.core/set (process-seq form :splicable)))
(seq? form) (w (process-seq form :splicable))
:else (w (list 'quote form)))))
(defmacro syntax-quote [form]
(binding [*sq-gensyms* {}]
(list 'clojure.core/first (doall (syntax-quote* form)))))
;; example
(syntax-quote (fn [foo#] foo# ~x))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment