Permalink
Browse files

.

  • Loading branch information...
1 parent 3807f4b commit 294ca64d1363c6a487e8f3085ed2c8d0b6efd9cb @richard-lyman committed Dec 30, 2011
Showing with 31 additions and 15 deletions.
  1. +31 −15 src/com/lithinos/amotoen/core.clj
@@ -17,6 +17,7 @@
(sp [t j] "Set pos") ; E.V.I.L. ... maybe
(in [t] "Indent - for debugging")
(de [t] "Dedent - for debugging")
+ (end [t] "End of input")
(m [t] "Returns the 'c' then (inc pos)")
(c [t] "The character at pos"))
(defn gen-ps
@@ -25,19 +26,21 @@
(let [j (ref j)
indent (ref 0)]
(reify IPosition
- (psdebug [t] (str (if (< @j 0)
- (str "<-" (subs s 0 20))
- (str "'" (subs s (max 0 (- @j 30)) (max 0 @j)) "'"
- " " (c t) " "
- "'" (subs s (inc @j) (min (+ @j 30) (count s))) "'"))
- (apply str (take @indent (repeat " ")))))
+ (psdebug [t]
+ (let [indent-string (apply str (take @indent (repeat " ")))
+ padding (apply str (take 60 (repeat " ")))
+ x (str "'" (pr-str (subs s (max 0 (- @j 30)) (max 0 @j))) "'")
+ y (str " " (pr-str (c t)) " ")
+ z (str "'" (pr-str (subs s (inc @j) (min (+ @j 30) (count s)))) "'")]
+ (str (subs (str (if (< @j 0) (str "<-" (subs s 0 20)) (str x y z)) padding) 0 60) indent-string)))
(in [t] (dosync (alter indent inc)))
(de [t] (dosync (alter indent dec)))
(gp [t] @j)
(sp [t k] (dosync (ref-set j k)))
(clone [t] (gen-ps s @j))
+ (end [t] (= @j (count s)))
(m [t] (let [r (c t)] (dosync (alter j inc)) r))
- (c [t] (.charAt s @j))))))
+ (c [t] (try (.charAt s @j) (catch Exception e nil)))))))
(defn lpegs [t s] (reverse (into '() (cons t (seq s))))) ; This doesn't need to be fast, but shouldn't the following work? (list (cons t (seq s)))
(defn pegs [s] (vec (seq s)))
@@ -92,19 +95,29 @@
(defn- type-list [n g w]
(let [t (first n)
b (second n)]
- (cond (= t '|) (let [temp (either n g w)] (debug w "Either returning:" temp) temp)
+ (cond (= t '|) (let [temp (either n g w)] (debug w "Either returning:" (pr-str temp)) temp)
(= t '*) (list (doall (take-while #(if (keyword? b) (b %) %)
(repeatedly #(pegasus b g w)))))
(= t '?) (pegasus b g w)
- ; If we succeed, then we fail - that's the point of AnyNot... If we fail, then we accept the current char
- (= t '%) (let [c (c w)] (if (pegasus b g w) nil (do (debug w "AnyNot MATCH:" (pr-str b)) (m w) c) )))))
+ (= t '%) (let [c (c w)
+ p (gp w)]
+ (if (pegasus b g w)
+ (do ; If we succeed, then we fail - that's the point of AnyNot...
+ (sp w p) ; Don't forget 'rollback'
+ nil)
+ (do ; If we fail, then we accept the current char
+ (debug w "AnyNot MATCH:" (pr-str b))
+ (m w)
+ c))))))
(defn- try-char [n w]
(if (= n (c w))
(do
- (debug w (str "MATCH: '" (pr-str n) "' with '" (c w) "'"))
+ (debug w (str "MATCH: '" (pr-str n) "' with '" (pr-str (c w)) "'"))
(m w))
- nil))
+ (do
+ (debug w (str "FAIL: '" (pr-str n) "' with '" (pr-str (c w)) "'"))
+ nil)))
(defn- peg-vec [n g w]
(loop [remaining n
@@ -134,9 +147,11 @@
([g] (validate g false))
([g d]
(dosync (ref-set *debug* d))
- (if (nil? (pegasus :Grammar grammar-grammar (gen-ps (pr-str g))))
- (println "Fail")
- (println "Pass"))
+ (let [w (gen-ps (pr-str g))]
+ (if (or (nil? (pegasus :Grammar grammar-grammar w))
+ (not (end w)))
+ (println "Fail")
+ (println "Pass")))
(dosync (ref-set *debug* false))))
(defn self-check [] (validate grammar-grammar))
@@ -145,5 +160,6 @@
; TODO
;
; If pegasus is given a keyword, but it doesn't exist in the given grammar, a useful error should be thrown
+; Allow debug to accept a 'limit' - if 0 then always dump everything. If more than 0, only keep limit number of lines of debug and print out at end
;

0 comments on commit 294ca64

Please sign in to comment.