132 lines
4.3 KiB
Clojure
132 lines
4.3 KiB
Clojure
;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
|
|
;; 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.
|
|
|
|
(ns cljs.tools.reader.impl.commons
|
|
(:refer-clojure :exclude [char])
|
|
(:require
|
|
[cljs.tools.reader.impl.errors :refer [reader-error]]
|
|
[cljs.tools.reader.reader-types :refer [peek-char read-char]]
|
|
[cljs.tools.reader.impl.utils :refer [numeric? newline? char]]))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; helpers
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn ^boolean number-literal?
|
|
"Checks whether the reader is at the start of a number literal"
|
|
[^not-native reader initch]
|
|
(or (numeric? initch)
|
|
(and (or (identical? \+ initch) (identical? \- initch))
|
|
(numeric? (peek-char reader)))))
|
|
|
|
(defn read-past
|
|
"Read until first character that doesn't match pred, returning
|
|
char."
|
|
[pred ^not-native rdr]
|
|
(loop [ch (read-char rdr)]
|
|
(if ^boolean (pred ch)
|
|
(recur (read-char rdr))
|
|
ch)))
|
|
|
|
(defn skip-line
|
|
"Advances the reader to the end of a line. Returns the reader"
|
|
[^not-native reader]
|
|
(loop []
|
|
(when-not (newline? (read-char reader))
|
|
(recur)))
|
|
reader)
|
|
|
|
(def int-pattern #"^([-+]?)(?:(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)?$")
|
|
(def ratio-pattern #"([-+]?[0-9]+)/([0-9]+)")
|
|
(def float-pattern #"([-+]?[0-9]+(\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?")
|
|
|
|
(defn- match-int
|
|
[s]
|
|
(let [m (vec (re-find int-pattern s))]
|
|
(if-not (nil? (m 2))
|
|
0
|
|
(let [^boolean negate? (identical? "-" (m 1))
|
|
a (cond
|
|
(not (nil? (m 3))) [(m 3) 10]
|
|
(not (nil? (m 4))) [(m 4) 16]
|
|
(not (nil? (m 5))) [(m 5) 8]
|
|
(not (nil? (m 7))) [(m 7) (js/parseInt (m 6))]
|
|
:else [nil nil])
|
|
n (a 0)]
|
|
(when-not (nil? n)
|
|
(let [bn (js/parseInt n (a 1))
|
|
bn (if negate? (* -1 bn) bn)]
|
|
(when-not (js/isNaN bn)
|
|
bn)))))))
|
|
|
|
(defn- match-ratio
|
|
[s]
|
|
(let [m (vec (re-find ratio-pattern s))
|
|
numerator (m 1)
|
|
denominator (m 2)
|
|
numerator (if (re-find #"^\+" numerator)
|
|
(subs numerator 1)
|
|
numerator)]
|
|
(/ (-> numerator js/parseInt) ;;; No ratio type in cljs
|
|
(-> denominator js/parseInt)))); So will convert to js/Number
|
|
|
|
(defn- match-float
|
|
[s]
|
|
(let [m (vec (re-find float-pattern s))]
|
|
(if-not (nil? (m 4)) ;; for BigDecimal "10.03M", as all parsed to js/Number
|
|
(js/parseFloat (m 1))
|
|
(js/parseFloat s))))
|
|
|
|
(defn ^boolean matches? [pattern s]
|
|
(let [[match] (re-find pattern s)]
|
|
(identical? match s)))
|
|
|
|
(defn match-number [s]
|
|
(if (matches? int-pattern s)
|
|
(match-int s)
|
|
(if (matches? float-pattern s)
|
|
(match-float s)
|
|
(when (matches? ratio-pattern s)
|
|
(match-ratio s)))))
|
|
|
|
(defn parse-symbol
|
|
"Parses a string into a vector of the namespace and symbol"
|
|
[token]
|
|
(when-not (or (identical? "" token)
|
|
(true? (.test #":$" token))
|
|
(true? (.test #"^::" token)))
|
|
(let [ns-idx (.indexOf token "/")
|
|
ns (when (pos? ns-idx)
|
|
(subs token 0 ns-idx))]
|
|
(if-not (nil? ns)
|
|
(let [ns-idx (inc ns-idx)]
|
|
(when-not (== ns-idx (count token))
|
|
(let [sym (subs token ns-idx)]
|
|
(when (and (not (numeric? (nth sym 0)))
|
|
(not (identical? "" sym))
|
|
(false? (.test #":$" ns))
|
|
(or (identical? sym "/")
|
|
(== -1 (.indexOf sym "/"))))
|
|
[ns sym]))))
|
|
(when (or (identical? token "/")
|
|
(== -1 (.indexOf token "/")))
|
|
[nil token])))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; readers
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn read-comment
|
|
[rdr & _]
|
|
(skip-line rdr))
|
|
|
|
(defn throwing-reader
|
|
[msg]
|
|
(fn [rdr & _]
|
|
(reader-error rdr msg)))
|