Wishful Coding

Didn't you ever wish your
computer understood you?

Leiningen project-in-a-gist

Since I wrote a pattern matcher in under 50 lines of code, I do not feel like setting up an entire project for it, but I do want to use it in other projects and share it with you.

Those great folks at Github added git access to Gists a while back, and it turns out you can make Leiningen run in a flat structure with a few extra lines of project.clj.

This allows you to make cute mini projects with git access that can be installed and published and are embeddable and sharable.

Here is the project.clj from my pattern matcher, I also pushed the jar to clojars.

(defproject seqex "1.0.0-SNAPSHOT"
  :description "a tiny pattern matcher"
  :dependencies [[org.clojure/clojure "1.2.1"]]
  :source-path ""
  :aot [seqex]
  :omit-source true)

First we tell Leiningen that our :source-path is the root dir. The other 2 lines are a bit of a hack to make sure only seqex.clj gets into the jar, Otherwise you'll get conflicts and broken jars.

Published on

Clojure micro pattern matcher

Today I had some ideas for my game related to cellular automata that involved pattern matching. I googled, and found Matchure.

It might be a great pattern matcher, but the syntax and the amount of macro trickery makes me feel uncomfortable.

In an attempt to write one that relies only on functions, I made this.

Update: This is now a cute project-in-a-gist that can be used as a checkout dependency in Leiningen and Cake.

(ns seqex
  (:import [clojure.lang
            Fn
            IPersistentVector
            IPersistentMap]))

(defn cps [funct cont]
  (fn [[f & r]]
    (when-let [f (funct f)]
      (when-let [r (cont r)]
        (if (true? r)
          (if (true? f) [] [f])
          (if (true? f) r (cons f r)))))))
;    (and (funct f) (cont r))))

(def _ (constantly true))

(def end nil?)

(defmulti matcher type)

(defn match [pattern items]
  ((reduce #(cps (matcher %2) %1)
           (rseq pattern))
     items))

(defmethod matcher :default [l]
  (partial = l))

(defmethod matcher Fn [f] f)

(defmethod matcher IPersistentVector [pattern]
  (partial match pattern))

(defmethod matcher IPersistentMap [pattern]
  (fn [m]
    (every? identity
      (for [[k v] pattern]
        (when-let [mv (get m k)]
          ((matcher v) mv))))))

(defmethod matcher java.util.regex.Pattern [pattern]
  (partial re-find pattern)) ; returns match

(defn store [pattern]
  (fn [s]
    (when ((matcher pattern) s)
      s)))

(defmacro cond-let
  [& clauses]
    (when clauses
      (list `if-let (first clauses)
            (if (next clauses)
                (second clauses)
                (throw (IllegalArgumentException.
                         "cond-let requires an even number of forms")))
            (cons `cond-let (next (next clauses))))))
(match
 [1
  [3 _ end]
  {:a even?, :b #(= 2 (count %))}
  end]
 [1 [3 5] {:a 4, :b [1 2], :d :a}])
; [] (is truthy)

(match [1 2 3 _] [1 2 3 4 5 6 7 8])
; []

(let [[x y] (match
              [1 #"\w.+?\w" 3 (store _) end]
              [1 "foo bar"  3        4])]
  (dotimes [_ y] (println x)))
; foo
; foo
; foo
; foo
; nil
(defproject seqex "1.0.0-SNAPSHOT"
  :description "a tiny pattern matcher"
  :dependencies [[org.clojure/clojure "1.2.1"]]
  :source-path ""
  :aot [seqex]
  :omit-source true)

Published on

A new seque

I have used clojure.core/seque quite a bit lately, and I love it.

Creates a queued seq on another (presumably lazy) seq s. The queued
seq will produce a concrete seq in the background, and can get up to
n items ahead of the consumer. n-or-q can be an integer n buffer
size, or an instance of java.util.concurrent BlockingQueue. Note
that reading from a seque can block if the reader gets ahead of the
producer.
First I used it in Begame for decoupling the frame computation from the rendering. But for most games, this needs to work without the frames getting ahead of rendering.

This morning I wanted to make a lazy heapsort in one line, rather than with my own heap implementation.

That is when problems started to occur. While seque optionally takes a BlockingQueue as argument, it is not made to support exotic queues like SynchronousQueue(for Begame) and PriorityBlockingQueue(for heapsort), which do a bit more than just threading items through a queue.

Long story short, I submitted a bug report and wrote something that works for me.

Update: I'm not even sure It's possible anymore to write seque so that it works in all cases.

(ns test
  (:import [java.util.concurrent
            BlockingQueue
            LinkedBlockingQueue
            SynchronousQueue
            PriorityBlockingQueue
            CyclicBarrier])
  (:use clojure.test)
  (:refer-clojure :exclude [seque]))

;; some BlockingQueues are...
;; not ordered
;; not finite
;; unable to contain nil
;; without content
;; mutable
;; dropping or recieving extra items

;; seque...
;; fills the que on another thread
;; propagates errors
;; replaces nil with a sentinel
;; detects the end of the input seq
;; can be consumed on any thread

(defn seque
  "Creates a queued seq on another (presumably lazy) seq s. The queued
  seq will produce a concrete seq in the background, and can get up to
  n items ahead of the consumer. n-or-q can be an integer n buffer
  size, or an instance of java.util.concurrent BlockingQueue. Note
  that reading from a seque can block if the reader gets ahead of the
  producer."
  {:added "1.0"}
  ([s] (seque 100 s))
  ([n-or-q s]
   (let [^BlockingQueue q (if (instance? BlockingQueue n-or-q)
                             n-or-q
                             (LinkedBlockingQueue. (int n-or-q)))
         NIL (Object.) ;nil sentinel since BQ doesn't support nils
         s (map (fnil identity NIL) s)
         channel (LinkedBlockingQueue.)
         fill (fn fill [s]
                (try
                  (if (seq s)
                    (do
                      (.put channel #(.take q))
                      (.put q (first s))
                      (recur (next s)))
                    (.put channel #(throw (InterruptedException.))))
                  (catch Exception e
                    (.put channel #(throw e)))))
         fut (future (fill s))
         drain (fn drain []
                 (lazy-seq
                   (try
                     (cons ((.take channel)) (drain))
                     (catch InterruptedException e nil))))]
     (map #(if (identical? % NIL) nil %) (drain)))))

(defn trickle
  [slow]
  (map #(do (Thread/sleep 100) %) slow))

(deftest identity?
  (is (= (seque (range 10)) (range 10))))

(deftest priority
  (is (= 4 (count (seque (PriorityBlockingQueue.)
             [:a :b :c :a])))))

(deftest synchronous
  (is (= (seque (SynchronousQueue.)
                (range 10))
         (range 10))))

(deftest nils
  (is (= (seque [nil true false []])
         [nil true false []])))

(deftest errors
  (is (thrown? Throwable
               (dorun (seque (map #(throw (Exception. (str %))) (range 10)))))))

(deftest threads
  (let [s (seque (SynchronousQueue.) (range 10))
        f1 (future (doall s))
        f2 (future (doall s))]
    (is (= (range 10) @f1 @f2))))

(defn moronic [] ; untestable
  (let [q (LinkedBlockingQueue. 100)]
    (future (dotimes [_ 1000] (Thread/yield) (.poll q)))
    (future (dotimes [_ 1000] (Thread/yield) (.offer q :foo)))
    (seque q (range 1000))))
Published on