Skip to content
Browse files

Add source logging to read forms.

- Introduce new SourceLoggingPushbackReader type to reader types.
- All IMeta read by a SourceLoggingPushbackReader have a :source key in their metadata.
- The :source key is the character string which was read to produce the IMeta.
- Tests to verify the :source keys for various kinds of values, e.g. IMetas, nested IMetas, native Java types, IMetas with Meta present.

Also-by: Bronsa <brobronsa@gmail.com>

Signed-off-by: Bronsa <brobronsa@gmail.com>
  • Loading branch information...
1 parent 3ecd575 commit f9e55071d82a443db3fac1c2feda059d0215bb90 @aredington aredington committed with Bronsa
View
61 src/main/clojure/clojure/tools/reader.clj
@@ -154,7 +154,8 @@
(if (identical? delim (char ch))
(persistent! a)
(if-let [macrofn (macros ch)]
- (let [mret (macrofn rdr ch)]
+ (let [mret (log-source-unread rdr
+ (macrofn rdr ch))]
(recur (if-not (identical? mret rdr) (conj! a mret) a)))
(let [o (read (doto rdr (unread ch)) true nil recursive?)]
(recur (if-not (identical? o rdr) (conj! a o) a)))))
@@ -322,22 +323,23 @@
(defn- read-meta
[rdr _]
- (let [[line column] (when (indexing-reader? rdr)
- [(get-line-number rdr) (int (dec (get-column-number rdr)))])
- m (desugar-meta (read rdr true nil true))]
- (when-not (map? m)
- (reader-error rdr "Metadata must be Symbol, Keyword, String or Map"))
- (let [o (read rdr true nil true)]
- (if (instance? IMeta o)
- (let [m (if (and line
- (seq? o))
- (assoc m :line line
+ (log-source rdr
+ (let [[line column] (when (indexing-reader? rdr)
+ [(get-line-number rdr) (int (dec (get-column-number rdr)))])
+ m (desugar-meta (read rdr true nil true))]
+ (when-not (map? m)
+ (reader-error rdr "Metadata must be Symbol, Keyword, String or Map"))
+ (let [o (read rdr true nil true)]
+ (if (instance? IMeta o)
+ (let [m (if (and line
+ (seq? o))
+ (assoc m :line line
:column column)
- m)]
- (if (instance? IObj o)
- (with-meta o (merge (meta o) m))
- (reset-meta! o m)))
- (reader-error rdr "Metadata can only be applied to IMetas")))))
+ m)]
+ (if (instance? IObj o)
+ (with-meta o (merge (meta o) m))
+ (reset-meta! o m)))
+ (reader-error rdr "Metadata can only be applied to IMetas"))))))
(defn- read-set
[rdr _]
@@ -719,19 +721,20 @@
(when (= :unknown *read-eval*)
(reader-error "Reading disallowed - *read-eval* bound to :unknown"))
(try
- (let [ch (read-char reader)]
- (cond
- (whitespace? ch) (read reader eof-error? sentinel recursive?)
- (nil? ch) (if eof-error? (reader-error reader "EOF") sentinel)
- (number-literal? reader ch) (read-number reader ch)
- (comment-prefix? ch) (read (read-comment reader ch) eof-error? sentinel recursive?)
- :else (let [f (macros ch)]
- (if f
- (let [res (f reader ch)]
- (if (identical? res reader)
- (read reader eof-error? sentinel recursive?)
- res))
- (read-symbol reader ch)))))
+ (log-source reader
+ (let [ch (read-char reader)]
+ (cond
+ (whitespace? ch) (read reader eof-error? sentinel recursive?)
+ (nil? ch) (if eof-error? (reader-error reader "EOF") sentinel)
+ (number-literal? reader ch) (read-number reader ch)
+ (comment-prefix? ch) (read (read-comment reader ch) eof-error? sentinel recursive?)
+ :else (let [f (macros ch)]
+ (if f
+ (let [res (f reader ch)]
+ (if (identical? res reader)
+ (read reader eof-error? sentinel recursive?)
+ res))
+ (read-symbol reader ch))))))
(catch Exception e
(if (ex-info? e)
(throw e)
View
122 src/main/clojure/clojure/tools/reader/reader_types.clj
@@ -11,7 +11,7 @@
clojure.tools.reader.reader-types
(:refer-clojure :exclude [char read-line])
(:use clojure.tools.reader.impl.utils)
- (:import clojure.lang.LineNumberingPushbackReader
+ (:import (clojure.lang LineNumberingPushbackReader Var)
(java.io InputStream BufferedReader)))
(defmacro ^:private update! [what f]
@@ -165,6 +165,84 @@
:get-file-name (constantly nil)})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Source Logging support
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn merge-meta
+ "Returns an object of the same type and value as `obj`, with its
+metadata merged over `m`."
+ [obj m]
+ (let [orig-meta (meta obj)]
+ (with-meta obj (merge m (dissoc orig-meta :source)))))
+
+(defn- peek-source-log
+ "Returns a string containing the contents of the top most source
+logging frame."
+ [source-log-frames]
+ (let [current-frame @source-log-frames]
+ (.substring ^StringBuilder (:buffer current-frame) (:offset current-frame))))
+
+(defn- log-source-char
+ "Logs `char` to all currently active source logging frames."
+ [source-log-frames char]
+ (when-let [^StringBuilder buffer (:buffer @source-log-frames)]
+ (.append buffer char)))
+
+(defn- drop-last-logged-char
+ "Removes the last logged character from all currently active source
+logging frames. Called when pushing a character back."
+ [source-log-frames]
+ (when-let [^StringBuilder buffer (:buffer @source-log-frames)]
+ (.deleteCharAt buffer (dec (.length buffer)))))
+
+(deftype SourceLoggingPushbackReader
+ [rdr ^:unsynchronized-mutable line ^:unsynchronized-mutable column
+ ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev
+ ^:unsynchronized-mutable prev-column file-name source-log-frames]
+ Reader
+ (read-char [reader]
+ (when-let [ch (read-char rdr)]
+ (let [ch (normalize-newline rdr ch)]
+ (set! prev line-start?)
+ (set! line-start? (newline? ch))
+ (when line-start?
+ (set! prev-column column)
+ (set! column 0)
+ (update! line inc))
+ (update! column inc)
+ (log-source-char source-log-frames ch)
+ ch)))
+
+ (peek-char [reader]
+ (peek-char rdr))
+
+ IPushbackReader
+ (unread [reader ch]
+ (if line-start?
+ (do (update! line dec)
+ (set! column prev-column))
+ (update! column dec))
+ (set! line-start? prev)
+ (when ch
+ (drop-last-logged-char source-log-frames))
+ (unread rdr ch))
+
+ IndexingReader
+ (get-line-number [reader] (int (inc line)))
+ (get-column-number [reader] (int column))
+ (get-file-name [reader] file-name))
+
+(defn log-source*
+ [reader f unread?]
+ (let [frame (.source_log_frames ^SourceLoggingPushbackReader reader)
+ ^StringBuilder buffer (:buffer @frame)
+ new-frame (assoc-in @frame [:offset] (+ (.length buffer) (if unread? -1 0)))]
+ (with-bindings {frame new-frame}
+ (let [ret (f)]
+ (if (instance? clojure.lang.IMeta ret)
+ (merge-meta ret {:source (peek-source-log frame)})
+ ret)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -213,6 +291,26 @@
(IndexingPushbackReader.
(if (string? s-or-rdr) (string-push-back-reader s-or-rdr buf-len) s-or-rdr) 0 1 true nil 0 file-name)))
+(defn source-logging-push-back-reader
+ "Creates an IndexingPushbackReader from a given string or Reader"
+ ([s-or-rdr]
+ (source-logging-push-back-reader s-or-rdr 1))
+ ([s-or-rdr buf-len]
+ (source-logging-push-back-reader s-or-rdr buf-len nil))
+ ([s-or-rdr buf-len file-name]
+ (SourceLoggingPushbackReader.
+ (if (string? s-or-rdr) (string-push-back-reader s-or-rdr buf-len) s-or-rdr)
+ 0
+ 1
+ true
+ nil
+ 0
+ file-name
+ (.. Var
+ (create {:buffer (StringBuilder.)
+ :offset 0})
+ setDynamic))))
+
(defn read-line
"Reads a line from the reader or from *in* if no reader is specified"
([] (read-line *in*))
@@ -237,3 +335,25 @@
:column (get-column-number rdr)}
(when-let [file-name (get-file-name rdr)]
{:file file-name})))))))
+
+(defn source-logging-reader?
+ [rdr]
+ (instance? SourceLoggingPushbackReader rdr))
+
+(defmacro log-source
+ "If reader implements SourceLoggingReader, execute body in a source
+ logging context. Otherwise, execute body, returning the result."
+ [reader & body]
+ `(if (and (source-logging-reader? ~reader)
+ (not (whitespace? (peek-char ~reader))))
+ (log-source* ~reader (^{:once true} fn* [] ~@body) false)
+ (do ~@body)))
+
+(defmacro log-source-unread
+ "If reader implements SourceLoggingReader, execute body in a source
+ logging context. Otherwise, execute body, returning the result."
+ [reader & body]
+ `(if (and (source-logging-reader? ~reader)
+ (not (whitespace? (peek-char ~reader))))
+ (log-source* ~reader (^{:once true} fn* [] ~@body) true)
+ (do ~@body)))
View
51 src/test/clojure/clojure/tools/metadata_test.clj
@@ -64,3 +64,54 @@
(tree-seq coll? identity second-form))]
(doseq [[expected actual] comparisons]
(is (= [expected (meta expected)] [actual (meta actual)]))))))
+
+(def expected-haiku-ns-with-source
+ (with-meta '(^{:line 1 :column 2 :end-line 1 :end-column 4 :source "ns"} ns
+ ^{:line 1 :column 5 :end-line 1 :end-column 31 :source "clojure.tools.reader.haiku"} clojure.tools.reader.haiku)
+ {:line 1 :column 1 :end-line 1 :end-column 32 :source "(ns clojure.tools.reader.haiku)"}))
+
+(def expected-haiku-defn-with-source
+ (with-meta (list
+ '^{:line 3 :column 2 :end-line 3 :end-column 6 :source "defn"} defn
+ '^{:line 3 :column 7 :end-line 3 :end-column 12 :source "haiku"} haiku
+ "It will read the form\n but will the form metadata be\n or never become?"
+ (with-meta ['^{:line 7 :column 6 :end-line 7 :end-column 16 :source "first-five"} first-five
+ '^{:line 7 :column 17 :end-line 7 :end-column 29 :source "middle-seven"} middle-seven
+ '^{:line 7 :column 30 :end-line 7 :end-column 39 :source "last-five"} last-five]
+ {:line 7 :column 5 :end-line 7 :end-column 40 :source "[first-five middle-seven last-five]"})
+ (with-meta (list '^{:line 8 :column 6 :end-line 8, :end-column 7 :source "-"} -
+ (with-meta (list '^{:line 8 :column 9 :end-line 8 :end-column 14 :source "apply"} apply
+ '^{:line 8 :column 15 :end-line 8 :end-column 16 :source "+"} +
+ ^{:last 'last-five :line 9 :column 34 :end-line 9 :end-column 41 :source "^{:last last-five} [1 2 3]"}
+ [1 2 3])
+ {:line 8 :column 8 :end-line 9 :end-column 42 :source "(apply +
+ ^{:last last-five} [1 2 3])"})
+ '^{:line 10 :column 8 :end-line 10 :end-column 18 :source "first-five"} first-five
+ '^{:line 10 :column 19 :end-line 10 :end-column 31 :source "middle-seven"} middle-seven)
+ {:line 8 :column 5 :end-line 10 :end-column 32 :source "(- (apply +
+ ^{:last last-five} [1 2 3])
+ first-five middle-seven)"}))
+ {:line 3 :column 1 :end-line 10 :end-column 33 :source "(defn haiku
+ \"It will read the form
+ but will the form metadata be
+ or never become?\"
+ [first-five middle-seven last-five]
+ (- (apply +
+ ^{:last last-five} [1 2 3])
+ first-five middle-seven))"}))
+
+(deftest read-metadata-with-source
+ (let [reader (-> (test-reader)
+ (LineNumberingPushbackReader.)
+ (reader-types/source-logging-push-back-reader 1 "haiku.clj"))
+ first-form (read reader)
+ second-form (read reader)]
+ (is (= {:line 1 :column 1 :end-line 1 :end-column 32 :source "(ns clojure.tools.reader.haiku)"} (meta first-form)))
+ (let [comparisons (map vector (tree-seq coll? identity expected-haiku-ns-with-source)
+ (tree-seq coll? identity first-form))]
+ (doseq [[expected actual] comparisons]
+ (is (= [expected (meta expected)] [actual (meta actual)]))))
+ (let [comparisons (map vector (tree-seq coll? identity expected-haiku-defn-with-source)
+ (tree-seq coll? identity second-form))]
+ (doseq [[expected actual] comparisons]
+ (is (= [expected (meta expected)] [actual (meta actual)]))))))

0 comments on commit f9e5507

Please sign in to comment.
Something went wrong with that request. Please try again.