Permalink
Browse files

simplified token, removing satisfy in the process

  • Loading branch information...
1 parent 9a3422b commit f03cda392f1a82a342aad00471c368ade9ac6e75 @youngnh committed Sep 22, 2011
Showing with 24 additions and 39 deletions.
  1. +17 −25 src/the/parsatron.clj
  2. +7 −14 test/parsatron/test.clj
View
@@ -9,6 +9,13 @@
(defrecord Err [errmsg])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; position
+(defn inc-sourcepos [{:keys [line column]} c]
+ (if (= c \newline)
+ (SourcePos. (inc line) 1)
+ (SourcePos. line (inc column))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; errors
(defprotocol ShowableError
(show-error [this]))
@@ -89,17 +96,13 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; token
-(defn token [consume? nextpos-f show-f]
+(defn token [consume?]
(fn [{:keys [input pos] :as state} cok cerr eok eerr]
- (if-let [s (seq input)]
- (let [item (first s)
- rest-of-input (next s)]
- (if (consume? item)
- (let [newpos (nextpos-f pos item rest-of-input)
- newstate (InputState. rest-of-input newpos)]
- (cok item newstate))
- (eerr (unexpect-error (show-f item) pos))))
- (eerr (unexpect-error "Input is empty" pos)))))
+ (if-let [tok (first input)]
+ (if (consume? tok)
+ (cok tok (InputState. (rest input) (inc-sourcepos pos tok)))
+ (eerr (unexpect-error (str "token '" tok "'") pos)))
+ (eerr (unexpect-error "end of input" pos)))))
(defn many [p]
(fn [state cok cerr eok eerr]
@@ -139,28 +142,17 @@
(eok nil state)
(eerr (expect-error "end of input" pos)))))
-(defn updatepos-char [{:keys [line column]} c]
- (case c
- \newline (SourcePos. (inc line) 1)
- (SourcePos. line (inc column))))
-
-(defn satisfy [pred]
- (token pred
- (fn [pos c cs]
- (updatepos-char pos c))
- str))
-
(defn char [c]
- (satisfy #(= c %)))
+ (token #(= c %)))
(defn any-char []
- (satisfy (constantly true)))
+ (token (constantly true)))
(defn digit []
- (satisfy #(Character/isDigit %)))
+ (token #(Character/isDigit %)))
(defn letter []
- (satisfy #(Character/isLetter %)))
+ (token #(Character/isLetter %)))
(defn between [open close p]
(let->> [_ open
@@ -31,25 +31,18 @@
(is (parser-result? 5 (either (never) (always 5)) "")))
(testing "when neither succeed, errors are merged"
- (is (thrown-with-msg? RuntimeException #"Unexpected c, Unexpected c"
+ (is (thrown-with-msg? RuntimeException #"Unexpected token 'c', Unexpected token 'c'"
(run (either (char \a) (char \b)) "c")))))
(deftest test-token
(testing "throws error on empty input"
- (let [consume? (constantly true)
- nxtpos (constantly (SourcePos. 1 2))
- show-token (constantly "a")]
- (is (thrown-with-msg? RuntimeException #"Input is empty"
- (run (token consume? nxtpos show-token) "")))))
+ (is (thrown-with-msg? RuntimeException #"Unexpected end of input"
+ (run (token (constantly true)) ""))))
(testing "consume? determines parser's behavior, show-f used in error message"
- (let [consume (constantly true)
- dont-consume (constantly false)
- nxtpos (constantly (SourcePos. 1 2))
- show-token (constantly "a")]
- (is (parser-result? \a (token consume nxtpos show-token) "a"))
- (is (thrown-with-msg? RuntimeException #"Unexpected a"
- (run (token dont-consume nxtpos show-token) "a"))))))
+ (is (parser-result? \a (token (constantly true)) "a"))
+ (is (thrown-with-msg? RuntimeException #"Unexpected token 'a'"
+ (run (token (constantly false)) "a")))))
(deftest test-many
(testing "throws an exception if parser does not consume"
@@ -70,7 +63,7 @@
(is (parser-result? [] (times 0 (char \a)) "")))
(testing "throws an error (from underlying parser) if fewer than specified"
- (are [input] (thrown-with-msg? RuntimeException #"Input is empty"
+ (are [input] (thrown-with-msg? RuntimeException #"Unexpected end of input"
(run (times 3 (char \a)) input))
""
"a"

0 comments on commit f03cda3

Please sign in to comment.