Well, I just find out there was an obvious bug in the code I posted
previously. Here's the correct expand-parser-body:
(defn- expand-parser-body [body s]
(let [rec (fn [r p xs]
`(let [~r (~p ~s) ~s (second (first ~r))]
(if (= 0 (count ~r)) ~r
~(expand-parser-body xs s))))]
(match body
(_ '<- _) (parser-error)
(p) (list p s)
(v '<- p & xs) (rec v p xs)
(p & xs) (rec (gensym 'r) p xs))))
So now we can do this:
user=> ((parser a <- (pchar \t) (result a)) "test")
([([\t "est"]) "est"])
And the 'string' combinator can be simply written like that:
(defn string [s]
(if (= 0 (count s)) (result "")
(let [[x xs] (split s)]
(parser (pchar x)
(string xs)
(result (join x xs))))))
On Aug 29, 4:09 pm, budu <[EMAIL PROTECTED]> wrote:
> Thank you very much! Your trick worked and it even made me realize
> that the match-forms function is not even required. I've replaced it
> by a much more simple is-match? function and completely overhauled the
> match macro.
>
> Here's the new code with your corrections, some other improvements and
> an example of how I intend to use it:
>
> (defn result [v] #(list [v %]))
>
> (def zero (fn [s] ()))
>
> (def item
> #(cond (= 0 (. % length)) ()
> true (list [(. % (charAt 0))
> (. % (substring 1))])))
>
> (defn bind [p f]
> (fn [s]
> (let [r (p s)]
> (if (= 0 (count r)) r
> (mapcat #(let [[v s] %] ((f v) s)) r)))))
>
> (defn sat [p]
> (bind item #(if (p %) (result %) zero)))
>
> (defn pchar [c] (sat #(= % c)))
>
> (defn is-match? [p t]
> (if (and (seq? p) (= 'quote (first p)))
> (= t (second p))
> (symbol? p)))
>
> (defmacro match [value & clauses]
> (when (and clauses (= 0 (rem (count clauses) 2)))
> (let [[c1 c2 & cr] clauses
> only-sym #(or (not (symbol? %)) (= '_ %))
> syms (map #(if (only-sym %) (gensym) %) c1)]
> `(if (and (every? identity (map is-match? '~c1 ~value))
> (or (some (fn [x#] (= '& x#)) '~c1)
> (= (count '~c1) (count ~value))))
> (if (= 0 (count '~syms)) false
> (let [~(vec syms) ~value] ~c2))
> (match ~value [EMAIL PROTECTED])))))
>
> (defn- parser-error []
> (new Exception "Parser must end with non-binding form."))
>
> (defn- expand-parser-body [body s]
> (let [rec (fn [p xs]
> `(let [r# (~p ~s) ~s (second (first r#))]
> (if (= 0 (count r#)) r#
> ~(expand-parser-body xs s))))]
> (match body
> (_ '<- _) (parser-error)
> (p) (list p s)
> (v '<- p & xs) (rec p xs)
> (p & xs) (rec p xs))))
>
> (defmacro parser [& body]
> (let [s (gensym 's)]
> `(fn [~s] ~(expand-parser-body body s))))
>
> (defn split [s]
> (if (= 0 (count s)) []
> [(. s (charAt 0))
> (. s (substring 1 (count s)))]))
>
> (defn join [c s]
> (. String (format "%c%s" (to-array [c s]))))
>
> ;; string :: String -> Parser String
> (defn string [s]
> (if (= 0 (count s)) (result "")
> (let [[x xs] (split s)]
> (parser _ <- (pchar x)
> _ <- (string xs)
> (result (join x xs))))))
>
> user=> ((string "hello") "hello world")
> (["hello" " world"])
>
> It's a straitforward implementation of the parser combinators
> described in the "Monadic Parser Combinators" papers by Hutton and
> Meijer.
>
> Thanks again!!!
>
> On Aug 26, 11:57 pm, Chouser <[EMAIL PROTECTED]> wrote:
>
> > On Sun, Aug 24, 2008 at 6:02 PM, budu <[EMAIL PROTECTED]> wrote:
>
> > > Well, for now only the value s used by the parser macro is really
> > > needed.
>
> > I think you misunderstood me, but I'm not too sure. Anyway, here's an
> > attempt:
>
> > (defn match-forms [p s]
> > (if (= '_ p) []
> > (loop [p p s s vars []]
> > (cond
> > (and (= 0 (count p)) (= 0 (count s))) vars
> > (= 0 (count s)) nil
> > :else (let [[fp & rp] p [fs & rs] s]
> > (cond
> > ;; wildcard pattern
> > (= '_ fp) (recur rp rs vars)
> > ;; rest
> > (and (symbol? fp) (= '& fp))
> > (conj vars (first rp) (conj rs fs))
> > ;; add variable to bindings
> > (symbol? fp) (recur rp rs (conj vars fp fs))
> > ;; match a symbol
> > (and (seq? fp) (= 'quote (first fp)))
> > (if (= fs (second fp)) (recur rp rs vars) nil)
> > ;; not matching
> > true nil))))))
>
> > (defmacro match [value & clauses]
> > (when (and clauses (= 0 (rem (count clauses) 2)))
> > (let [[c1 c2 & cr] clauses
> > syms (take-nth 2 (match-forms c1 c1))]
> > `(if-let m# (take-nth 2 (rest (match-forms '~c1 ~value)))
> > (let [~(vec syms) (vec m#)]
> > ~c2)
> > (match ~value [EMAIL PROTECTED])))))
>
> > The trick here is I run match-forms once at compile time to get the
> > list of symbols that will need to be bound, even though I don't have
> > the real values yet. I use that list to set up a "let" expression.
> > At runtime, I run match-forms again, but only take the values part and
> > drop that into the "let" that I set up at compile time.
>
> > That's probably not the best way to solve the problem, but it is *a*
> > way, and may help you find a more correct solution. ...and since I
> > don't really understand what you're trying to do, I had only limited
> > tests that I could try, so I've probably introduced some new bugs.
> > But at the very least, your original examples now work:
>
> > user=> (match '(1 2 3) (a b c) (list c b a))
> > (3 2 1)
> > user=> (let [z 4] (match '(1 2 3) (a b c) (list z c b a)))
> > (4 3 2 1)
>
> > --Chouser
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"Clojure" group.
To post to this group, send email to clojure@googlegroups.com
To unsubscribe from this group, send email to [EMAIL PROTECTED]
For more options, visit this group at
http://groups.google.com/group/clojure?hl=en
-~----------~----~----~----~------~----~------~--~---
