finally fixed all apparent bugs due to defrecord constructor change

src/edu/arizona/fnparse/cat.clj

@@ -3,6 +3,7 @@
             [clojure.contrib [monads :as m] [def :as d] [seq :as seq]
                              [core :as cljcore]]
             [clojure.template :as template])
+  (:import [edu.arizona.fnparse.core Success Failure])
   (:refer-clojure :rename {peek vec-peek}, :exclude #{for + mapcat find}))
 
 (defprotocol ABankable
@@ -12,13 +13,13 @@
 (defn- vary-bank [bankable f & args]
   (set-bank bankable (apply f (get-bank bankable) args)))
 
-(defrecord State [tokens position context] :as this
+(defrecord State [tokens position context]
   c/AState
-    (get-position [] position)
-    (get-remainder [] (drop position tokens))
+    (get-position [this] position)
+    (get-remainder [this] (drop position tokens))
   ABankable
-    (get-bank [] (meta this))
-    (set-bank [new-bank] (with-meta this new-bank)))
+    (get-bank [this] (meta this))
+    (set-bank [this new-bank] (with-meta this new-bank)))
 
 (defrecord Bank [memory lr-stack position-heads])
   ; memory: a nested map with function keys and map vals
@@ -32,22 +33,22 @@
     ; The keys correspond to token positions
     ; The vals correspond to LRNodes' indexes in the lr-stack
 
-(defrecord LRNode [seed rule head] :as this ABankable
-    (get-bank [] (meta this))
-    (set-bank [new-bank] (with-meta this new-bank)))
+(defrecord LRNode [seed rule head] ABankable
+  (get-bank [this] (meta this))
+  (set-bank [this new-bank] (with-meta this new-bank)))
 
 (defrecord Head [involved-rules rules-to-be-evaluated])
 
-(extend ::c/Success ABankable
+(extend Success ABankable
   {:get-bank (comp get-bank :state)
    :set-bank #(update-in %1 [:state] set-bank %2)})
 
-(extend ::c/Failure ABankable
+(extend Failure ABankable
   {:get-bank meta
    :set-bank with-meta})
 
 (defn make-state [input context]
-  (State. input 0 context (Bank {} [] {}) nil))
+  (State. input 0 context (Bank. {} [] {}) nil))
 
 (defn state?
   "Tests if the given object is a Hound State."
@@ -70,7 +71,7 @@
 
 (defn- make-failure [state descriptors]
   (set-bank
-    (c/Failure. (c/ParseError. (:position state) descriptors))
+    (c/make-failure (c/make-parse-error (:position state) descriptors))
     (get-bank state)))
 
 (c/defmaker prod
@@ -87,8 +88,8 @@
    :no-memoize? true}
   [product]
   (make-rule product-rule [state]
-    (c/Success. product state
-      (c/ParseError. (:position state) #{}))))
+    (c/make-success product state
+      (c/make-parse-error (:position state) #{}))))
 
 (defmacro defrm [& forms]
   `(d/defn-memo ~@forms))
@@ -123,7 +124,7 @@
    :error "An error with the given `message`."}
   [message]
   (make-rule with-error-rule [state]
-    (make-failure state #{(c/ErrorDescriptor. :message message)})))
+    (make-failure state #{(c/make-error-descriptor :message message)})))
 
 (c/defmaker only-when
   "Creates a maybe-failing rule—
@@ -221,7 +222,7 @@
             (recur new-bank)))))))
 
 (defn- add-head-if-not-already-there [head involved-rules]
-  (update-in (or head (Head #{} #{})) [:involved-rules]
+  (update-in (or head (Head. #{} #{})) [:involved-rules]
     into involved-rules))
 
 (defn- setup-lr [lr-stack stack-index]
@@ -279,7 +280,7 @@
         (let [bank (store-memory bank subrule state-position
                      (-> bank :lr-stack count))
               bank (update-in bank [:lr-stack] conj
-                     (LRNode nil subrule nil))
+                     (LRNode. nil subrule nil))
               state-0b (set-bank state bank)
               subresult (c/apply  state-0b subrule)
               bank (get-bank subresult)
@@ -446,9 +447,9 @@
             token (nth tokens position ::nothing)]
         (if (not= token ::nothing)
           (if-let [f-result (f token)]
-            (c/Success. (if pred-product? f-result token)
+            (c/make-success (if pred-product? f-result token)
               (assoc state :position (inc position))
-              (c/ParseError. position #{}))
+              (c/make-parse-error position #{}))
             (make-failure state #{}))
           (make-failure state #{}))))))
 
@@ -632,7 +633,7 @@
      (make-rule antipeek-rule [state]
        (let [result (c/apply state rule)]
          (if (c/failure? result)
-           (c/Success. true state (:error result))
+           (c/make-success true state (:error result))
            (c/apply state
              (if-let [message (when message-fn (message-fn (:product result)))]
                (with-error (message-fn (:product result)))
@@ -645,7 +646,7 @@
   Use the `phrase` function instead of this
   function when `f` is just `lit`."
   [f & token-colls]
-  #{:pre #{(ifn? f) (every? cljcore/seqable? token-colls)}}
+  {:pre #{(ifn? f) (every? cljcore/seqable? token-colls)}}
   (->> token-colls (apply map f) (apply cat)))
 
 (c/defmaker mapsum
@@ -654,6 +655,7 @@
   Use the `set-term` function instead of this
   function when `f` is just `lit`."
   [f & token-colls]
+  {:pre #{(ifn? f) (every? cljcore/seqable? token-colls)}}
   (->> token-colls (apply map f) (apply +)))
 
 (c/defmaker phrase
@@ -681,12 +683,13 @@
   {:pre #{(rule? prefix-rule) (rule? body-rule)}}
   (for [_ prefix-rule, content body-rule] content))
 
-(c/defmaker suffix [body-rule suffix-rule]
+(c/defmaker suffix
   "Creates a suffixed rule. Use when you want to
   concatenate two rules, but you don't care about
   the second rule's product.
   Its product is always the body-rule's product.
   A shortcut for `(for [content body-rule, _ suffix-rule] content)`."
+  [body-rule suffix-rule]
   {:pre #{(rule? suffix-rule) (rule? body-rule)}}
   (for [content body-rule, _ suffix-rule] content))
 
@@ -778,7 +781,7 @@
             (let [new-message (message-fn error)]
               (if new-message
                 (update-in error [:descriptors]
-                  conj (c/ErrorDescriptor. :message new-message))
+                  conj (c/make-error-descriptor :message new-message))
                 error)))]
     (make-rule error-annotation-rule [state]
       (let [reply (c/apply state rule)]

src/edu/arizona/fnparse/common.clj

@@ -27,5 +27,6 @@
   [descriptors label-str]
   {:pre #{(set? descriptors) (string? label-str)}}
   (let [descriptors (set/select #(not= (:kind %) :label) descriptors)
-        descriptors (conj descriptors (c/ErrorDescriptor. :label label-str))]
+        new-descriptor (c/make-error-descriptor :label label-str)
+        descriptors (conj descriptors new-descriptor)]
     descriptors))

src/edu/arizona/fnparse/core.clj

@@ -24,6 +24,9 @@
   text: A string. The text of the descriptor."}
   ErrorDescriptor [kind text])
 
+(defn make-error-descriptor [kind text]
+  (ErrorDescriptor. kind text))
+
 (defrecord
   #^{:doc "Represents FnParse errors.
   position: An integer. The position in the token
@@ -33,6 +36,9 @@
   ParseError
   [position descriptors])
 
+(defn make-parse-error [position descriptors]
+  (ParseError. position descriptors))
+
 (defprotocol AParseAnswer
   "The protocol of FnParse Answers: what
   FnParse rules must return. Answers must
@@ -51,11 +57,17 @@
 (defrecord Failure [error]
   AParseAnswer (answer-result [this] this))
 
+(defn make-success [product state error]
+  (Success. product state error))
+
+(defn make-failure [error]
+  (Failure. error))
+
 (temp/do-template [fn-name type-name doc-string]
   (defn fn-name doc-string [result]
     (-> result type (isa? type-name)))
-  failure? ::Failure "Is the given result a Failure?"
-  success? ::Success "Is the given result is a Success?")
+  failure? Failure "Is the given result a Failure?"
+  success? Success "Is the given result is a Success?")
 
 (defn apply
   "Applies the given rule to the given state."

src/edu/arizona/fnparse/hound.clj

@@ -10,14 +10,13 @@
 
 (declare make-state)
 
-(defrecord State [remainder position context] :as this
-  c/AState
-    (get-position [] (:position this))
-    (get-remainder [] (:remainder this))
-    (make-another-state [input context] (make-state input context)))
+(defrecord State [remainder position context] c/AState
+  (get-position [this] (:position this))
+  (get-remainder [this] (:remainder this))
+  (make-another-state [this input context] (make-state input context)))
 
-(defrecord Reply [tokens-consumed? result] :as this
-  c/AParseAnswer (answer-result [] (-> this :result force)))
+(defrecord Reply [tokens-consumed? result]
+  c/AParseAnswer (answer-result [this] (-> this :result force)))
 
 (defn make-state
   "Creates a state with the given remainder and context."
@@ -65,8 +64,8 @@
   [product]
   (make-rule prod-rule [state]
     (Reply. false
-      (c/Success. product state
-        (c/ParseError. (:position state) #{})))))
+      (c/make-success product state
+        (c/make-parse-error (:position state) #{})))))
 
 (c/defrule <emptiness>
   "The general emptiness rule. (Actually just `(prod nil)`)."
@@ -82,11 +81,11 @@
   ([state unexpected-token descriptors]
    {:pre #{(state? state) (set? descriptors)}}
    (Reply. false
-     (c/Failure
-       (c/ParseError. (:position state) descriptors)))))
+     (c/make-failure
+       (c/make-parse-error (:position state) descriptors)))))
 
 (d/defvar nothing-descriptors
-  #{(c/ErrorDescriptor. :label "absolutely nothing")}
+  #{(c/make-parse-error :label "absolutely nothing")}
   "The error descriptors that `<nothing>` uses.")
 
 (c/defrule <nothing>
@@ -110,7 +109,7 @@
   [message]
   {:pre #{(string? message)}}
   (make-rule with-error-rule [state]
-    (make-failed-reply state #{(c/ErrorDescriptor. :message message)})))
+    (make-failed-reply state #{(c/make-parse-error :message message)})))
 
 (c/defmaker only-when
   "Creates a maybe-failing rule—
@@ -366,10 +365,10 @@
             (if f-result
               (Reply. true
                 (delay
-                  (c/Success. (if pred-product? f-result first-token)
+                  (c/make-success (if pred-product? f-result first-token)
                     (assoc state :remainder (next remainder)
                                  :position (inc position))
-                    (c/ParseError. position #{}))))
+                    (c/make-parse-error position #{}))))
               (make-failed-reply state first-token #{})))
           (make-failed-reply state ::c/end-of-input #{}))))))
 
@@ -598,7 +597,7 @@
      (make-rule antipeek-rule [state]
        (let [result (-> state (c/apply rule) :result force)]
          (if (c/failure? result)
-           (Reply. false (c/Success. true state (:error result)))
+           (Reply. false (c/make-success true state (:error result)))
            (c/apply state
              (if-let [message (when message-fn (message-fn (:product result)))]
                (with-error (message-fn (:product result)))
@@ -701,7 +700,7 @@
   Use the `phrase` function instead of this
   function when `f` is just `lit`."
   [f & token-colls]
-  #{:pre #{(ifn? f) (every? cljcore/seqable? token-colls)}}
+  {:pre #{(ifn? f) (every? cljcore/seqable? token-colls)}}
   (->> token-colls (apply map f) (apply cat)))
 
 (c/defmaker mapsum
@@ -710,7 +709,7 @@
   Use the `set-term` function instead of this
   function when `f` is just `lit`."
   [f & token-colls]
-  #{:pre #{(ifn? f) (every? cljcore/seqable? token-colls)}}
+  {:pre #{(ifn? f) (every? cljcore/seqable? token-colls)}}
   (->> token-colls (apply map f) (apply +)))
 
 (c/defmaker phrase
@@ -738,12 +737,13 @@
   {:pre #{(rule? prefix-rule) (rule? body-rule)}}
   (for [_ prefix-rule, content body-rule] content))
 
-(c/defmaker suffix [body-rule suffix-rule]
+(c/defmaker suffix
   "Creates a suffixed rule. Use when you want to
   concatenate two rules, but you don't care about
   the second rule's product.
   Its product is always the body-rule's product.
   A shortcut for `(for [content body-rule, _ suffix-rule] content)`."
+  [body-rule suffix-rule]
   {:pre #{(rule? suffix-rule) (rule? body-rule)}}
   (for [content body-rule, _ suffix-rule] content))
 
@@ -854,7 +854,7 @@
                          new-message (message-fn error)]
                      (if new-message
                        (update-in forced-result [:error :descriptors]
-                         conj (c/ErrorDescriptor. :message new-message))
+                         conj (c/make-error-descriptor :message new-message))
                        forced-result))))]
     (make-rule error-annotation-rule [state]
       (let [reply (c/apply state rule)]

src/edu/arizona/fnparse/json.clj

@@ -41,7 +41,9 @@
 
 ; Define special value rules: true, false, and null.
 ; Again, I use `clojure.template/do-template` to reduce repetition.
-(do-template [rule-name tokens product]
+
+(def <true> (p/chook true (p/phrase "true")))
+#_(do-template [rule-name tokens product]
   (c/defrule rule-name
     "Padded on the front with optional whitespace."
     (p/prefix <ws?> (p/chook product (p/phrase tokens))))