Skip to content


Stack Woes #7

merged 1 commit into from

2 participants


Hey Nate,

I've been using Parsatron to great effect for a few days now, but I've recently been running into stack overflow errors. The issue is most easily demonstrated by:

(run (many (char \a)) (take 1000 (repeat \a)))
;; [Thrown class java.lang.StackOverflowError]

I investigated trying to rewrite many using loop and recur, but it's not obvious how to do so given that the recursive call happens within an inner function. I've implemented a simple trampolining strategy to slow stack consumption. With this pull request I can run up to (run (many (char\a)) (take 10000 (repeat \a))) without triggering an overflow error.

Working on converting many to be iterative instead of recursive so as to keep it's stack consumption constant.


I like the spirit of this. I completely agree with you that The Parsatron, if it is to be usable for serious projects, needs to not blow the stack. I'm interested why you chose to use a record and loop/recur, essentially a hand-rolled trampoline, when Clojure there's clojure.core/trampoline ?

Only in case people want their parsers to evaluate to actual functions, e.x.: (>> (char \+) (always +). Using clojure.core/trampoline would definitely be cleaner.

@youngnh youngnh merged commit e211ba1 into youngnh:master
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on May 15, 2012
  1. @zane
Showing with 31 additions and 27 deletions.
  1. +31 −27 src/the/parsatron.clj
58 src/the/parsatron.clj
@@ -5,6 +5,7 @@
(defrecord InputState [input pos])
(defrecord SourcePos [line column])
+(defrecord Cont [fn])
(defrecord Ok [item])
(defrecord Err [errmsg])
@@ -45,12 +46,13 @@
;; m
(defn always
"A parser that always succeeds with the value given and consumes no
(fn [state cok cerr eok eerr]
- (eok x state)))
+ (Cont. #(eok x state))))
(defn bind
"Parse p, and then q. The function f must be of one argument, it
@@ -59,15 +61,15 @@
(fn [state cok cerr eok eerr]
(letfn [(pcok [item state]
(let [q (f item)]
- (q state cok cerr cok cerr)))
+ (Cont. #(q state cok cerr cok cerr))))
(peok [item state]
(let [q (f item)]
- (q state cok cerr eok eerr)))]
- (p state pcok cerr peok eerr))))
+ (Cont. #(q state cok cerr eok eerr))))]
+ (Cont. #(p state pcok cerr peok eerr)))))
(defn nxt
"Parse p and then q, returning q's value and discarding p's"
- [p q]
+ [p q]
(bind p (fn [_] q)))
(defmacro defparser
@@ -78,7 +80,7 @@
`(defn ~name ~args
(fn [state# cok# cerr# eok# eerr#]
(let [p# (>> ~@body)]
- (p# state# cok# cerr# eok# eerr#)))))
+ (Cont. #(p# state# cok# cerr# eok# eerr#))))))
(defmacro >>
"Expands into nested nxt forms"
@@ -100,7 +102,7 @@
"A parser that always fails, consuming no input"
(fn [state cok cerr eok eerr]
- (eerr (unknown-error state))))
+ (Cont. #(eerr (unknown-error state)))))
(defn either
"A parser that tries p, upon success, returning its value, and upon
@@ -109,16 +111,16 @@
(fn [state cok cerr eok eerr]
(letfn [(peerr [err-from-p]
(letfn [(qeerr [err-from-q]
- (eerr (merge-errors err-from-p err-from-q)))]
- (q state cok cerr eok qeerr)))]
- (p state cok cerr eok peerr))))
+ (Cont. #(eerr (merge-errors err-from-p err-from-q))))]
+ (Cont. #(q state cok cerr eok qeerr))))]
+ (Cont. #(p state cok cerr eok peerr)))))
(defn attempt
"A parser that will attempt to parse p, and upon failure never
- consume any input"
+ consume any input"
(fn [state cok cerr eok eerr]
- (p state cok eerr eok eerr)))
+ (Cont. #(p state cok eerr eok eerr))))
;; token
@@ -130,9 +132,9 @@
(fn [{:keys [input pos] :as state} cok cerr eok eerr]
(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)))))
+ (Cont. #(cok tok (InputState. (rest input) (inc-sourcepos pos tok))))
+ (Cont. #(eerr (unexpect-error (str "token '" tok "'") pos))))
+ (Cont. #(eerr (unexpect-error "end of input" pos))))))
(defn many
"Consume zero or more p. A RuntimeException will be thrown if this
@@ -158,11 +160,11 @@
(letfn [(pcok [item state]
(let [q (times (dec n) p)]
(letfn [(qcok [items state]
- (cok (cons item items) state))]
- (q state qcok cerr qcok eerr))))
+ (Cont. #(cok (cons item items) state)))]
+ (Cont. #(q state qcok cerr qcok eerr)))))
(peok [item state]
- (eok (repeat n item) state))]
- (p state pcok cerr peok eerr)))))
+ (Cont. #(eok (repeat n item) state)))]
+ (Cont. #(p state pcok cerr peok eerr))))))
(defn lookahead
"A parser that upon success consumes no input, but returns what was
@@ -170,8 +172,8 @@
(fn [state cok cerr eok eerr]
(letfn [(ok [item _]
- (eok item state))]
- (p state ok cerr eok eerr))))
+ (Cont. #(eok item state)))]
+ (Cont. #(p state ok cerr eok eerr)))))
(defn choice
"A varargs version of either that tries each given parser in turn,
@@ -189,8 +191,8 @@
(fn [{:keys [input pos] :as state} cok cerr eok eerr]
(if (empty? input)
- (eok nil state)
- (eerr (expect-error "end of input" pos)))))
+ (Cont. #(eok nil state))
+ (Cont. #(eerr (expect-error "end of input" pos))))))
(defn char
"Consume the given character"
@@ -249,7 +251,9 @@
in a RuntimeException and thrown, and if the parser succeeds, its
value is returned"
[p input]
- (let [result (run-parser p (InputState. input (SourcePos. 1 1)))]
- (condp = (class result)
- Ok (:item result)
- Err (throw (RuntimeException. (:errmsg result))))))
+ (let [state (InputState. input (SourcePos. 1 1))]
+ (loop [result (run-parser p state)]
+ (condp = (class result)
+ Cont (recur ((:fn result)))
+ Ok (:item result)
+ Err (throw (RuntimeException. (:errmsg result)))))))
Something went wrong with that request. Please try again.