diff --git a/src/main/clojure/clojure/tools/reader.clj b/src/main/clojure/clojure/tools/reader.clj index ca67f77..383a63f 100644 --- a/src/main/clojure/clojure/tools/reader.clj +++ b/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) diff --git a/src/main/clojure/clojure/tools/reader/reader_types.clj b/src/main/clojure/clojure/tools/reader/reader_types.clj index 5883c7e..92a0a40 100644 --- a/src/main/clojure/clojure/tools/reader/reader_types.clj +++ b/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] @@ -164,6 +164,84 @@ (fn [rdr] 0)) :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))) diff --git a/src/test/clojure/clojure/tools/metadata_test.clj b/src/test/clojure/clojure/tools/metadata_test.clj index 97ffb91..6423a53 100644 --- a/src/test/clojure/clojure/tools/metadata_test.clj +++ b/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)]))))))