Migration to protocol-monads

Author: Roman Gonzalez & Tatsuhiro Ujihisa

.gitignore

@@ -1,4 +1,5 @@
 /pom.xml
+/pom.xml.asc
 *jar
 /lib
 /classes

project.clj

@@ -6,7 +6,9 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.5.1"]
-                 [org.clojure/algo.monads "0.1.4"]]
+                 [net.clojure/monads "1.0.3-SNAPSHOT"]
+                 [org.clojure/algo.monads "0.1.4"]
+                 ]
   :dev-dependencies [[lein-autodoc "0.9.0"]
                      [marginalia "0.7.0-SNAPSHOT"]
                      [lein-marginalia "0.7.0-SNAPSHOT"]])

src/zetta/combinators.clj

@@ -1,8 +1,7 @@
 (ns zetta.combinators
   (:refer-clojure :exclude [replicate])
-  (:require [clojure.core :as core])
-  (:use [clojure.algo.monads :only [m-seq]])
-
+  (:require [clojure.core :as core]
+            [monads.core :as monad])
   (:use zetta.core))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -40,8 +39,7 @@
 (defn replicate
   "Apply the given parser 'p' 'n' times, returning every result."
   [n p]
-  (with-parser
-    (m-seq (core/replicate n p))))
+  (monad/seq (core/replicate n p)))
 
 (defn option
   "Applies parser p to the input, if p fails then default-val is returned."
@@ -94,4 +92,3 @@
   "Skip one or more applications of parser p."
   [p]
   (*> p (skip-many p)))
-

src/zetta/core.clj

