pparse.clj

(defn psuccess [v p] (fn [t f] (t v p)))
(defn pfailure [p] (fn [t f] (f p)))

(def pfail (fn [s p] (pfailure p)))
(defn preturn [v] (fn [s p] (psuccess v p)))
(defn pbind [t uf] (fn [s p] ((t s p)
  (fn [tv tp] ((uf tv) s tp))
  (fn [tp] (pfailure tp)))))
(defn pmap [t m] (pbind
  t
  (fn [tv] (preturn (m tv))))
)
(def peos (fn [s p] (if (>= p (count s)) (psuccess nil p) (pfailure p))))
(def pchar (fn [s p] (if (< p (count s)) (psuccess (get s p) (+ p 1)) (pfailure p))))
(def ppos (fn [s p] (psuccess p p)))
(defn psat [f] (pbind
  pchar
  (fn [tv] (if (f tv) (preturn tv) pfail)))
)
(defn por [t u] (fn [s p] ((t s p)
  (fn [tv tp] (psuccess tv tp))
  (fn [tp] (u s p))
)))
(defn pdebug [n t] (fn [s p]
  (println "BEFORE - " n)
  ((t s p)
    (fn [tv tp]
      (println "SUCCESS - " n " - " tp " - " tv)
      (psuccess tv tp)
    )
    (fn [tp]
      (println "FAILURE - " n " - " tp)
      (pfailure tp)
    )
  )
))
(defn pmany [t] (fn [s p]
  (defn inner [tvs cp]
    ((t s cp)
      (fn [tv tp] (inner (cons tv tvs) tp))
      (fn [tp] (psuccess (reverse tvs) cp))
    )
  )
  (inner nil p)
))
(defn pmany1 [t]
  (pbind t (fn [tv]
    (pbind (pmany t) (fn [tvs]
      (preturn (conj tvs tv)))
    ))
  )
)

(defn parse [p s] ((p s 0)
  (fn [v p] {:position p :value v})
  (fn [p] {:position p}))
)

(def peq (psat (fn [c] (= \= c))))
(def pdigit (psat (fn [c] (java.lang.Character/isDigit c))))
(def pletter (psat (fn [c] (java.lang.Character/isLetter c))))
(def pdigits (pmany pdigit))
(def pletter (psat (fn [c] (java.lang.Character/isLetter c))))
(def pletters1 (pmany1 pletter))

(def presult (parse pletters1 "hello"))
(def presult (parse peq "="))
;(def presult (parse pdigits "123"))
;(parse pddigit "123")
;(parse (pbind (preturn 123) (fn [v] (preturn (+ v 456)))) "")
;(parse pchar "123")
;(parse (psat (fn [c] false)) "123")
;(parse pdigits "123")
(println "Result" presult)