├── .gitignore ├── project.clj ├── README.md ├── src └── clojure_reader │ ├── numbers.clj │ ├── symbols.clj │ ├── util.clj │ └── core.clj └── test └── clojure_reader └── test ├── error.clj └── core.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /pom.xml 2 | *jar 3 | /lib 4 | /classes 5 | /native 6 | /.lein-failures 7 | /checkouts 8 | /.lein-deps-sum 9 | /nohup.out 10 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojure-reader "1.0.0-SNAPSHOT" 2 | :description "A Clojure reader implemented in Clojure" 3 | :dependencies [[org.clojure/clojure "1.4.0-alpha5"]]) 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # clojure-reader 2 | 3 | A re-implementation of the Clojure reader in Clojure. 4 | 5 | ## Features 6 | 7 | This implementation should support all of the forms supported by the Clojure reader, including: 8 | 9 | - character 10 | - strings 11 | - regex 12 | 13 | - comments 14 | - discard 15 | 16 | - metadata 17 | - symbols 18 | 19 | - lists 20 | - vectors 21 | - maps 22 | - sets 23 | 24 | - integers 25 | - floats 26 | - ratios 27 | 28 | - syntax quote 29 | - unquote 30 | 31 | - records 32 | - tagged literals 33 | 34 | - fn reader 35 | - arg reader 36 | 37 | - eval reader 38 | 39 | ## License 40 | 41 | Copyright (C) 2012 Cosmin Stejerean 42 | 43 | Distributed under the Eclipse Public License, the same as Clojure. 44 | -------------------------------------------------------------------------------- /src/clojure_reader/numbers.clj: -------------------------------------------------------------------------------- 1 | (ns clojure-reader.numbers 2 | (:use clojure-reader.util) 3 | (:import [java.io PushbackReader] 4 | [java.math BigDecimal BigInteger] 5 | [java.util.regex Pattern Matcher] 6 | [clojure.lang Numbers BigInt])) 7 | 8 | (defn- number-and-radix [^Matcher m] 9 | (cond-let [n] 10 | (.group m 3) [n 10] 11 | (.group m 4) [n 16] 12 | (.group m 5) [n 8] 13 | (.group m 7) [n (Integer/parseInt (.group m 6))])) 14 | 15 | (defn- read-big-integer [negate? n radix] 16 | (let [bn (BigInteger. n radix)] 17 | (if negate? 18 | (.negate bn) 19 | bn))) 20 | 21 | (def int-pattern (Pattern/compile "([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)(N)?")) 22 | (defn- parse-integer [s] 23 | (let [m (.matcher int-pattern s)] 24 | (if (.matches m) 25 | (if (not-nil? (.group m 2)) 26 | (if (not-nil? (.group m 8)) 27 | BigInt/ZERO 28 | (Numbers/num 0)) 29 | (let [negate? (= "-" (.group m 1)) 30 | [n radix] (number-and-radix m)] 31 | (if (not-nil? n) 32 | (let [bn (read-big-integer negate? n radix)] 33 | (if (not-nil? (.group m 8)) 34 | (BigInt/fromBigInteger bn) 35 | (if (< (.bitLength bn) 64) 36 | (Numbers/num (.longValue bn)) 37 | (BigInt/fromBigInteger bn)))))))))) 38 | 39 | (def ratio-pattern (Pattern/compile "([-+]?[0-9]+)/([0-9]+)")) 40 | (defn- parse-ratio [s] 41 | (let [m (.matcher ratio-pattern s) 42 | reduce-big-int (fn [x] (Numbers/reduceBigInt (BigInt/fromBigInteger (BigInteger. x))))] 43 | (if (.matches m) 44 | (Numbers/divide (reduce-big-int (.group m 1)) 45 | (reduce-big-int (.group m 2)))))) 46 | 47 | (def float-pattern (Pattern/compile "([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?")) 48 | (defn- parse-float [s] 49 | (let [m (.matcher float-pattern s)] 50 | (if (.matches m) 51 | (if (nil? (.group m 4)) 52 | (Double/parseDouble s) 53 | (BigDecimal. (.group m 1)))))) 54 | 55 | (defn match-number [s] 56 | (cond 57 | (.contains s "/") (parse-ratio s) 58 | (.contains s ".") (parse-float s) 59 | :else (parse-integer s))) 60 | -------------------------------------------------------------------------------- /test/clojure_reader/test/error.clj: -------------------------------------------------------------------------------- 1 | (ns clojure-reader.test.error 2 | (:require [clojure-reader.core :as cr]) 3 | (:use [clojure.test])) 4 | 5 | (deftest test-read-eof 6 | (is (thrown-with-msg? RuntimeException #"EOF while reading character" 7 | (cr/read-string "\\"))) 8 | (is (thrown-with-msg? RuntimeException #"EOF while reading character" 9 | (cr/read-string "~"))) 10 | (is (thrown-with-msg? RuntimeException #"EOF while reading character" 11 | (cr/read-string "#"))) 12 | (is (thrown-with-msg? RuntimeException #"EOF while reading string" 13 | (cr/read-string "\"abc"))) 14 | (is (thrown-with-msg? RuntimeException #"EOF while reading string" 15 | (cr/read-string "\"abc\\"))) 16 | (is (thrown-with-msg? RuntimeException #"EOF while reading regex" 17 | (cr/read-string "#\"abc"))) 18 | (is (thrown-with-msg? RuntimeException #"EOF while reading" 19 | (cr/read-string "(1 2 3"))) 20 | (is (thrown-with-msg? RuntimeException #"EOF while reading" 21 | (cr/read-string "@"))) 22 | (is (thrown-with-msg? RuntimeException #"EOF while reading" 23 | (cr/read-string "[1 2 3"))) 24 | (is (thrown-with-msg? RuntimeException #"EOF while reading" 25 | (cr/read-string "{1 2 3"))) 26 | (is (thrown-with-msg? RuntimeException #"EOF while reading" 27 | (cr/read-string "#{1 2 3")))) 28 | 29 | (deftest test-read-record-errors 30 | ;; in this particular case Clojure reports a different error because it doesn't catch EOF 31 | (is (thrown-with-msg? RuntimeException #"EOF while reading constructor form" 32 | (cr/read-string "#java.util.ArrayList"))) 33 | (is (thrown-with-msg? RuntimeException #"Unreadable constructor form starting with \"#java.util.ArrayList\(" 34 | (cr/read-string "#java.util.ArrayList("))) 35 | ;; the Clojure source indicates the record reader might skip whitespace in the future 36 | (is (thrown-with-msg? RuntimeException #"Unreadable constructor form starting with \"#java.util.ArrayList \"" 37 | (cr/read-string "#java.util.ArrayList ")))) 38 | 39 | (deftest test-unmatched-delimiter-read 40 | (is (thrown-with-msg? RuntimeException #"Unmatched delimiter: \)" 41 | (cr/read-string ")"))) 42 | (is (thrown-with-msg? RuntimeException #"Unmatched delimiter: \]" 43 | (cr/read-string "]"))) 44 | (is (thrown-with-msg? RuntimeException #"Unmatched delimiter: \}" 45 | (cr/read-string "}")))) 46 | -------------------------------------------------------------------------------- /src/clojure_reader/symbols.clj: -------------------------------------------------------------------------------- 1 | (ns clojure-reader.symbols 2 | (:use clojure-reader.util) 3 | (:import [java.util.regex Pattern Matcher] 4 | [clojure.lang Namespace Compiler Symbol Keyword Var])) 5 | 6 | (defn namespace-for 7 | ([^Symbol sym] (namespace-for *ns* sym)) 8 | ([^Namespace inns, ^Symbol sym] 9 | (let [ns-sym (symbol (.ns sym)) 10 | ns (.lookupAlias inns ns-sym )] 11 | (if (nil? ns) 12 | (Namespace/find ns-sym) 13 | ns)))) 14 | 15 | (def symbol-pattern (Pattern/compile "[:]?([\\D&&[^/]].*/)?([\\D&&[^/]][^/]*)")) 16 | (defn match-symbol [s] 17 | (let [m (.matcher symbol-pattern s)] 18 | (if (.matches m) 19 | (let [gc (.groupCount m) 20 | ns (.group m 1) 21 | name (.group m 2)] 22 | (cond 23 | (or (and (not-nil? ns) (.endsWith ns ":/")) 24 | (.endsWith name ":") 25 | (not= -1 (.indexOf s "::" 1))) 26 | nil 27 | 28 | (.startsWith s "::") 29 | (let [ks (symbol (.substring s 2)) 30 | kns (if (not-nil? (namespace ks)) 31 | (namespace-for ks) 32 | *ns*)] 33 | (if (not-nil? kns) 34 | (Keyword/intern (.. kns getName getName) (. ks getName)))) 35 | 36 | :else 37 | (let [keyword? (= \: (.charAt s 0)) 38 | sym (symbol (.substring s (if keyword? 1 0)))] 39 | (if keyword? 40 | (Keyword/intern sym) 41 | sym))))))) 42 | 43 | (defn interpret-token [token] 44 | (condp = token 45 | "nil" nil 46 | "true" true 47 | "false" false 48 | "/" / 49 | "clojure.core//" clojure.core// 50 | (if-let [matched (match-symbol token)] 51 | matched 52 | (throw (RuntimeException. (str "Invalid token: " token)))))) 53 | 54 | (defn resolve-symbol [sym] 55 | (cond 56 | (> (.indexOf (name sym) ".") 0) sym ;; already namespace qualified or class name 57 | (not-nil? (namespace sym)) (let [ns (namespace-for sym)] 58 | (if (or (nil? ns) (= (namespace sym) (name (ns-name ns)))) 59 | sym ;; cannot be found or same namespace 60 | (symbol (name (ns-name ns)) (name sym)))) 61 | :else 62 | (let [o (.getMapping *ns* sym)] 63 | (cond 64 | (nil? o) (symbol (name (ns-name *ns*)) (name sym)) 65 | (class? o) (symbol nil (.getName ^Class o)) 66 | (var? o) (symbol (name (ns-name (.ns ^Var o))) (name (.sym ^Var o))) 67 | :else nil)))) 68 | 69 | (defn is-special [sym] (.containsKey Compiler/specials sym)) 70 | -------------------------------------------------------------------------------- /src/clojure_reader/util.clj: -------------------------------------------------------------------------------- 1 | (ns clojure-reader.util 2 | (:import [java.io PushbackReader] 3 | [java.util ArrayList] 4 | [clojure.lang LineNumberingPushbackReader])) 5 | 6 | (defn not-nil? [val] 7 | (not (nil? val))) 8 | 9 | (defmacro cond-let [bindings & clauses] 10 | (let [binding (first bindings)] 11 | (when-let [[test expr & more] clauses] 12 | (if (= test :else) 13 | expr 14 | `(if-let [~binding ~test] 15 | ~expr 16 | (cond-let ~bindings ~@more)))))) 17 | 18 | (defn throw-runtime 19 | "Throws the supplied exception wrapped in a runtime exception, 20 | unless it is already a runtime exception" 21 | ([e] 22 | (if (instance? RuntimeException e) 23 | (throw e) 24 | (throw (RuntimeException. e))))) 25 | 26 | (defn whitespace? 27 | "Determine if the character is considered whitespace in Clojure" 28 | [ch] 29 | (if (= -1 ch) 30 | false 31 | (or (Character/isWhitespace ch) (= \, (char ch))))) 32 | 33 | (defn plus-or-minus? [^Character ch] 34 | (let [chr (char ch)] 35 | (or (= chr \+) (= chr \-)))) 36 | 37 | (defn get-line-number [^PushbackReader reader] 38 | (if (instance? LineNumberingPushbackReader reader) 39 | (.getLineNumber reader) 40 | -1)) 41 | 42 | (defn slice 43 | ([string start-idx] 44 | (slice string start-idx (.length string))) 45 | ([string start-idx end-idx] 46 | (let [len (.length string) 47 | positivize #(if (< %1 0) (+ len %1) %1) 48 | s (positivize start-idx) 49 | e (positivize end-idx)] 50 | (if (< s e) 51 | (.substring string s e) 52 | "")))) 53 | 54 | (defn digit? [chr] 55 | (Character/isDigit chr)) 56 | 57 | (defn char->digit [chr base] 58 | (Character/digit chr base)) 59 | 60 | (defn eof? [ch] 61 | (or (= -1 ch) (= 65535 ch))) 62 | 63 | (def ^:dynamic *replace-eof-with* nil) 64 | 65 | (def ^:dynamic *eof-msg* "EOF while reading") 66 | 67 | (defn read-one 68 | ([^PushbackReader stream] (read-one stream *eof-msg*)) 69 | ([^PushbackReader stream, ^String eof-error-message] 70 | (let [ch (.read stream)] 71 | (if (eof? ch) 72 | (if (nil? *replace-eof-with*) 73 | (throw (RuntimeException. eof-error-message)) 74 | *replace-eof-with*) 75 | (char ch))))) 76 | 77 | (defn unread [^PushbackReader reader, chr] 78 | (.unread reader (int chr))) 79 | 80 | (def ^:dynamic *hashtable-threshold* 32) 81 | 82 | ;; re-implementation of RT/map 83 | (defn make-map [array-contents] 84 | (let [size (alength array-contents)] 85 | (cond 86 | (= 0 size) {} 87 | (<= size *hashtable-threshold*) (apply array-map array-contents) 88 | :else (apply hash-map array-contents)))) 89 | -------------------------------------------------------------------------------- /test/clojure_reader/test/core.clj: -------------------------------------------------------------------------------- 1 | (ns clojure-reader.test.core 2 | (:require [clojure-reader.core :as cr]) 3 | (:use [clojure.test])) 4 | 5 | (deftest test-reading-integers 6 | (is (= 23 (cr/read-string "23"))) 7 | (is (= -23 (cr/read-string "-23"))) 8 | (is (= +23 (cr/read-string "+23"))) 9 | 10 | (is (= 23N (cr/read-string "23N"))) 11 | (is (= -23N (cr/read-string "-23N"))) 12 | (is (= +23N (cr/read-string "+23N"))) 13 | 14 | (is (= 0123 (cr/read-string "0123"))) 15 | (is (= 0xff (cr/read-string "0xff")))) 16 | 17 | (deftest test-reading-floats 18 | (is (= 2.3 (cr/read-string "2.3"))) 19 | (is (= -2.3 (cr/read-string "-2.3"))) 20 | (is (= +2.3 (cr/read-string "+2.3"))) 21 | 22 | (is (= 2.3M (cr/read-string "2.3M"))) 23 | (is (= -2.3M (cr/read-string "-2.3M"))) 24 | (is (= +2.3M (cr/read-string "+2.3M")))) 25 | 26 | (deftest test-reading-rations 27 | (is (= 2/5 (cr/read-string "2/5"))) 28 | (is (= -2/5 (cr/read-string "-2/5")))) 29 | 30 | (deftest test-reading-symbols 31 | (is (= :foo (cr/read-string ":foo"))) 32 | (is (= :user/foo (cr/read-string "::foo"))) 33 | (is (= 'clojure.core/map (cr/read-string "clojure.core/map")))) 34 | 35 | (defn regex-equal [r1 r2] 36 | (and (= (class r1) (class r2)) 37 | (= (str r1) (str r2)))) 38 | 39 | (deftest test-reading-regexs 40 | (is (regex-equal #"foo" (cr/read-string "#\"foo\"")))) 41 | 42 | (deftest test=reading-lists 43 | (is (= '() (cr/read-string "()"))) 44 | (is (= '(1) (cr/read-string "(1)"))) 45 | (is (= '(1 2 3) (cr/read-string "(1 2 3)"))) 46 | (is (= '(1 (2 3)) (cr/read-string "(1 (2 3))")))) 47 | 48 | (deftest test-reading-vectors 49 | (is (= [] (cr/read-string "[]"))) 50 | (is (= [1] (cr/read-string "[1]"))) 51 | (is (= [1 2 3] (cr/read-string "[1 2 3]"))) 52 | (is (= [1 [2 3]] (cr/read-string "[1 [2 3]]")))) 53 | 54 | (deftest test-reading-maps 55 | (is {} (cr/read-string "{}")) 56 | (is {1 2} (cr/read-string "{1 2}")) 57 | (is {1 {2 3}} (cr/read-string "{1 {2 3}}")) 58 | (is {1 {2 3} 4 5} (cr/read-string "{1 {2 3} 4 5}"))) 59 | 60 | (deftest test-reading-sets 61 | (is (= #{} (cr/read-string "#{}"))) 62 | (is (= #{1} (cr/read-string "#{1}"))) 63 | (is (= #{1 2} (cr/read-string "#{1 2}"))) 64 | (is (= #{1 2 #{3 4}} (cr/read-string "#{1 2 #{3 4}}")))) 65 | 66 | (deftest test-comma-is-whitespace 67 | (is (= [1 2] (cr/read-string "[1, 2]"))) 68 | (is (= {1 2} (cr/read-string "{1, 2}"))) 69 | (is (= 1 (cr/read-string ",1")))) 70 | 71 | (deftest test-reading-metadata 72 | (is (= {:foo true} (meta (cr/read-string "^:foo (1 2 3)")))) 73 | (is (= {:a 1} (meta (cr/read-string "^{:a 1} (1 2 3)")))) 74 | (is (= {:tag "foo"} (meta (cr/read-string "^\"foo\" (1 2 3)")))) 75 | (is (= {:tag 'java.util.ArrayList} (meta (cr/read-string "^java.util.ArrayList (1 2 3)"))))) 76 | 77 | (deftest test-reading-strings 78 | (let [simple-string "\"abcd\"" 79 | octal-string "\"abc\\177\"" 80 | unicode-string "\"abc\\0104\"" 81 | escaped-string "\"\\n\\b\\f\\r\""] 82 | (is (= (clojure.core/read-string simple-string) 83 | (cr/read-string simple-string))) 84 | (is (= (clojure.core/read-string octal-string) 85 | (cr/read-string octal-string))) 86 | (is (= (clojure.core/read-string unicode-string) 87 | (cr/read-string unicode-string))) 88 | (is (= (clojure.core/read-string escaped-string) 89 | (cr/read-string escaped-string))))) 90 | 91 | (deftest test-read-characters 92 | (is (= \space (cr/read-string "\\space"))) 93 | (is (= \c (cr/read-string "\\c"))) 94 | (is (= \o377 (cr/read-string "\\o377"))) 95 | (is (= \u0104 (cr/read-string "\\u0104")))) 96 | 97 | (deftest test-syntax-quote 98 | (doseq [form ["`1" "`map" "`asdfasdv" "`(1 2 (3 4))" "`(a b c ~z)" "`(a b c ~@z)"]] 99 | (is (= (clojure.core/read-string form)) (cr/read-string form)))) 100 | 101 | (deftest test-tagged-literals 102 | (let [s "#inst \"2010-11-12T13:14:15.666-06:00\""] 103 | (is (= (clojure.core/read-string s) (cr/read-string s))) 104 | (binding [*data-readers* {}] 105 | (= java.util.Date (class (cr/read-string s)))) 106 | (binding [*data-readers* {'inst clojure.instant/read-instant-calendar}] 107 | (= java.util.GregorianCalendar (class (cr/read-string s)))))) 108 | 109 | (defrecord Person [name age]) 110 | 111 | (deftest test-records 112 | (is (= #clojure_reader.test.core.Person["test" 18] 113 | (cr/read-string "#clojure_reader.test.core.Person[\"test\" 18]"))) 114 | (is (= #clojure_reader.test.core.Person{:age 18} 115 | (cr/read-string "#clojure_reader.test.core.Person{:age 18}")))) 116 | 117 | (deftest test-eval-reader 118 | (is (= 3 (cr/read-string "#=(+ 2 1)"))) 119 | (is (= "" (cr/read-string "#=(java.lang.String.)"))) 120 | (is (= 12 (cr/read-string "#=(java.lang.Long/valueOf 12)")))) 121 | 122 | (deftest test-fn-reader 123 | (is (= (cr/read-string "#(+ 1 2)") (clojure.core/read-string "#(+ 1 2)")))) 124 | 125 | (deftest test-arg-reader 126 | (is (= 3 (apply (eval (cr/read-string "#(+ %1 %2)")) [1 2])))) 127 | 128 | (deftest test-wrapping-readers 129 | (let [quote-form "'foo" 130 | var-form "#'foo" 131 | deref-form "@foo"] 132 | (is (= (clojure.core/read-string quote-form) (cr/read-string quote-form))) 133 | (is (= (clojure.core/read-string var-form) (cr/read-string var-form))) 134 | (is (= (clojure.core/read-string deref-form) (cr/read-string deref-form))))) 135 | -------------------------------------------------------------------------------- /src/clojure_reader/core.clj: -------------------------------------------------------------------------------- 1 | (ns clojure-reader.core 2 | (:refer-clojure :exclude [read read-string]) 3 | (:use clojure-reader.util 4 | [clojure-reader.numbers :only (match-number)] 5 | [clojure-reader.symbols :only (interpret-token resolve-symbol is-special)]) 6 | (:import [java.io PushbackReader StringReader] 7 | [java.util ArrayList] 8 | [java.util.regex Pattern Matcher] 9 | [clojure.lang IFn RT Symbol Keyword IMeta IReference IObj Reflector Var] 10 | [clojure.lang PersistentList PersistentHashSet LazilyPersistentVector] 11 | [clojure.lang IPersistentMap IPersistentCollection IPersistentList] 12 | [clojure.lang LineNumberingPushbackReader LispReader$ReaderException])) 13 | 14 | (declare read) 15 | (declare read-string) 16 | 17 | (def ^:private macros (make-array IFn 256)) 18 | (def ^:private dispatch-macros (make-array IFn 256)) 19 | 20 | (def ^:dynamic *allow-incomplete-read* false) 21 | 22 | (defn- get-macro [ch] 23 | (if (< (int ch) (alength macros)) 24 | (aget macros ch))) 25 | 26 | (defn- macro? [ch] 27 | (not-nil? (get-macro ch))) 28 | 29 | (defn- terminating-macro? [ch] 30 | (and (not (or (= \# (char ch)) 31 | (= \\ (char ch)) 32 | )) 33 | (macro? ch))) 34 | 35 | (defn- read-a-token [^PushbackReader stream, ch] 36 | (let [sb (StringBuilder.)] 37 | (.append sb (char ch)) 38 | (loop [ch (.read stream)] 39 | (if (not (or (eof? ch) (whitespace? ch) (terminating-macro? ch))) 40 | (do 41 | (.append sb (char ch)) 42 | (recur (.read stream))) 43 | (do 44 | (unread stream ch) 45 | (.toString sb)))))) 46 | 47 | 48 | (defn read-delimited-list [^Character delim, ^PushbackReader reader, recursive?] 49 | (let [first-line (get-line-number reader) 50 | a (ArrayList.)] 51 | (binding [*eof-msg* (if (< first-line 0) 52 | "EOF while reading" 53 | (str "EOF while reading, starting at line " first-line)) 54 | *replace-eof-with* (if *allow-incomplete-read* delim nil) 55 | ] 56 | (loop [chr (read-one reader)] 57 | (if (whitespace? chr) 58 | (recur (read-one reader)) 59 | (cond 60 | (= chr delim) a 61 | (macro? chr) (let [mret ((get-macro chr) reader chr)] 62 | (if (not= reader mret) 63 | (do (.add a mret) 64 | (recur (read-one reader))) 65 | (recur (read-one reader)))) 66 | :else (do (unread reader chr) 67 | (let [o (read reader true nil recursive?)] 68 | (if (not= reader o) 69 | (.add a o))) 70 | (recur (read-one reader))))))))) 71 | 72 | (defmacro defreader [name & body] 73 | `(defn ~name ~[^PushbackReader 'reader, ^Character 'ch] 74 | ~@body 75 | ) 76 | ) 77 | 78 | (defn read-unicode-char 79 | ([^String token, ^long offset, ^long length, ^long base] 80 | (if (not= (.length token) (+ offset length)) 81 | (throw (IllegalArgumentException. (str "Invalid unicode character: \\" token))) 82 | (loop [uc 0 i offset] 83 | (if (= i (+ offset length)) 84 | uc 85 | (let [ch (.charAt token i) 86 | d (char->digit ch base)] 87 | (if (= -1 d) 88 | (throw (IllegalArgumentException. (str "Invalid digit: " ch))) 89 | (recur (+ d (* uc base)) (+ i 1)))))))) 90 | ([^PushbackReader reader, 91 | ^Character initch, 92 | base, length, 93 | exact?] 94 | (loop [uc (char->digit initch (int base)) i 1] 95 | (if (= -1 uc) 96 | (throw (IllegalArgumentException. (str "Invalid digit: " initch))) 97 | (if (= length i) 98 | uc 99 | (let [ch (.read reader)] 100 | (if (or (eof? ch) (whitespace? (char ch)) (macro? ch)) 101 | (do 102 | (unread reader ch) 103 | (if (and exact? (not= length i)) 104 | (throw (IllegalArgumentException. (str "Invalid character length: " i ", should be: " length))) 105 | uc 106 | ) 107 | ) 108 | (let [d (char->digit (char ch) (int base))] 109 | (if (= -1 d) 110 | (throw (IllegalArgumentException. (str "Invalid digit: " ch))) 111 | (recur (+ d (* uc base)) (+ i 1))))))))))) 112 | 113 | (defn read-escaped-character [^PushbackReader reader] 114 | (binding [*eof-msg* "EOF"] 115 | (let [chr (read-one reader)] 116 | (condp = chr 117 | \t \tab 118 | \r \return 119 | \n \newline 120 | \\ \\ 121 | \" \" 122 | \b \backspace 123 | \f \formfeed 124 | \u 125 | (let [ch (.read reader)] 126 | (if (= -1 (char->digit ch 16)) 127 | (throw (RuntimeException. (str "Invalid unicode escape: \\u" (char ch)))) 128 | (read-unicode-char reader (char ch) 16 4 true))) 129 | (if (digit? chr) 130 | (let [uchr (read-unicode-char reader chr 8 3 false)] 131 | (if (> uchr 0377) 132 | (throw (RuntimeException. "Octal escape sequence must be in range [0, 377].")) 133 | (char uchr))) 134 | (throw (RuntimeException. (str "Unsupported escape character: \\" chr)))))))) 135 | 136 | (defreader string-reader 137 | (binding [*eof-msg* "EOF while reading string" 138 | *replace-eof-with* (if *allow-incomplete-read* \" nil)] 139 | (let [sb (StringBuilder.)] 140 | (loop [chr (read-one reader)] 141 | (cond (= \" chr) (.toString sb) 142 | (not= \\ chr) (do (.append sb chr) 143 | (recur (read-one reader))) 144 | :else (let [echr (read-escaped-character reader)] 145 | (.append sb echr) 146 | (recur (read-one reader)))))))) 147 | 148 | (defreader comment-reader 149 | (loop [ch (.read reader)] 150 | (if (not (or (eof? ch) (= \newline (char ch)) (= \return (char ch)))) 151 | (recur (.read reader)) 152 | reader))) 153 | 154 | (defn to-meta-map [meta] 155 | (cond 156 | (or (symbol? meta) (string? meta)) {:tag meta} 157 | (keyword? meta) {meta true} 158 | (map? meta) meta 159 | :else (throw (IllegalArgumentException. "Metadata must be Symbol,Keyword,String or Map")))) 160 | 161 | (defn to-meta-map-with-line-number 162 | ([meta] (to-meta-map-with-line-number -1)) 163 | ([meta line] 164 | (let [meta-without-line (to-meta-map meta)] 165 | (if (not= line -1) 166 | (assoc meta-without-line :line line) 167 | meta-without-line)))) 168 | 169 | (defreader meta-reader 170 | (let [line (get-line-number reader) 171 | meta (to-meta-map-with-line-number (read reader true nil true) line) 172 | o (read reader true nil true)] 173 | (if (instance? IMeta o) 174 | (if (instance? IReference o) 175 | (do (.resetMeta o meta) o) 176 | (with-meta o (merge (meta o) meta))) 177 | (throw (IllegalArgumentException. "Metadata can only be applied to IMetas"))))) 178 | 179 | 180 | (def ^:dynamic *gensym-environment* nil) 181 | 182 | 183 | (defn- unquote? [form] 184 | (and (seq? form) (= (first form) clojure.core/unquote))) 185 | 186 | (defn- unquote-splicing? [form] 187 | (and (seq? form) (= (first form) clojure.core/unquote-splicing))) 188 | 189 | (declare syntax-quote) 190 | 191 | (defn- syntax-quote-symbol [^Symbol sym] 192 | (list 'quote 193 | (cond 194 | (and (nil? (namespace sym)) (.endsWith (name sym) "#")) 195 | (let [gmap *gensym-environment*] 196 | (if (nil? gmap) 197 | (throw (IllegalStateException. "Gensym literal not in syntax-quote")) 198 | (let [gs (gmap sym)] 199 | (if (not-nil? gs) 200 | gs 201 | (let [sym-name (str (slice (name sym) 0 -1) "__" (RT/nextID) "__auto__") 202 | gs (symbol nil sym-name)] 203 | (var-set (var *gensym-environment*) (assoc gmap sym gs)) 204 | gs))))) 205 | 206 | (and (nil? (namespace sym)) (.endsWith (name sym) ".")) 207 | (let [csym (symbol nil (slice (name sym) 0 -1)) 208 | rsym (resolve-symbol csym)] 209 | (symbol nil (.concat (name rsym) "."))) 210 | 211 | (and (nil? (namespace sym)) (.startsWith (name sym) ".")) 212 | sym 213 | 214 | :else 215 | (if (not-nil? (namespace sym)) 216 | (let [maybe-class (ns-resolve *ns* (symbol nil (namespace sym)))] 217 | (if (class? maybe-class) 218 | (symbol (.getName maybe-class) (name sym)) 219 | (resolve-symbol sym))) 220 | (resolve-symbol sym))))) 221 | 222 | (defn- flatten-map [form] 223 | (reduce (fn [result keyval] (apply conj result keyval)) [] form)) 224 | 225 | (defn- seq-expand-list [lst] 226 | (doall (map (fn [item] 227 | (cond 228 | (unquote? item) (list 'clojure.core/list (second item)) 229 | (unquote-splicing? item) (second item) 230 | :else (list 'clojure.core/list (syntax-quote item)) 231 | ) 232 | ) lst))) 233 | 234 | (defn- syntax-quote-seq [constructor form] 235 | (let [inner (list 'clojure.core/seq 236 | (apply list 'clojure.core/concat 237 | (seq-expand-list form)))] 238 | (if (nil? constructor) 239 | inner 240 | (list 'clojure.core/apply constructor inner)))) 241 | 242 | (defn- syntax-quote-col [form] 243 | (cond 244 | (map? form) (syntax-quote-seq 'clojure.core/hash-map (flatten-map form)) 245 | (vector? form) (syntax-quote-seq 'clojure.core/vector form) 246 | (set? form) (syntax-quote-seq 'clojure.core/hash-set form) 247 | (or (seq? form) (list? form)) 248 | (if (nil? (seq form)) (list 'clojure.core/list) (syntax-quote-seq nil form)) 249 | :else (throw (UnsupportedOperationException. "Unknown Collection type")))) 250 | 251 | 252 | (defn syntax-quote [form] 253 | (let [ret (cond 254 | (is-special form) (list 'quote form) 255 | (symbol? form) (syntax-quote-symbol form) 256 | (unquote? form) (second form) 257 | (unquote-splicing? form) (throw (IllegalStateException. "splice not in list")) 258 | (coll? form) (syntax-quote-col form) 259 | (or (keyword? form) (number? form) 260 | (char? form) (string? form)) form 261 | :else (list 'quote form))] 262 | (if (and (instance? IObj form) (not-nil? (meta form))) 263 | (let [new-meta (dissoc (meta form) :line)] ; filter line numbers 264 | (if (> 0 (.count new-meta)) 265 | (list clojure.core/with-meta ret (syntax-quote (meta form))) 266 | ret)) 267 | ret 268 | ))) 269 | 270 | (defreader syntax-quote-reader 271 | (binding [*gensym-environment* {}] 272 | (let [form (read reader (not *allow-incomplete-read*) nil true)] 273 | (syntax-quote form)))) 274 | 275 | (defreader unquote-reader 276 | (binding [*eof-msg* "EOF while reading character" 277 | *replace-eof-with* (if *allow-incomplete-read* \space nil)] 278 | (let [chr (read-one reader)] 279 | (if (= \@ chr) 280 | (let [o (read reader (not *allow-incomplete-read*) () true)] 281 | (list clojure.core/unquote-splicing o)) 282 | (do 283 | (unread reader chr) 284 | (let [o (read reader (not *allow-incomplete-read*) nil true)] 285 | (list clojure.core/unquote o))))))) 286 | 287 | (defreader list-reader 288 | (let [line (get-line-number reader) 289 | lst (read-delimited-list \) reader true)] 290 | (if (.isEmpty lst) 291 | (list) 292 | (let [s (apply list lst)] 293 | (if (not= -1 line) 294 | (.withMeta s {:line line}) 295 | s 296 | ))))) 297 | 298 | (defreader character-reader 299 | (binding [*eof-msg* "EOF while reading character"] 300 | (let [chr (read-one reader)] 301 | (let [token (read-a-token reader chr)] 302 | (if (= 1 (.length token)) 303 | (Character/valueOf (.charAt token 0)) 304 | (condp = token 305 | "newline" \newline 306 | "space" \space 307 | "tab" \tab 308 | "backspace" \backspace 309 | "formfeed" \formfeed 310 | "return" \return 311 | (cond 312 | (.startsWith token "u") 313 | (let [c (read-unicode-char token 1 4 16)] 314 | (if (and (>= c 0xD800 (<= c 0xDFFF))) 315 | (throw (RuntimeException. (str "Invalid character constant: \\u" 316 | (Integer/toString c 16)))) 317 | (char c))) 318 | 319 | (.startsWith token "o") 320 | (let [len (- (.length token) 1)] 321 | (if (> len 3) 322 | (throw (RuntimeException. (str "Invalid octal escape sequence length: " len))) 323 | (let [uc (read-unicode-char token 1 len 8)] 324 | (if (> uc 0377) 325 | (throw (RuntimeException. "Octal escape sequence must be in range [0, 377].")) 326 | (char uc))))) 327 | 328 | :else 329 | (throw (RuntimeException. (str "Unsupported character: \\" token)))))))))) 330 | 331 | (declare ctor-reader) 332 | 333 | (defreader dispatch-reader 334 | (binding [*eof-msg* "EOF while reading character"] 335 | (loop [chr (read-one reader) 336 | dfn (aget dispatch-macros chr)] 337 | (if (nil? dfn) 338 | (do 339 | (unread reader chr) 340 | (let [result (ctor-reader reader chr)] 341 | (if (nil? result) 342 | (throw (RuntimeException. (str "No dispatch macro for:" chr))) 343 | result))) 344 | (dfn reader chr))))) 345 | 346 | (defreader regex-reader 347 | (binding [*eof-msg* "EOF while reading regex"] 348 | (let [sb (StringBuilder.)] 349 | (loop [chr (read-one reader)] 350 | (if (not= \" chr) 351 | (do 352 | (.append sb chr) 353 | (if (= \\ chr) 354 | (let [ch2 (read-one reader)] 355 | (.append sb (char ch2)))) 356 | (recur (read-one reader))) 357 | (Pattern/compile (.toString sb))))))) 358 | 359 | (defn- read-record [^PushbackReader reader, ^Symbol record-name] 360 | (binding [*eof-msg* "EOF while reading constructor form" 361 | *replace-eof-with* (if *allow-incomplete-read* \[ nil)] 362 | (let [record-class (RT/classForName (.toString record-name)) 363 | chr (read-one reader) 364 | [endch short-form?] (condp = chr 365 | \{ [\} false] 366 | \[ [\] true] 367 | (throw (RuntimeException. (str "Unreadable constructor form" 368 | " starting with \"#" 369 | record-name chr "\"")))) 370 | record-entries (.toArray (read-delimited-list endch reader true)) 371 | all-ctors (.getConstructors record-class)] 372 | (if short-form? 373 | (let [matching-ctor #(= (alength record-entries) (alength (.getParameterTypes %1))) 374 | ctor (first (filter matching-ctor all-ctors))] 375 | (if (nil? ctor) 376 | (throw (RuntimeException. (str "Unexpected number of constructor arguments to " 377 | record-class ": got " (alength record-entries)))) 378 | (Reflector/invokeConstructor record-class record-entries))) 379 | (let [vals (make-map record-entries)] 380 | (doseq [k (keys vals)] 381 | (if (not (keyword? k)) 382 | (throw (RuntimeException. (str "Unreadable defrecord form: " 383 | "key must be of type clojure.lang.Keyword, got " 384 | k))))) 385 | (Reflector/invokeStaticMethod record-class "create" (into-array Object [vals]))))))) 386 | 387 | (defn- get-data-reader [tag] 388 | (let [data-readers clojure.core/*data-readers* 389 | data-reader (data-readers tag)] 390 | (if (nil? data-reader) 391 | (let [default-reader (clojure.core/default-data-readers tag)] 392 | (if (nil? default-reader) 393 | (throw (RuntimeException. (str "No reader function for tag" tag))) 394 | default-reader 395 | )) 396 | data-reader))) 397 | 398 | (defn- read-tagged [^PushbackReader reader, ^Symbol tag] 399 | (let [o (read reader true nil true) 400 | data-reader (get-data-reader tag)] 401 | (data-reader o))) 402 | 403 | (defreader ctor-reader 404 | (let [sym (read reader true nil false)] 405 | (if (not (symbol? sym)) 406 | (throw (RuntimeException. "Reader tag must be a symbol")) 407 | (if (.contains (name sym) ".") 408 | (read-record reader sym) 409 | (read-tagged reader sym))))) 410 | 411 | (def ^:dynamic *arg-env* nil) 412 | 413 | (defn- garg [^long n] 414 | (symbol nil (if (= -1 n) "rest" (str "p" n "__" (RT/nextID) "#")))) 415 | 416 | (defn- get-args [] 417 | (let [argsym *arg-env* 418 | args [] 419 | rargs (rseq argsym)] 420 | (if (not-nil? rargs) 421 | (let [higharg (key (first rargs))] 422 | (if (> higharg 0) 423 | (apply conj args (for [i (range 1 (inc higharg))] 424 | (let [sym (get argsym i)] 425 | (if (nil? sym) 426 | (garg i) 427 | sym)))) 428 | (let [restsym (get argsym -1)] 429 | (if (not-nil? restsym) 430 | (conj args '& restsym) 431 | args)))) 432 | args))) 433 | 434 | (defreader fn-reader 435 | (if (not-nil? *arg-env*) 436 | (throw (IllegalStateException. "Nested #()s are not allowed")) 437 | (binding [*arg-env* (sorted-map)] 438 | (unread reader ch) 439 | (let [form (read reader true nil true) 440 | args (get-args)] 441 | (list 'fn* args form))))) 442 | 443 | (defn register-arg [n] 444 | (let [argsym *arg-env*] 445 | (if (nil? argsym) 446 | (throw (IllegalStateException. "arg literal not in #()")) 447 | (let [ret (get argsym n)] 448 | (if (nil? ret) 449 | (let [ret (garg n)] 450 | (var-set (var *arg-env*) (assoc *arg-env* n ret)) 451 | ret) 452 | ret))))) 453 | 454 | (defreader arg-reader 455 | (if (nil? *arg-env*) 456 | (interpret-token (read-a-token reader \%)) 457 | (let [ch (.read reader)] 458 | (unread reader ch) 459 | (if (or (eof? ch) (whitespace? ch) (terminating-macro? ch)) 460 | (register-arg 1) 461 | (let [n (read reader true nil true)] 462 | (cond (= '& n) (register-arg -1) 463 | (not (number? n)) (throw (IllegalStateException. 464 | "arg literal must be %, %& or %integer")) 465 | :else (register-arg (int n)))))))) 466 | 467 | (defreader eval-reader 468 | (if (not clojure.core/*read-eval*) 469 | (throw (RuntimeException. "EvalReader not allowed when *read-eval* is false.")) 470 | (let [o (read reader true nil true)] 471 | (cond 472 | (symbol? o) (RT/classForName (str o)) 473 | (list? o) (let [fs (first o)] 474 | (cond 475 | (= fs 'var) (let [vs (second o)] (RT/var (namespace vs) (name vs))) 476 | (.endsWith (name fs) ".") (let [args (RT/toArray (next o))] 477 | (Reflector/invokeConstructor 478 | (RT/classForName (slice (name fs) 0 -1)) 479 | args)) 480 | (Compiler/namesStaticMember fs) (let [args (RT/toArray (next o))] 481 | (Reflector/invokeStaticMethod 482 | (namespace fs) 483 | (name fs) 484 | args)) 485 | :else (let [v (ns-resolve *ns* fs)] 486 | (if (var? v) 487 | (apply v (next o)) 488 | (throw (RuntimeException. (str "Can't resolve " fs))))))) 489 | :else (throw (IllegalArgumentException. "Unsupported #= form")))))) 490 | 491 | (defreader discard-reader 492 | (read reader (not *allow-incomplete-read*) nil true) 493 | reader) 494 | 495 | (defreader unmatched-delimiter-reader 496 | (throw (RuntimeException. (str "Unmatched delimiter: " ch)))) 497 | 498 | (defreader unreadable-reader 499 | (throw (RuntimeException. "Unreadable form"))) 500 | 501 | (defreader set-reader 502 | (apply hash-set (read-delimited-list \} reader true))) 503 | 504 | (defreader vector-reader 505 | (apply vector (read-delimited-list \] reader true))) 506 | 507 | (defreader map-reader 508 | (let [read (read-delimited-list \} reader true)] 509 | (if (not= 0 (bit-and (.size read) 1)) 510 | (if *allow-incomplete-read* 511 | (do 512 | (.add read nil) 513 | (make-map (.toArray read))) 514 | (throw (RuntimeException. "Map literal must contain an even number of forms"))) 515 | (make-map (.toArray read))))) 516 | 517 | (defn make-wrapping-reader [^Symbol sym] 518 | (fn [^PushbackReader reader, ^Character ch] 519 | (list sym (read reader (not *allow-incomplete-read*) nil true)))) 520 | 521 | (def quote-reader (make-wrapping-reader 'quote)) 522 | (def deref-reader (make-wrapping-reader 'clojure.core/deref)) 523 | (def var-reader (make-wrapping-reader 'var)) 524 | 525 | (do 526 | (aset macros \" string-reader) 527 | (aset macros \; comment-reader) 528 | (aset macros \' quote-reader) 529 | (aset macros \@ deref-reader) 530 | (aset macros \^ meta-reader) 531 | (aset macros \` syntax-quote-reader) 532 | (aset macros \~ unquote-reader) 533 | (aset macros \( list-reader) 534 | (aset macros \) unmatched-delimiter-reader) 535 | (aset macros \[ vector-reader) 536 | (aset macros \] unmatched-delimiter-reader) 537 | (aset macros \{ map-reader) 538 | (aset macros \} unmatched-delimiter-reader) 539 | (aset macros \\ character-reader) 540 | (aset macros \% arg-reader) 541 | (aset macros \# dispatch-reader)) 542 | 543 | (do 544 | (aset dispatch-macros \^ meta-reader) 545 | (aset dispatch-macros \' var-reader) 546 | (aset dispatch-macros \" regex-reader) 547 | (aset dispatch-macros \( fn-reader) 548 | (aset dispatch-macros \{ set-reader) 549 | (aset dispatch-macros \= eval-reader) 550 | (aset dispatch-macros \! comment-reader) 551 | (aset dispatch-macros \< unreadable-reader) 552 | (aset dispatch-macros \_ discard-reader)) 553 | 554 | 555 | (defn- read-a-number [^PushbackReader stream, ^Character ch] 556 | (let [sb (StringBuilder.)] 557 | (.append sb (char ch)) 558 | (loop [ch (.read stream)] 559 | (if (not (or (eof? ch) (whitespace? ch) (macro? ch))) 560 | (do 561 | (.append sb (char ch)) 562 | (recur (.read stream))) 563 | (unread stream ch))) 564 | (let [s (.toString sb) 565 | n (match-number s)] 566 | (if (nil? n) 567 | (throw (NumberFormatException. (str "Invalid number: " s))) 568 | n)))) 569 | 570 | (defn read 571 | "Reads the next object from stream, which must be an instance of 572 | java.io.PushbackReader or some derivee. stream defaults to the 573 | current value of *in* ." 574 | ([] 575 | (read *in*)) 576 | ([stream] 577 | (read stream true nil)) 578 | ([stream eof-error? eof-value] 579 | (read stream eof-error? eof-value false)) 580 | ([stream eof-error? eof-value recursive?] 581 | (try 582 | (loop [ch (.read stream)] 583 | (if (whitespace? ch) 584 | (recur (.read stream)) 585 | (cond 586 | (eof? ch) (if eof-error? 587 | (throw (RuntimeException. "EOF while reading")) 588 | eof-value) 589 | (digit? ch) (read-a-number stream ch) 590 | (macro? ch) (let [the-macro (get-macro ch) 591 | val (the-macro stream (char ch))] 592 | (if (= stream val) ; no-op macros return the reader 593 | (recur (.read stream)) 594 | val)) 595 | (plus-or-minus? ch) (let [ch2 (.read stream)] 596 | (if (digit? ch2) 597 | (do 598 | (unread stream ch2) 599 | (read-a-number stream ch)) 600 | (do 601 | (unread stream ch2) 602 | (interpret-token (read-a-token stream ch))))) 603 | :else (interpret-token (read-a-token stream ch))))) 604 | (catch Exception e 605 | (if (or recursive? (not (instance? LineNumberingPushbackReader stream))) 606 | (throw-runtime e) 607 | (throw (LispReader$ReaderException. (.getLineNumber stream) e)) 608 | ))))) 609 | 610 | (defn read-string 611 | "Reads one object from the supplied string" 612 | ([s] 613 | (let [stream (PushbackReader. (StringReader. s))] 614 | (read stream (not *allow-incomplete-read*) nil false)))) 615 | --------------------------------------------------------------------------------