parser

gistfile1.clj

(ns veyemel)
; ref http://www.cs.nott.ac.uk/~gmh/pearl.pdf

(defn return [v]
  (fn [s]
    [{:result v
      :remaining s}]))

(def fail (fn [_] []))

(defn item [s]
  (if (empty? s)
    []
    [{:result (first s)
      :remaining (rest s)}]))

(defn bind [p f]
  (fn [s]
    (mapcat (fn [m] ((f (:result m)) (:remaining m))) (p s))))

(defmacro chain 
  ([p b & rst]
  `(bind ~p (fn [~b]
              (chain ~@rst))))
  ([_ _] (throw "chain Needs an odd number of args!"))
  ([f] f))

(defn sat [p]
  (chain
    item ch
    (if (p ch) (return ch) fail)))

(defn cha [c]
  (sat #(= % c)))

(defn ++ [& ps]
  (fn [s] (mapcat #(% s) ps)))

(defn +++ [& ps]
  (fn [s]
    (let [result (mapcat #(% s) ps)]
      (if (empty? result) [] [(first result)]))))

(def open-paren (cha \())
(def close-paren (cha \)))
(defn many [p]
  (+++
    (many1 p)
    (return [])))

(defn many1 [p]
  (chain
    p fst
    (many p) rst
    (return (cons fst rst))))

(def alphabetic (sat #(<= (int \a) (int %) (int \z))))

(def atm
  (chain
    (many1 alphabetic) token
    clear _
    (return (apply str token))))

(def whitespace? #{\space \newline \tab \,})
(def clear (many (sat whitespace?)))

(def form 
  (+++
    atm
    (chain
      open-paren  _
      (many form) forms
      close-paren _
      (return forms))))

(prn
  (form
   "(foo bar (baz))"))
 ; -> [{:remaining (), :result ("foo" "bar" ("baz"))}]