kleene.clj

(ns kleene)

;;
;; Inspired by "Regexes, Kleene Algebras and Real Ultimate Power"
;; http://plastic-idolatry.com/erik/oslo2014.pdf
;;
;; What do we want to do?...
;;
;; (def p1 (times (Var. "w") (Var. "o") (Var. "w"))
;; (matches? p1 "wow") ;; true
;;
;; (def p2 (times (Var. "w") (kplus (Var. "o")) (Var. "w"))
;; (matches? p2 "woooooow") ;; true
;;
;; (def p3 (times (Var. "w") (Var. "o") (Var. "o") (plus (Var. "w") (Var. "d"))))
;; (matches? p3 "wood") ;; true
;;

(defrecord Nul [])
(defrecord Empty [])
(defrecord Var [x])
(defrecord Or [x y])
(defrecord Then [x y])
(defrecord Star [x])

(defn zero [] (Nul.))

(defn one [] (Empty.))

(defn plus [x y]
  (let [cx (class x)
        cy (class y)]
    (cond
     (= Nul cx) y
     (= Nul cy) x
     (and (= Empty cx) (= Empty cy)) (one)
     (and (= Empty cx) (= Star cy)) y
     (and (= Star cx) (= Empty cy)) x
     :else (Or. x y))))

(defn times
  ([x y] (let [cx (class x)
               cy (class y)]
           (cond
            (= Nul cx) (zero)
            (= Nul cy) (zero)
            (= Empty cx) y
            (= Empty cy) x
            :else (Then. x y))))
  ([x y & args]
     (reduce times (concat [x y] args))))

(defmulti kstar class)
(defmethod kstar Nul [_] (one))
(defmethod kstar Empty [_] (one))
(defmethod kstar Star [expr] (kstar (:x expr)))
(defmethod kstar :default [expr] (Star. expr))

(defn kplus [x] (Then. x (kstar x)))

(defn fits? [pos a input]
  (and (< pos (count input))
       (= a (str (get input pos)))))

(defmulti look (fn [expr _ _] (class expr)))

(defmethod look Nul [_ _ _] '())

(defmethod look Empty [_ _ pos] '(pos))

(defmethod look Var [expr input pos]
  (if (fits? pos (:x expr) input) (list (inc pos)) '()))

(defmethod look Or [{:keys [x y]} input pos]
  (lazy-cat (look x input pos)
            (look y input pos)))

(defmethod look Then [{:keys [x y]} input pos]
  (mapcat #(look y input %)
          (look x input pos)))

(defmethod look Star [expr input pos]
  (cons pos (mapcat #(look expr input %)
                    (look (:x expr) input pos))))

(defn matches? [expr input]
  (let [len (count input)]
    (not= nil (some (partial = len) (look expr input 0)))))

;;
;; How to use?
;;

;; wo*(w|t)
(def p (times
        (Var. "w")
        (kplus (Var. "o"))
        (plus (Var. "w") (Var. "t"))))

(matches? p "woot") ;; true
(matches? p "wooow") ;; true
(matches? p "wood") ;; false

;;
;; Higher level
;; 

(defn string [s]
  (if (= 1 (count s))
    (Var. s)
    (apply times (map #(Var. (str %)) s))))

(matches? (string "wow") "wow") ;; true
(matches? (string "wow") "wow such kleene") ;; false