object.clj

(ns scratch.object
  "This namespace defines a basic framework for class-based object-oriented
  programming, including classes, instances, fields, methods, single
  inheritance, and multiple inheritance through abstract classes."
  (:refer-clojure :exclude [class instance?])
  (:require [clojure.walk :as walk]))

;; A basic immutable object system.

(defn object
  "Constructs a new object with the given instance fields."
  [fields]
  {:fields fields})

(defn get-field
  "Gets the value of a field in the given object."
  [obj field-name]
  (if (contains? (:fields obj) field-name)
    (get (:fields obj) field-name)
    (throw (ex-info (str "No such field " field-name) {}))))

(defn set-field
  "Sets the value of a field in the given object, returning the new object."
  [obj field value]
  (update obj :fields assoc field value))

(defn call-method
  "Takes an object and a field of that object which refers to a method (a
  Clojure function). Calls that method, providing the object as the first
  argument, and passing in any additional arguments thereafter."
  [obj method-name & args]
  (if-let [method (get-field obj method-name)]
    (apply method obj args)
    (throw (ex-info (str "No such method " method-name)))))

;; OK, now let's try setting up something basic. Like a person who can give a
;; speech!

(def sussman
  "Gerald Sussman is here to teach us about object-oriented programming."
  (object
    {:name           "Gerald Jay Sussman"
     :make-statement (fn [this]
                       (println "It's not at all obvious what an object is."))
     :greet          (fn [this other-person]
                       (println "Hello," (get-field other-person :name)))}))

; user=> (o/get-field o/sussman :name)
; "Gerald Jay Sussman"

; user=> (o/call-method o/sussman :make-statement)
; It's not at all obvious what an object is.

; What about... making that into a speech?

(def speech-giver
  "Speech givers have a single function, give-speech, which makes a short
  speech introducing themselves and making a statement."
  (object {:give-speech (fn [this]
                          (print "Hello. My name is ")
                          (print (get-field this :name))
                          (println ".")
                          (call-method this :make-statement)
                          (println "Thank you for your time.")
                          :applause)}))

; user=> (o/call-method o/speech-giver :give-speech)
; ExceptionInfo No such field :name  clojure.core/ex-info (core.clj:4617)

; Hello. My name is user=> (o/call-method o/sussman :give-speech)
; ExceptionInfo No such field :give-speech  clojure.core/ex-info (core.clj:4617)

(defn inherit
  "Merges objects `prototype` and `instance`, returning a new object. Where
  fields conflict, `instance` overrides `prototype`."
  [prototype instance]
  (merge-with merge prototype instance))

(def sussman (inherit speech-giver sussman))

; user=> (o/call-method o/speechgiving-sussman :give-speech)
; Hello. My name is Gerald Jay Sussman.
; It's not at all obvious what an object is.
; Thank you for your time.

; And we can selectively override fields, which lets us alter behavior.
(def nega-sussman
  (inherit
    speechgiving-sussman
    (object {:name "NEGA-SUSSMAN"
             :give-speech
             (fn [this]
               (println "I SHALL DRAW FROM YOUR FEEBLE MINDS THE VERY CONCEPTS"
                        "YOU HAVE STRUGGLED SO HARD TO ACQUIRE. THE KNOWLEDGE"
                        "OF OBJECTS IS MINE AND MINE ALONE."
                        (get-field this :name)
                        "OUT.")
               :stunned-silence)})))

; (o/call-method o/nega-sussman :give-speech)

(defn parse-dot
  "Takes a symbol like 'foo.bar and returns ['foo :bar], or `nil` if sym is not
  a symbol, or does not have a period. For symbols with multiple dots (e.g.
  'foo.bar.baz), returns ['foo.bar :baz]. Helpful for parsing OO calls."
  [sym]
  (when (symbol? sym)
    (when-let [[_ object field] (re-find #"^(.+)?\.(.+)$" (name sym))]
      [(when object
         ; Re-qualify this object symbol in the right namespace, if necessary.
         (if (qualified-symbol? sym)
           (symbol (namespace sym) object)
           (symbol object)))
       (keyword field)])))

(defn transform-oo
  "Takes an expression and provides syntactic sugar for object-oriented calls.
  Transforms symbols like foo.bar into field accesses:

    - foo.bar             -> (get-field foo :bar)
    - foo.bar.baz         -> (get-field (get-field foo :bar) :baz)

  And in seqs, transforms foo.bar to field or method calls, so that one can
  write:

    - (do foo.bar(arg1, arg2)) -> (do (call-method foo :bar arg1 arg2))
    - (do foo.bar().baz)       -> (do (get-field (call-method foo :bar) :baz))"
  [expr]
  (cond ; Handle foo.bar instance fields
        (symbol? expr)
        (if-let [[obj field] (parse-dot expr)]
          `(get-field ~(transform-oo obj) ~field)
          expr)

        ; Transform (foo.bar ...) method calls.
        (sequential? expr)
        (loop [results []
               tokens  expr
               cur-obj ::none]
          ;(println (str (pr-str results) \tab
          ;              (pr-str tokens) \tab
          ;              (pr-str cur-obj)))
          ; If we were to add our current object to results, what
          ; would we get?
          (let [results' (if (= ::none cur-obj)
                           results
                           (conj results (transform-oo cur-obj)))]
            (if-not (seq tokens)
              ; Done; turn results into something of the same type as expr.
              (if (vector? expr)
                results'
                (seq results'))

              ; Take a look at the next two expressions...
              (let [[token next-token & later-tokens] tokens]
                (if-let [[obj field] (parse-dot token)]
                  ; This is an OO call
                  (if (seq? next-token)
                    ; Specifically, a method call
                    (if obj
                      ; And we're starting it on a fresh object.
                      (recur results'
                             later-tokens
                             `(call-method ~(transform-oo obj)
                                           ~field
                                           ~@(transform-oo next-token)))
                      ; We're chaining onto the current object.
                      (recur results
                             later-tokens
                             `(call-method ~cur-obj
                                           ~field
                                           ~@(transform-oo next-token))))
                    ; Specifically, a field access.
                    (if obj
                      ; And we're starting it on a fresh object.
                      (recur results'
                             (next tokens)
                             `(get-field ~(transform-oo obj)
                                         ~field))
                      ; We're chaining onto the current object.
                      (recur results
                             (next tokens)
                             `(get-field ~cur-obj ~field))))
                  ; This is not an OO call.
                  (recur results'
                         (next tokens)
                         token))))))

        ; Anything else, pass through unchanged.
        true
        expr))

(defmacro oo
  "This macro executes any number of expressions in our object-oriented
  paradigm. Expressions are resolved as Clojure, except we offer special syntax
  for getting fields and calling methods, as per transform-oo."
  [& exprs]
  (transform-oo `(do ~@exprs)))