Skip to content
This repository

Stack Woes #7

Merged
merged 1 commit into from almost 2 years ago

2 participants

Zane Shelby Nate Young
Zane Shelby
zane commented May 14, 2012

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.

Nate Young
Owner

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 ?

zane replied May 15, 2012

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

Nate Young youngnh merged commit e211ba1 into from May 18, 2012
Nate Young youngnh closed this May 18, 2012
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Showing 1 unique commit by 1 author.

May 14, 2012
Zane Shelby Add primitive trampolining to slow stack consumption. c4602c5
This page is out of date. Refresh to see the latest.

Showing 1 changed file with 31 additions and 27 deletions. Show diff stats Hide diff stats

  1. 58  src/the/parsatron.clj
58  src/the/parsatron.clj
@@ -5,6 +5,7 @@
5 5
 (defrecord InputState [input pos])
6 6
 (defrecord SourcePos [line column])
7 7
 
  8
+(defrecord Cont [fn])
8 9
 (defrecord Ok [item])
9 10
 (defrecord Err [errmsg])
10 11
 
@@ -45,12 +46,13 @@
45 46
 
46 47
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 48
 ;; m
  49
+
48 50
 (defn always
49 51
   "A parser that always succeeds with the value given and consumes no
50 52
    input"
51 53
   [x]
52 54
   (fn [state cok cerr eok eerr]
53  
-    (eok x state)))
  55