@@ -1,7 +1,10 @@
 (ns zetta.core
-  (:use [clojure.algo.monads
-         :only
-         [defmonad defmonadfn domonad with-monad m-seq]]))
+  (:require [monads.macros :as monad-macro])
+  (:require [monads.core :as monad]
+            [clojure.algo.monads
+             :refer
+             [defmonad defmonadfn domonad with-monad m-seq]])
+  ^:clj (:import [clojure.lang IFn]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -99,6 +102,45 @@
   [input0 more0 input1 more1 f]
   (f (concat input0 input1) (concat-more more0 more1)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; ## Parser Monad implementation
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare always)
+(declare bind-parsers)
+(declare fail-parser)
+(declare join-parsers)
+
+(defrecord Parser [f]
+  IFn
+  ;; (invoke [this_ a] (println "1) ERROR: " a))
+  ;; (invoke [this_ a b] (println "2)ERROR: " a b))
+  ;; (invoke [this_ a b c] (println "3) ERROR: " a b c))
+  (invoke [this_ input0 more0 err-fn ok-fn]
+    ;; (println "4)" input0 more0 err-fn ok-fn)
+    (f input0 more0 err-fn ok-fn))
+
+  ^:clj
+  (applyTo [this args] (clojure.lang.AFn/applyToHelper this args))
+
+  monad/Monad
+  (do-result [self a]
+    (always a))
+
+  (bind [self f]
+    (bind-parsers self f))
+
+  monad/MonadZero
+  (zero [_]
+    (fail-parser "MonadZero/zero"))
+
+  (plus-step [self ps]
+    (reduce join-parsers self ps)))
+
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; ## Basic parsers primitives
@@ -120,15 +162,17 @@
   "Parser that will always fail, you may provide an error message msg that
   will be shown on the final result."
   [msg]
-  (fn failed-parser [input0 more0 err-fn _ok-fn]
-    #(err-fn input0 more0 [] (str "Failed reading: " msg))))
+  (Parser.
+   (fn failed-parser [input0 more0 err-fn _ok-fn]
+     #(err-fn input0 more0 [] (str "Failed reading: " msg)))))
 
 (defn always
   "Returns a parser that will always succeed, this parser will return the
   parameter given."
   [a]
-  (fn new-parser [input0 more0 err-fn ok-fn]
-    #(ok-fn input0 more0 a)))
+  (Parser.
+   (fn new-parser [input0 more0 _err-fn ok-fn]
+     #(ok-fn input0 more0 a))))
 
 (defn bind-parsers
   "Receives a parser and a continuation function, the result of the parser is
@@ -141,10 +185,11 @@
     (bind-parsers (char \\a) (fn [achr] (always \"hello\")))
   "
   [p f]
-  (fn parser-continuation [input0 more0 err-fn ok-fn0]
-    (letfn [
-      (ok-fn [input1 more1 a] ((f a) input1 more1 err-fn ok-fn0))]
-      (p input0 more0 err-fn ok-fn))))
+  (Parser.
+   (fn parser-continuation [input0 more0 err-fn ok-fn0]
+     (letfn [(ok-fn [input1 more1 a]
+               ((f a) input1 more1 err-fn ok-fn0))]
+       (p input0 more0 err-fn ok-fn)))))
 
 (defn join-parsers
   "Merges two parsers together and returns a new parser that will execute
@@ -156,36 +201,23 @@
     (join-parsers (char \\a) (char \\b))
   "
   [p1 p2]
-  (fn m-plus-parser [input0 more0 err-fn0 ok-fn]
-                 (letfn [
-                   (err-fn [input1 more1 _ _]
-                     (p2 input1 more1 err-fn0 ok-fn))]
-                 (p1 input0 more0 err-fn ok-fn))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; ## Parser Monad implementation
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmonad parser-m
-  [ m-result (fn result-fn [a]
-               (always a))
-
-    m-bind   (fn bind-fn [p f]
-               (bind-parsers p f))
-
-    m-zero   (fail-parser "m-zero")
-
-    m-plus   (fn m-plus-fn [p1 p2]
-               (join-parsers p1 p2))])
+  (Parser.
+   (fn m-plus-parser [input0 more0 err-fn0 ok-fn]
+     (letfn [
+             (err-fn [input1 more1 _ _]
+               (p2 input1 more1 err-fn0 ok-fn))]
+       (p1 input0 more0 err-fn ok-fn)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; ## Parser building macros
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(def parser-monad always)
+(def dummy-parser (parser-monad nil))
+
+;; TODO: How do we translate this to ProtocolMonads?
 (defmacro with-parser
   "Allows the use of monadic functions m-bind and m-result which are
   binded to the parser-m monad."
@@ -196,7 +228,7 @@
   "Allows the use of 'domonad' statements with the m-bind and m-result
   functions binded to the parser-m monad."
   [steps result]
-  `(domonad parser-m ~steps ~result))
+  `(monad-macro/do always ~steps ~result))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -216,16 +248,17 @@
   [input0 _more0 result]
   (ResultDone. input0 result))
 
-(defn prompt
+(def prompt
   "This is parser is used to return continuations (when there is not
   enough input available for the parser to either succeed or fail)."
-  [input0 _more0 err-fn ok-fn]
-  (with-meta
-    (fn [new-input]
-      (if (empty? new-input)
-        (p-trampoline err-fn input0 complete)
-        (p-trampoline ok-fn (concat input0 (seq new-input)) incomplete)))
-    {:stop true}))
+  (Parser.
+   (fn prompt [input0 _more0 err-fn ok-fn]
+     (with-meta
+       (fn [new-input]
+         (if (empty? new-input)
+           (p-trampoline err-fn input0 complete)
+           (p-trampoline ok-fn (concat input0 (seq new-input)) incomplete)))
+       {:stop true}))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -302,9 +335,10 @@
 
   Where `number` is a parser that will return a number from the parsed input."
   [f & more]
-  (with-parser
-    (m-bind (m-seq more) (fn [params]
-    (m-result (apply f params))))))
+  (bind-parsers
+   (monad/seq always more)
+   (fn [params]
+     (always (apply f params)))))
 
 (def <|>
   "Alias for join-parsers function."

src/zetta/parser/seq.clj

@@ -2,10 +2,11 @@
   (:refer-clojure
    :exclude [ensure get take take-while char some replicate])
   (:require [clojure.core :as core]
-            [clojure.string :as str])
-
+            [clojure.string :as str]
+            [monads.core :as monad])
   (:use zetta.core)
-  (:use zetta.combinators))
+  (:use zetta.combinators)
+  (:import [zetta.core Parser]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -25,49 +26,53 @@
 
 (def demand-input
   "Basic parser that will ensure the request of more input via a continuation."
-  (fn [input0 more0 err-fn0 ok-fn0]
-    (if (complete? more0)
-      #(err-fn0 input0 more0 ["demand-input"] "not enough input")
-      (letfn [
-        (err-fn [input more]
-          #(err-fn0 input more ["demand-input"] "not enough input"))
-        (ok-fn [input more]
-          #(ok-fn0 input more nil))]
-      (prompt input0 more0 err-fn ok-fn)))))
+  (Parser.
+   (fn [input0 more0 err-fn0 ok-fn0]
+     (if (complete? more0)
+       #(err-fn0 input0 more0 ["demand-input"] "not enough input")
+       (letfn [
+               (err-fn [input more]
+                 #(err-fn0 input more ["demand-input"] "not enough input"))
+               (ok-fn [input more]
+                 #(ok-fn0 input more nil))]
+         (prompt input0 more0 err-fn ok-fn))))))
 
 (def want-input?
   "Parser that returns `true` if any input is available either immediately or
   on demand, and `false` if the end of all input has been reached.
 
   **WARNING**: This parser always succeeds."
-  (fn [input0 more0 _err-fn ok-fn0]
-    (cond
+  (Parser.
+   (fn [input0 more0 _err-fn ok-fn0]
+     (cond
       (not (empty? input0)) #(ok-fn0 input0 more0 true)
       (complete? more0) #(ok-fn0 input0 more0 false)
       :else
-        (letfn [(err-fn [input more] #(ok-fn0 input more false))
-                (ok-fn [input more] #(ok-fn0 input more true))]
-        (prompt input0 more0 err-fn ok-fn)))))
+      (letfn [(err-fn [input more] #(ok-fn0 input more false))
+              (ok-fn [input more] #(ok-fn0 input more true))]
+        (prompt input0 more0 err-fn ok-fn))))))
 
 (defn ensure
   "If at least `n` items of input are available, return the current input,
   otherwise fail."
   [n]
-  (fn [input0 more0 err-fn ok-fn]
-    (if (>= (count input0) n)
-      #(ok-fn input0 more0 input0)
-      (with-parser
-        ((>> demand-input (ensure n)) input0 more0 err-fn ok-fn)))))
+  (Parser.
+   (fn [input0 more0 err-fn ok-fn]
+     (if (>= (count input0) n)
+       #(ok-fn input0 more0 input0)
+       ((>> demand-input (ensure n)) input0 more0 err-fn ok-fn)))))
 
 (def get
   "Returns the input given in the `zetta.core/parse` function."
-  (fn [input0 more0 _err-fn ok-fn]
-    #(ok-fn input0 more0 input0)))
+  (Parser.
+   (fn [input0 more0 _err-fn ok-fn]
+     #(ok-fn input0 more0 input0))))
 
 (defn put [s]
   "Sets a (possibly modified) input into the parser state."
-  (fn [_input0 more0 _err-fn ok-fn]
-    #(ok-fn s more0 nil)))
+  (Parser.
+   (fn [_input0 more0 _err-fn ok-fn]
+     #(ok-fn s more0 nil))))
 
 (defn satisfy?
   "Parser that succeeds for any item for which the predicate `pred` returns
@@ -172,7 +177,7 @@
                :then [result (take-while-loop (conj acc pre))]
                :else [result (always (conj acc pre))]
            ]
-           :else [result (m-result (conj acc pre))]]
+           :else [result (monad/do-result dummy-parser (conj acc pre))]]
            result))]
   (<$> (comp #(apply core/concat %) core/reverse)
        (take-while-loop []))))
@@ -334,21 +339,22 @@
 (def end-of-input
   "Parser that matches only when the end-of-input has been reached, otherwise
   it fails. Returns a nil value."
-  (fn [input0 more0 err-fn0 ok-fn0]
-    (if (empty? input0)
-      (if (complete? more0)
-        #(ok-fn0 input0 more0 nil)
-        (letfn [
-          (err-fn [input1 more1 _ _]
-            (add-parser-stream input0 more0 input1 more1
-                               (fn [input2 more2]
-                                  (ok-fn0 input2 more2 nil))))
-          (ok-fn [input1 more1 _]
-            (add-parser-stream input0 more0 input1 more1
-                               (fn [input2 more2]
-                                  (err-fn input2 more2 [] "end-of-input"))))]
-        (demand-input input0 more0 err-fn ok-fn)))
-      #(err-fn0 input0 more0 [] "end-of-input"))))
+  (Parser.
+   (fn [input0 more0 err-fn0 ok-fn0]
+     (if (empty? input0)
+       (if (complete? more0)
+         #(ok-fn0 input0 more0 nil)
+         (letfn [
+                 (err-fn [input1 more1 _ _]
+                   (add-parser-stream input0 more0 input1 more1
+                                      (fn [input2 more2]
+                                        (ok-fn0 input2 more2 nil))))
+                 (ok-fn [input1 more1 _]
+                   (add-parser-stream input0 more0 input1 more1
+                                      (fn [input2 more2]
+                                        (err-fn input2 more2 [] "end-of-input"))))]
+           (demand-input input0 more0 err-fn ok-fn)))
+       #(err-fn0 input0 more0 [] "end-of-input")))))
 
 (def at-end?
   "Parser that never fails, it returns `true` when the end-of-input
@@ -360,5 +366,3 @@
   This parser returns a nil value."
   (<|> (*> (char \newline) (always nil))
        (*> (string "\r\n") (always nil))))
-
-