.

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
 ;