gistfile1.clj

;; feed macro
(use 'clojure.walk)
(defmacro _>_ [& exprs]
  (reduce
    (fn [inner step]
      (clojure.walk/postwalk-replace {'___ inner} step))
    (reverse exprs)))

;; Protocol for dodo prototypes
(defprotocol DodoProtocol
  (class* [self] "the class for that object"))

;; Create new copy of self with the specified bindings
(defn new* [self & {:as bindings}]
  (merge self bindings))

;; Apply using a map
(defn kwapply [function & args]
  (apply function (apply concat (butlast args) (last args))))

;; Create a new copy of self with self added as superclass and the specified bindings
(defn newclass* [self & bindings]
  (if (= 1 (count bindings))
    (kwapply newclass* self (first bindings))  ; got bindings as a map
    (assoc (apply new* self bindings)
      :super
        (conj (-> self :super) self))))


;; Dispatch message to object
(defmacro call* [obj, getter & args]
  `(let [object# ~obj]
    (((keyword '~getter) (class* object#)) object# ~@args)))

;; Forward results to selected continuation
(defn >>> [continuation]
  (fn [& values]
    #(apply continuation values)))

(defrecord Dodo [super, instance])

(def DodoClass (new Dodo nil nil))

;; class LinkedList is Abstract:
;;    def head()
;;    LinkedList tail()
;;    bool empty().
(def LinkedListClass (newclass* DodoClass :head nil :tail nil :empty nil))


;; def Nil = new LinkedList():
;;    def head() = throw(new IllegalArgument.instance(message: "Nothing in list"))
;;    def tail() = self
;;    def empty() = true.
(declare NilClass)

(defrecord Nil []
  DodoProtocol
    (class* [_]
      NilClass))

(def NilClass (newclass* LinkedListClass
  :instance (new Nil)
  :head (fn [self, return, error]
    #(error (IllegalArgumentException. "Nothing in list")))
  :tail (fn [self, return, error]
    #(return self))
  :empty (fn [self, yes, no]
    #(yes true))))


;; def Link = new LinkedList():
;;    def head
;;    LinkedList tail = Nil.instance
;;    def empty() = false.
(declare LinkClass)

(defrecord Link [head, tail]
  DodoProtocol
    (class* [_]
      LinkClass))

(def LinkClass (newclass* LinkedListClass
  :instance (new Link nil (-> NilClass :instance))
  :head (fn [self, return, error]
    #(return (-> self :head)))
  :tail (fn [self, return, error]
    #(return (-> self :tail)))
  :empty (fn [self, yes, no]
    #(no false))))

;; qualifier Backlinked:
;;    def parent() = self.parent ->|
;;      throw(OutOfBounds.instance).
(defrecord Backlinked [parent])

(def BacklinkedQualifier (new Backlinked
  ;; parent
  (fn [self, return, error]
    (if (nil? (-> self :parent))
      #(error (new IndexOutOfBoundsException))
      #(return (-> self :parent))))))

;; def ReverseNil = new Nil() is Backlinked:
;;    def parent.
(declare ReverseNilClass)

(defrecord ReverseNil [parent]
  DodoProtocol
    (class* [_]
      ReverseNilClass))

(def ReverseNilClass
  (newclass* BacklinkedQualifier
    (newclass* NilClass
      :instance (new ReverseNil (atom nil)))))

;; def ReverseLink = new Link() is Backlinked:
;;    def tail = new ReverseNil.instance(parent: self)
;;    def parent.
(declare ReverseLinkClass)

(defrecord ReverseLink [head, tail, parent]
  DodoProtocol
    (class* [_]
      ReverseLinkClass))

(def ReverseLinkClass
  (newclass* BacklinkedQualifier
    (newclass* LinkClass
      :instance
        (let
          [self
            (new ReverseLink
              nil
              (new* (-> ReverseNilClass :instance))
              (atom nil))]
        (swap! (-> (-> self :tail) :parent) (fn [_] self)) self))))

;; LinkedList intList = new Link.instance(head: 0)
(def intList
  (new* (-> LinkClass :instance)
    :head 0))

;; def x = new intList(head: 4, tail: new intList(head: 56, tail: new ReverseLink.instance(head: 4)))
(def x
  (new* intList
    :head 4
    :tail
      (new* intList
        :head 56
        :tail
          (new* (-> ReverseLinkClass :instance)
            :head -6))))

;; x.head -> x1
;; Println("x[1] = " + x1)
;; x.tail -> y
;; y.empty ->
;;    Println("no more items")
;; |
;;    y.head -> x2
;;    Println("x[2] = " + x2),
;;    y.tail -> z
;;    z.head -> x3
;;    Println("x[3] = " + x3),
;;    z.tail -> t
;;    t.parent -> z\'
;;    z'.head -> x3
;;      Println("x[3] = " + x3),
;;      z.empty ->|;
;;    | e
;;      e.getMessage;
;;    |; |; |; |; |;;
;; |; |;
(defn main [return]
  (_>_
    (call* x head ___ (>>> return))
  (fn [x1]
    (println "x[1] =" x1)
    (call* x tail ___ (>>> return)))
  (fn [y]
    (call* y empty
      (fn [_] (println "no more items"))
      (fn [_]
        (_>_
          (call* y head ___ (>>> return))
        (fn [x2]
          (println "x[2] =" x2)
          (call* y tail ___ (>>> return)))
        (fn [z]
          (call* z head ___ (>>> return)))
        (fn [x3]
          (println "x[3] =" x3)
          (call* z tail ___ (>>> return)))
        (fn [t]
          (call* t parent ___ (>>> return)))   ; NB: that is ReverseLink.instance.tail's parent
        (fn [zref]
          (call* @zref head
            (fn [x3]
              (println "Really, x[3] =" x3)
              (call* @zref empty (>>> return) (>>> return)))
            (fn [e]
              #(return (.getMessage e)))))))))))

(trampoline (main (>>> println)))