turel-borked.clj

(ns turel.core
  (:refer-clojure :exclude [==])
  (:use clojure.core.logic))

(defn not-membero
  [x l]
  (conde [(emptyo l)]
         [(fresh [head tail]
          (conso head tail l)
          (!= head x)
          (not-membero x tail))]))

(defn turing-ruleo
  [rules state-in tape-in-val rule-out]
  (fresh [rule rules-rest write-val dir state-new]
         (conso rule rules-rest rules)
         (conde [(== [state-in tape-in-val write-val dir state-new] rule)
                 (== rule-out [write-val dir state-new])]
                [(turing-ruleo rules-rest state-in tape-in-val rule-out)])))

(defn turing-directiono
  [dir tape-in tape-out]
  (fresh [tape-in-l tape-in-val tape-in-r]
         (== [tape-in-l tape-in-val tape-in-r] tape-in)
         (conde [(== dir :r)
                 (fresh [tape-new-l tape-new-val tape-new-r]
                        (conde [(== tape-in-val :_)
                                (emptyo tape-in-l)
                                (emptyo tape-new-l)]
                               [(conso tape-in-val tape-in-l tape-new-l)])
                        (conde [(firsto tape-in-r tape-new-val)
                                (resto tape-in-r tape-new-r)]
                               [(== tape-new-val :_)
                                (emptyo tape-in-r)
                                (emptyo tape-new-r)])
                        (== tape-out [tape-new-l tape-new-val tape-new-r]))]
                [(== dir :l)
                 (fresh [tape-new-l tape-new-val tape-new-r]
                        (conde [(== tape-in-val :_)
                                (emptyo tape-in-r)
                                (emptyo tape-new-r)]
                               [(conso tape-in-val tape-in-r tape-new-r)])
                        (conde [(firsto tape-in-l tape-new-val)
                                (resto tape-in-l tape-new-l)]
                               [(== tape-new-val :_)
                                (emptyo tape-in-l)
                                (emptyo tape-new-l)])
                        (== tape-out [tape-new-l tape-new-val tape-new-r]))]
                [(== dir :n)
                 (== tape-out tape-in)])))

; note: tape is a 3-tuple [[tape-left...] tape-val [tape-right...]]
; tape-left and tape-right are vectors
; tape-left is inverted, so a value of [[:0 :1] :0 [:1 :1]] actually
; represents the tape [:1 :0 :0 :1 :1]

(defn turing-machineo
  [rules accept-states state-in tape-in state-out tape-out]
  (fresh [tape-in-l tape-in-val tape-in-r
          write-val dir state-new
          tape-new]
         (conde [(== state-out state-in)
                 (== tape-out tape-in)
                 (membero state-in accept-states)]
                [(== tape-in [tape-in-l tape-in-val tape-in-r])
                 (not-membero state-in accept-states)
                 (turing-ruleo rules state-in tape-in-val [write-val dir state-new])
                 (turing-directiono dir [tape-in-l write-val tape-in-r] tape-new)
                 (turing-machineo rules accept-states state-new tape-new state-out tape-out)])))

; generate a partial hello world machine
; unfortunately this causes an OutOfMemoryError where java runs out of heap space

(run 1 [q]
  (turing-machineo q [42] 1 [[] :_ []] 42 [[] :_ [:l :l :o]]))

; which is really confusing, because it works just fine for this rule set

(def hello-rules
  [[1 :_ :o :l 2]
   [2 :_ :l :l 3]
   [3 :_ :l :l 42]])

(run 1 [q]
  (turing-machineo hello-rules [42] 1 [[] :_ []] 42 [[] :_ [:l :l :o]]))

No OutOfMemory here, 5 sec and I have the answer.

user=> (time (doall (run 1 [q]   
           (turing-machineo q [42] 1 [[] :_ []] 42 [[] :_ [:l :l :o]]))))
"Elapsed time: 4873.721118 msecs"
((([1 :_ :o :l _0] [_0 :_ :l :l _1] [_1 :_ :l :l 42] . _2)  
  :- (!= (_1 42)) (!= (_0 42))))