+    (Cont. #(eok x state))))
54 56
 
55 57
 (defn bind
56 58
   "Parse p, and then q. The function f must be of one argument, it
@@ -59,15 +61,15 @@
59 61
   (fn [state cok cerr eok eerr]
60 62
     (letfn [(pcok [item state]
61 63
               (let [q (f item)]
62  
-                (q state cok cerr cok cerr)))
  64
+                (Cont. #(q state cok cerr cok cerr))))
63 65
             (peok [item state]
64 66
               (let [q (f item)]
65  
-                (q state cok cerr eok eerr)))]
66  
-      (p state pcok cerr peok eerr))))
  67
+                (Cont. #(q state cok cerr eok eerr))))]
  68
+      (Cont. #(p state pcok cerr peok eerr)))))
67 69
 
68 70
 (defn nxt
69 71
   "Parse p and then q, returning q's value and discarding p's"
70  
-  [p q]  
  72
+  [p q]
71 73
   (bind p (fn [_] q)))
72 74
 
73 75
 (defmacro defparser
@@ -78,7 +80,7 @@
78 80
   `(defn ~name ~args
79 81
      (fn [state# cok# cerr# eok# eerr#]
80 82
        (let [p# (>> ~@body)]
81  
-         (p# state# cok# cerr# eok# eerr#)))))
  83
+         (Cont. #(p# state# cok# cerr# eok# eerr#))))))
82 84
 
83 85
 (defmacro >>
84 86
   "Expands into nested nxt forms"
@@ -100,7 +102,7 @@
100 102
   "A parser that always fails, consuming no input"
101 103
   []
102 104
   (fn [state cok cerr eok eerr]
103  
-    (eerr (unknown-error state))))
  105
+    (Cont. #(eerr (unknown-error state)))))
104 106
 
105 107
 (defn either
106 108
   "A parser that tries p, upon success, returning its value, and upon
@@ -109,16 +111,16 @@
109 111
   (fn [state cok cerr eok eerr]
110 112
     (letfn [(peerr [err-from-p]
111 113
               (letfn [(qeerr [err-from-q]
112  
-                        (eerr (merge-errors err-from-p err-from-q)))]
113  
-                (q state cok cerr eok qeerr)))]
114  
-      (p state cok cerr eok peerr))))
  114
+                        (Cont. #(eerr (merge-errors err-from-p err-from-q))))]
  115
+                (Cont. #(q state cok cerr eok qeerr))))]
  116
+      (Cont. #(p state cok cerr eok peerr)))))
115 117
 
116 118
 (defn attempt
117 119
   "A parser that will attempt to parse p, and upon failure never
118  
-   consume any input"  
  120
+   consume any input"
119 121
   [p]
120 122
   (fn [state cok cerr eok eerr]
121  
-    (p state cok eerr eok eerr)))
  123
+    (Cont. #(p state cok eerr eok eerr))))
122 124
 
123 125
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
124 126
 ;; token
@@ -130,9 +132,9 @@
130 132
   (fn [{:keys [input pos] :as state} cok cerr eok eerr]
131 133
     (if-let [tok (first input)]
132 134
       (if (consume? tok)
133  
-        (cok tok (InputState. (rest input) (inc-sourcepos pos tok)))
134  
-        (eerr (unexpect-error (str "token '" tok "'") pos)))
135  
-      (eerr (unexpect-error "end of input" pos)))))
  135
+        (Cont. #(cok tok (InputState. (rest input) (inc-sourcepos pos tok))))
  136
+        (Cont. #(eerr (unexpect-error (str "token '" tok "'") pos))))
  137
+      (Cont. #(eerr (unexpect-error "end of input" pos))))))
136 138
 
137 139
 (defn many
138 140
   "Consume zero or more p. A RuntimeException will be thrown if this
@@ -158,11 +160,11 @@
158 160
       (letfn [(pcok [item state]
159 161
                 (let [q (times (dec n) p)]
160 162
                   (letfn [(qcok [items state]
161  
-                            (cok (cons item items) state))]
162  
-                    (q state qcok cerr qcok eerr))))
  163
+                            (Cont. #(cok (cons item items) state)))]
  164
+                    (Cont. #(q state qcok cerr qcok eerr)))))
163 165
               (peok [item state]
164  
-                (eok (repeat n item) state))]
165  
-        (p state pcok cerr peok eerr)))))
  166
+                (Cont. #(eok (repeat n item) state)))]
  167
+        (Cont. #(p state pcok cerr peok eerr))))))
166 168
 
167 169
 (defn lookahead
168 170
   "A parser that upon success consumes no input, but returns what was
@@ -170,8 +172,8 @@
170 172
   [p]
171 173
   (fn [state cok cerr eok eerr]
172 174
     (letfn [(ok [item _]
173  
-              (eok item state))]
174  
-      (p state ok cerr eok eerr))))
  175
+              (Cont. #(eok item state)))]
  176
+      (Cont. #(p state ok cerr eok eerr)))))
175 177
 
176 178
 (defn choice
177 179
   "A varargs version of either that tries each given parser in turn,
@@ -189,8 +191,8 @@
189 191
   []
190 192
   (fn [{:keys [input pos] :as state} cok cerr eok eerr]
191 193
     (if (empty? input)
192  
-      (eok nil state)
193  
-      (eerr (expect-error "end of input" pos)))))
  194
+      (Cont. #(eok nil state))
  195
+      (Cont. #(eerr (expect-error "end of input" pos))))))
194 196
 
195 197
 (defn char
196 198
   "Consume the given character"
@@ -249,7 +251,9 @@
249 251
    in a RuntimeException and thrown, and if the parser succeeds, its
250 252
    value is returned"
251 253
   [p input]
252  
-  (let [result (run-parser p (InputState. input (SourcePos. 1 1)))]
253  
-    (condp = (class result)
254  
-      Ok (:item result)
255  
-      Err (throw (RuntimeException. (:errmsg result))))))
  254
+  (let [state (InputState. input (SourcePos. 1 1))]
  255
+    (loop [result (run-parser p state)]
  256
+      (condp = (class result)
  257
+        Cont (recur ((:fn result)))
  258
+        Ok (:item result)
  259
+        Err (throw (RuntimeException. (:errmsg result)))))))
Commit_comment_tip

Tip: You can add notes to lines in a file. Hover to the left of a line to make a note

Something went wrong with that request. Please try again.