See this message from Aaron Cohen:
One thing I’d really want before I even considered using this would be some way of restricting the scope of a reader macro to the current file. As is, they just have way too much room to interfere with your whole world. I’m not sure if that’s possible without modifying clojure.core though.
(let-macro-characters [\" (fn (reader char)
(reverse (macro-read-string reader quote)))]
;; => sorcam redaer ,olleh
(println "hello, reader macros"))
;; => hello, reader macros
(println "hello, reader macros")As opposed to, say:
(with-macro-characters
{\" (fn (reader char)
(reverse (macro-read-string reader quote)))}
(λ []
;; => sorcam redaer ,olleh
(println "hello, reader macros")))
;; => hello, reader macros
(println "hello, reader macros")see the which.
See, also, this from 2008.
Example from Brian Carper
(use 'add-classpath.core)
(add-classpath "lib/*")
(add-classpath "lib/dev/*")
(use 'debug.core)
(use 'clojure.test)
(defn dispatch-reader-macro [ch fun]
(let [dm (.get (doto (.getDeclaredField clojure.lang.LispReader "dispatchMacros")
(.setAccessible true))
nil)]
(aset dm (int ch) fun)))
(defn reader-macro [ch fun]
(let [dm (.get (doto (.getDeclaredField clojure.lang.LispReader "macros")
(.setAccessible true))
nil)]
(aset dm (int ch) fun)))
(defn uppercase-string [rdr letter-u]
(let [c (.read rdr)]
(if (= c (int \"))
(.toUpperCase (.invoke
(clojure.lang.LispReader$StringReader.)
rdr
c))
(throw (Exception. (str "Reader barfed on " (char c)))))))
(dispatch-reader-macro \U uppercase-string)
(reader-macro \U uppercase-string)
(is (= #U"Foo bar BAZ" "FOO BAR BAZ")
(= U"Foo bar BAZ" "FOO BAR BAZ")) set-macro-character,
set-dispatch-macro-character, etc.:
- (set-macro-character char new-function)
- (get-macro-character char)
- (set-dispatch-macro-character disp-char sub-char new-function)
- (get-dispatch-macro-character char)
- (make-dispatch-macro-character char)
- (read-delimited-list char &optional input-stream recursive-p)
where new-function has the signatures (lambda (stream char)
. . .) and (lambda (stream disp-char sub-char)),
respectively. (So, roughly on analogy with Clojure’s read-table.)
set-macro-character also has a notion of non-terminating?;
read-delimited-list help find the end of a list with funny
characters.
(Hey, what do you know? Hickey implemented readDelimitedList; it
requires a java.io.PushbackReader, though.)
Like this, maybe make-dispatch-macro-character has the effect:
macros['#'] = new DispatchReader();Do we want to allow an optional read-table? Hmm; what’s the point?
It’s static in LispReader.
E.g. StringReader has the signature:
public static class StringReader extends AFn{
public Object invoke(Object reader, Object doublequote) {
StringBuilder sb = new StringBuilder();
Reader r = (Reader) reader;
// . . .
return stringBuilder.toString();
}
};;; This doesn't work (we need an instance to get the method).
(def string-reader LispReader$StringReader/invoke)
;;; This does, but it's ugly; and it's difficult to invoke.
(get (:declaredMethods (bean LispReader$StringReader)) 0)
;;; Maybe this?
(let [string-reader (new LispReader$StringReader)]
(defn (read-string reader char)
(.invoke string-reader reader char)))
(use 'add-classpath.core)
(add-classpath "lib/*" "lib/dev/*")
(use 'cadr.core)
(use 'debug.core)
(use 'clojure.test)
(use 'lambda.core)
(use 'clojure.string)
(use 'clojure.test)
(import '(clojure.lang LispReader
LispReader$WrappingReader))
(let [macros (.getDeclaredField LispReader "macros")]
(.setAccessible macros true)
(let [macros (.get macros nil)]
(def set-macro-character
(λ [character read]
(aset macros (int character) read)))
(def get-macro-character
(λ [character]
(aget macros (int character))))))
(let [dispatch-macros (.getDeclaredField LispReader "dispatchMacros")]
(.setAccessible dispatch-macros true)
(let [dispatch-macros (.get dispatch-macros nil)]
(def set-dispatch-macro-character
(λ [character read]
(aset dispatch-macros (int character) read)))
(def get-dispatch-macro-character
(λ [character]
(aget dispatch-macros (int character))))))
(def read-delimited-list
(λ [delimiter reader recursive?]
(LispReader/readDelimitedList delimiter reader recursive?)))
(def class->predicates
(λ [class]
(map lower-case (drop-last (re-seq #"[A-Z][a-z]+" class)))))
(def class->read-class
(λ [class]
(symbol (format "macro-read-%s" (join "-" (class->predicates class))))))
(def nullary-constructor
(λ [class]
(loop [constructors (into '() (:declaredConstructors (bean class)))]
(if (empty? constructors)
false
(let [constructor (car constructors)]
(if (zero? (count (:parameterTypes (bean constructor))))
constructor
(recur (cdr constructors))))))))
(def nullary-constructor?
#(and (nullary-constructor %) true))
(def nullary-readers
(map (λ [class]
{:class (symbol (.getName class))
:constructor (nullary-constructor class)
:read-class (class->read-class (.getSimpleName class))})
(filter (λ [class]
(and (re-find #"Reader$" (.getSimpleName class))
(nullary-constructor? class)))
(into '() (:declaredClasses (bean LispReader))))))
;;; Gather a list of these somehow for a dynamic API, or can we do
;;; some namespace-tricks?
(defmacro def-read-macros []
`(do ~@(map (λ [{class :class
constructor :constructor
read-class :read-class}]
`(let [constructor# (nullary-constructor ~class)]
(.setAccessible constructor# true)
(let [class-reader# (.newInstance constructor# nil)]
(def ~read-class
(λ [reader# character#]
(.invoke class-reader# reader# character#))))))
nullary-readers)))
(def-read-macros)
;;; Couple of unary exceptions
(let [macro-deref-reader (LispReader$WrappingReader. 'deref)]
(def macro-read-deref
(λ [reader character]
(.invoke macro-deref-reader reader character))))
(let [macro-quote-reader (LispReader$WrappingReader. 'quote)]
(def macro-read-quote
(λ [reader character]
(.invoke macro-quote-reader reader character))))
(letfn [(rotate [character]
(char (+ (mod (+ (- (int character) 97) 13) 26) 97)))]
(def rot13
"Only works for lower case letters."
(λ [string] (apply str (map rotate string)))))
(defn macro-read-rot13 [reader character]
(let [string (macro-read-string reader character)]
(rot13 string)))
(defn macro-read-reverse-string [reader character]
(reverse (macro-read-string reader character)))
;; (set-macro-character \" macro-read-reverse-string)
(set-macro-character
\"
(fn [reader quote]
(reverse (macro-read-string reader quote))))
(println "hello, reader macros")
;; (is (= "uryyb" (apply str '(\h \e \l \l \o))))
- CLOSING NOTE [2011-12-21 Wed 08:56]
We did this for the niladic readers.
If we do this, funny enough, we don’t actually have a guaranteed API; that’s bad, isn’t it?
(use 'add-classpath.core)
(add-classpath "lib/*" "lib/dev/*")
(use 'debug.core)
(use 'lambda.core)
(use 'clojure.string)
(use 'useful.seq)
(use 'cadr.core)
(import 'clojure.lang.LispReader)
(import 'java.util.regex.Pattern)
;;; re-seq exists.
(def tokenize
(λ [string regex]
(let [matcher (re-matcher regex string)]
(loop [tokens '()]
(if (.find matcher)
(recur (cons (re-groups matcher) tokens))
tokens)))))
(def class->predicates
(λ [class]
(map lower-case (drop-last (re-seq #"[A-Z][a-z]+" class)))))
(def class->read-class
(λ [class]
(symbol (format "macro-read-%s" (join "-" (class->predicates class))))))
(def nullary-constructor
(λ [class]
(loop [constructors (into '() (:declaredConstructors (bean class)))]
(if (empty? constructors)
false
(let [constructor (car constructors)]
(if (zero? (count (:parameterTypes (bean constructor))))
constructor
(recur (cdr constructors))))))))
(def nullary-constructor?
#(and (nullary-constructor %) true))
(def nullary-readers
(map (λ [class]
{:class (symbol (.getName class))
:constructor (nullary-constructor? class)
:read-class (class->read-class (.getSimpleName class))})
(filter (λ [class]
(and (re-find #"Reader$" (.getSimpleName class))
(nullary-constructor class)))
(into '() (:declaredClasses (bean LispReader))))))
(defmacro def-read-macros []
`(do ~@(map (λ [{class :class
constructor :constructor
read-class :read-class}]
`(let [constructor# (nullary-constructor ~class)]
(.setAccessible constructor# true)
(let [class-reader# (.newInstance constructor# nil)]
(def ~read-class
(λ [character# reader#]
(debug (class class-reader#))
(.invoke class-reader# reader# character#))))))
nullary-readers)))
(def-read-macros)
(debug
#_(map class->reader
(filter #(re-find #"Reader$" %)
(map #(.getSimpleName %)
(into '()
(:declaredClasses (bean LispReader))))))
#_(map (λ [class]
(let [simple-name (.getSimpleName class)]
{:read-class (class->read-class simple-name)
:class-reader (class->class-reader simple-name)
:class (symbol (.getName class))}))
(into '()
(:declaredClasses (bean LispReader))))
#_(macroexpand '(def-read-macros))
#_(map #(map count (map :parameterTypes(map bean (into '() %))))
(map :declaredConstructors (map bean (:declaredClasses (bean LispReader)))))
#_(map #(map bean (into '() %)) (map :declaredConstructors (map bean (:declaredClasses (bean LispReader)))))
#_(map nullary-constructor (:declaredClasses (bean LispReader)))
#_readers
#_(macroexpand-1 '(def-read-macros))
;; macro-read-string
;; macro-read-var
;; (macro-read-regex "2" "3")
)
From here:
(defn partition
"Splits the string into a lazy sequence of substrings, alternating
between substrings that match the patthern and the substrings
between the matches. The sequence always starts with the substring
before the first match, or an empty string if the beginning of the
string matches.
For example: (partition \"abc123def\" #\"[a-z]+\")
returns: (\"\" \"abc\" \"123\" \"def\")"
[#^String s #^Pattern re]
(let [m (re-matcher re s)]
((fn step [prevend]
(lazy-seq
(if (.find m)
(cons (.subSequence s prevend (.start m))
(cons (re-groups m)
(step (+ (.start m) (count (.group m))))))
(when (< prevend (.length s))
(list (.subSequence s prevend (.length s)))))))
0)))- CLOSING NOTE [2011-12-21 Wed 08:56]
We had to do this for a couple dyadic special-cases.
We’ll do something clever later, if we need to; we have a guaranteed API this way.