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 [email protected]
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
-~----------~----~----~----~------~----~------~--~---
