Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Better names and such in code.

  • Loading branch information...
commit f887395fde0248d8fd0e8f6b6deb1c7e0e98c2c8 1 parent 793b01e
@marick authored
View
237 solutions/message-class.clj
@@ -4,7 +4,7 @@
;;; Exercise 1
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -21,42 +21,35 @@
;;; Exercise 2
-(def tentative-message
+(def send-to-Message-new ;; Supposed to remind you of (send-to Message :new ...)
+ (fn [target name args holder-name]
+ (let [initializer (get (held-methods 'ActiveMessage) :add-instance-values)]
+ (binding [this (basic-object 'ActiveMessage)]
+ (initializer :name name
+ :holder-name holder-name
+ :args args
+ :target target)))))
+
+(def fresh-active-message
(fn [target name args]
- (let [initialize (get (held-methods 'Message) :add-instance-values)]
- (binding [this (basic-object 'Message)]
- (initialize :name name
- :holder-name (find-containing-holder-symbol
- (:__left_symbol__ target)
- name)
- :args args
- :target target)))))
-
-(def message-or-method-missing-message
- (fn [tentative]
- (if (:holder-name tentative)
- tentative
- (fresh-message (:target tentative)
- :method-missing
- (vector (:name tentative)
- (:args tentative))))))
-
-(def fresh-message
- "Construct the message corresponding to the
+ "Construct the message corresponding to the
attempt to send the particular `name` to the
`target` with the given `args`. If there is no
matching method, the message becomes one that
sends `:method-missing` to the target."
- (fn [target name args]
- (message-or-method-missing-message (tentative-message target name args))))
-
-
+ (let [holder-name (find-containing-holder-symbol (:__left_symbol__ target)
+ name)]
+ (if holder-name
+ (send-to-Message-new target name args holder-name)
+ (fresh-active-message target
+ :method-missing
+ (vector name args))))))
;;; Exercise 3
-(def message-above :ensure-that-the-function-can-no-longer-be-called)
+(def using-message-above :ensure-that-the-function-can-no-longer-be-called)
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -67,11 +60,11 @@
:args (fn [] (:args this))
:target (fn [] (:target this))
- :move-up ;; <<======
+ :move-up ;; <<======
(fn []
- (let [holder-name (find-containing-holder-symbol
- (method-holder-symbol-above (:holder-name this))
- (:name this))]
+ (let [symbol-above (method-holder-symbol-above (:holder-name this))
+ holder-name (find-containing-holder-symbol symbol-above
+ (:name this))]
(if holder-name
(assoc this :holder-name holder-name)
(throw (Error. (str "No superclass method `" (:name this)
@@ -82,19 +75,18 @@
(def repeat-to-super
(fn []
- (activate (send-to message :move-up))))
+ (activate-method (send-to *active-message* :move-up))))
(def send-super
(fn [& args]
- (def mss message)
- (activate (assoc (send-to message :move-up)
- :args args))))
+ (activate-method (assoc (send-to *active-message* :move-up)
+ :args args))))
;;; Exercise 4
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -105,27 +97,24 @@
:args (fn [] (:args this))
:target (fn [] (:target this))
- :move-up ;; <<======
+ :move-up
(fn []
- (let [holder-name (send-to this :find-containing-holder-symbol)]
- (if holder-name
+ (let [holder-name (send-to this :holder-name-above)]
+ (if holder-name
(assoc this :holder-name holder-name)
- (send-to this :no-message-to-move-up-to))))
-
- :find-containing-holder-symbol
- (fn []
- (find-containing-holder-symbol (send-to this :next-holder-up)
- (send-to this :name)))
-
- :next-holder-up
- (fn []
- (method-holder-symbol-above (send-to this :holder-name)))
-
- :no-message-to-move-up-to
- (fn []
- (throw (Error. (str "No superclass method `" (send-to this :name)
- "` above `" (send-to this :holder-name)
- "`."))))
+ (send-to this :spew-fail-to-move-up-error))))
+
+ ;; Private
+ :holder-name-above
+ (fn []
+ (let [symbol-above (method-holder-symbol-above (send-to this :holder-name))]
+ (find-containing-holder-symbol symbol-above (send-to this :name))))
+
+ :spew-fail-to-move-up-error
+ (fn []
+ (throw (Error. (str "No superclass method `" (send-to this :name)
+ "` above `" (send-to this :holder-name)
+ "`."))))
}
{})
@@ -137,7 +126,7 @@
;;; Exercise 6
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -148,47 +137,41 @@
:args (fn [] (:args this))
:target (fn [] (:target this))
:sender (fn [] (:sender this)) ;; <<==
-
+
:move-up
(fn []
- (let [holder-name (send-to this :find-containing-holder-symbol)]
- (if holder-name
+ (let [holder-name (send-to this :holder-name-above)]
+ (if holder-name
(assoc this :holder-name holder-name)
- (send-to this :no-message-to-move-up-to))))
-
- :find-containing-holder-symbol
- (fn []
- (find-containing-holder-symbol (send-to this :next-holder-up)
- (send-to this :name)))
-
- :next-holder-up
- (fn []
- (method-holder-symbol-above (send-to this :holder-name)))
-
- :no-message-to-move-up-to
- (fn []
- (throw (Error. (str "No superclass method `" (send-to this :name)
- "` above `" (send-to this :holder-name)
- "`."))))
+ (send-to this :spew-fail-to-move-up-error))))
+
+ ;; Private
+ :holder-name-above
+ (fn []
+ (let [symbol-above (method-holder-symbol-above (send-to this :holder-name))]
+ (find-containing-holder-symbol symbol-above (send-to this :name))))
+
+ :spew-fail-to-move-up-error
+ (fn []
+ (throw (Error. (str "No superclass method `" (send-to this :name)
+ "` above `" (send-to this :holder-name)
+ "`."))))
}
{})
-(def tentative-message
- (fn [target name args]
- (let [initialize (get (held-methods 'Message) :add-instance-values)
+(def send-to-Message-new ;; Supposed to remind you of (send-to Message :new ...)
+ (fn [target name args holder-name]
+ (let [initializer (get (held-methods 'ActiveMessage) :add-instance-values)
;; At this moment, `this` is still bound to the ;; <<==
;; sender of the message. ;; <<==
sender this] ;; <<==
- (binding [this (basic-object 'Message)]
- (initialize :name name
- :holder-name (find-containing-holder-symbol
- (:__left_symbol__ target)
- name)
- :args args
- :target target
- :sender sender))))) ;; <<==
-
+ (binding [this (basic-object 'ActiveMessage)]
+ (initializer :name name
+ :holder-name holder-name
+ :args args
+ :target target
+ :sender sender))))) ;; <<==
;;; Exercise 7
@@ -196,7 +179,7 @@
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -207,14 +190,14 @@
:args (fn [] (:args this))
:target (fn [] (:target this))
:sender (fn [] (:sender this))
- :previous (fn [] (:previous this)) ;; <<==
- :super-count (fn [] (:super-count this)) ;; <<==
-
- :trace ;; <<==
+ :previous (fn [] (:previous this)) ;; <<==
+ :super-count (fn [] (:super-count this)) ;; <<==
+
+ :trace ;; <<==
(fn []
;; Note that I decided, just to make things more varied, that
;; the work of turning a linked list of message lists into a
- ;; sequence should be a class method of `Message`.
+ ;; sequence should be a class method of `ActiveMessage`.
(let [raw-results (send-to (send-to this :class) :message-trace-to-sequence this)
formatted-results (map (fn [result]
(select-keys result
@@ -224,29 +207,28 @@
:move-up
(fn []
- (let [holder-name (send-to this :find-containing-holder-symbol)]
- (if holder-name
+ (let [holder-name (send-to this :holder-name-above)]
+ (if holder-name
(assoc this
:holder-name holder-name
- :previous this
+ :previous this
:super-count (inc (send-to this :super-count))) ;; <<==
- (send-to this :no-message-to-move-up-to))))
-
- :find-containing-holder-symbol
- (fn []
- (find-containing-holder-symbol (send-to this :next-holder-up)
- (send-to this :name)))
-
- :next-holder-up
- (fn []
- (method-holder-symbol-above (send-to this :holder-name)))
-
- :no-message-to-move-up-to
- (fn []
- (throw (Error. (str "No superclass method `" (send-to this :name)
- "` above `" (send-to this :holder-name)
- "`."))))
+ (send-to this :spew-fail-to-move-up-error))))
+
+ ;; Private
+ :holder-name-above
+ (fn []
+ (let [symbol-above (method-holder-symbol-above (send-to this :holder-name))]
+ (find-containing-holder-symbol symbol-above (send-to this :name))))
+
+ :spew-fail-to-move-up-error
+ (fn []
+ (throw (Error. (str "No superclass method `" (send-to this :name)
+ "` above `" (send-to this :holder-name)
+ "`."))))
}
+
+ ;; Class methods
{
:message-trace-to-sequence ;; <<==
(fn [final-message]
@@ -258,20 +240,17 @@
})
-(def tentative-message
- (fn [target name args]
- (let [initialize (get (held-methods 'Message) :add-instance-values)
- previous message ;; <<==
- sender this]
- (binding [this (basic-object 'Message)]
- (initialize :name name
- :holder-name (find-containing-holder-symbol
- (:__left_symbol__ target)
- name)
- :args args
- :target target
- :sender sender
- :previous previous ;; <<==
- :super-count 0))))) ;; <<==
-
+(def send-to-Message-new ;; Supposed to remind you of (send-to Message :new ...)
+ (fn [target name args holder-name]
+ (let [initializer (get (held-methods 'ActiveMessage) :add-instance-values)
+ previous *active-message* ;; <<==
+ sender this]
+ (binding [this (basic-object 'ActiveMessage)]
+ (initializer :name name
+ :holder-name holder-name
+ :args args
+ :target target
+ :sender sender
+ :previous previous ;; <<==
+ :super-count 0))))) ;; <<==
View
45 solutions/pieces/message-class-1.clj
@@ -4,7 +4,7 @@
;;; Exercise 1
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -21,33 +21,26 @@
;;; Exercise 2
-(def tentative-message
+(def send-to-Message-new ;; Supposed to remind you of (send-to Message :new ...)
+ (fn [target name args holder-name]
+ (let [initializer (get (held-methods 'ActiveMessage) :add-instance-values)]
+ (binding [this (basic-object 'ActiveMessage)]
+ (initializer :name name
+ :holder-name holder-name
+ :args args
+ :target target)))))
+
+(def fresh-active-message
(fn [target name args]
- (let [initialize (get (held-methods 'Message) :add-instance-values)]
- (binding [this (basic-object 'Message)]
- (initialize :name name
- :holder-name (find-containing-holder-symbol
- (:__left_symbol__ target)
- name)
- :args args
- :target target)))))
-
-(def message-or-method-missing-message
- (fn [tentative]
- (if (:holder-name tentative)
- tentative
- (fresh-message (:target tentative)
- :method-missing
- (vector (:name tentative)
- (:args tentative))))))
-
-(def fresh-message
- "Construct the message corresponding to the
+ "Construct the message corresponding to the
attempt to send the particular `name` to the
`target` with the given `args`. If there is no
matching method, the message becomes one that
sends `:method-missing` to the target."
- (fn [target name args]
- (message-or-method-missing-message (tentative-message target name args))))
-
-
+ (let [holder-name (find-containing-holder-symbol (:__left_symbol__ target)
+ name)]
+ (if holder-name
+ (send-to-Message-new target name args holder-name)
+ (fresh-active-message target
+ :method-missing
+ (vector name args))))))
View
19 solutions/pieces/message-class-2.clj
@@ -1,9 +1,9 @@
;;; Exercise 3
-(def message-above :ensure-that-the-function-can-no-longer-be-called)
+(def using-message-above :ensure-that-the-function-can-no-longer-be-called)
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -14,11 +14,11 @@
:args (fn [] (:args this))
:target (fn [] (:target this))
- :move-up ;; <<======
+ :move-up ;; <<======
(fn []
- (let [holder-name (find-containing-holder-symbol
- (method-holder-symbol-above (:holder-name this))
- (:name this))]
+ (let [symbol-above (method-holder-symbol-above (:holder-name this))
+ holder-name (find-containing-holder-symbol symbol-above
+ (:name this))]
(if holder-name
(assoc this :holder-name holder-name)
(throw (Error. (str "No superclass method `" (:name this)
@@ -29,12 +29,11 @@
(def repeat-to-super
(fn []
- (activate (send-to message :move-up))))
+ (activate-method (send-to *active-message* :move-up))))
(def send-super
(fn [& args]
- (def mss message)
- (activate (assoc (send-to message :move-up)
- :args args))))
+ (activate-method (assoc (send-to *active-message* :move-up)
+ :args args))))
View
37 solutions/pieces/message-class-3.clj
@@ -1,7 +1,7 @@
;;; Exercise 4
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -12,27 +12,24 @@
:args (fn [] (:args this))
:target (fn [] (:target this))
- :move-up ;; <<======
+ :move-up
(fn []
- (let [holder-name (send-to this :find-containing-holder-symbol)]
- (if holder-name
+ (let [holder-name (send-to this :holder-name-above)]
+ (if holder-name
(assoc this :holder-name holder-name)
- (send-to this :no-message-to-move-up-to))))
-
- :find-containing-holder-symbol
- (fn []
- (find-containing-holder-symbol (send-to this :next-holder-up)
- (send-to this :name)))
-
- :next-holder-up
- (fn []
- (method-holder-symbol-above (send-to this :holder-name)))
-
- :no-message-to-move-up-to
- (fn []
- (throw (Error. (str "No superclass method `" (send-to this :name)
- "` above `" (send-to this :holder-name)
- "`."))))
+ (send-to this :spew-fail-to-move-up-error))))
+
+ ;; Private
+ :holder-name-above
+ (fn []
+ (let [symbol-above (method-holder-symbol-above (send-to this :holder-name))]
+ (find-containing-holder-symbol symbol-above (send-to this :name))))
+
+ :spew-fail-to-move-up-error
+ (fn []
+ (throw (Error. (str "No superclass method `" (send-to this :name)
+ "` above `" (send-to this :holder-name)
+ "`."))))
}
{})
View
58 solutions/pieces/message-class-4.clj
@@ -5,7 +5,7 @@
;;; Exercise 6
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -16,45 +16,39 @@
:args (fn [] (:args this))
:target (fn [] (:target this))
:sender (fn [] (:sender this)) ;; <<==
-
+
:move-up
(fn []
- (let [holder-name (send-to this :find-containing-holder-symbol)]
- (if holder-name
+ (let [holder-name (send-to this :holder-name-above)]
+ (if holder-name
(assoc this :holder-name holder-name)
- (send-to this :no-message-to-move-up-to))))
-
- :find-containing-holder-symbol
- (fn []
- (find-containing-holder-symbol (send-to this :next-holder-up)
- (send-to this :name)))
-
- :next-holder-up
- (fn []
- (method-holder-symbol-above (send-to this :holder-name)))
-
- :no-message-to-move-up-to
- (fn []
- (throw (Error. (str "No superclass method `" (send-to this :name)
- "` above `" (send-to this :holder-name)
- "`."))))
+ (send-to this :spew-fail-to-move-up-error))))
+
+ ;; Private
+ :holder-name-above
+ (fn []
+ (let [symbol-above (method-holder-symbol-above (send-to this :holder-name))]
+ (find-containing-holder-symbol symbol-above (send-to this :name))))
+
+ :spew-fail-to-move-up-error
+ (fn []
+ (throw (Error. (str "No superclass method `" (send-to this :name)
+ "` above `" (send-to this :holder-name)
+ "`."))))
}
{})
-(def tentative-message
- (fn [target name args]
- (let [initialize (get (held-methods 'Message) :add-instance-values)
+(def send-to-Message-new ;; Supposed to remind you of (send-to Message :new ...)
+ (fn [target name args holder-name]
+ (let [initializer (get (held-methods 'ActiveMessage) :add-instance-values)
;; At this moment, `this` is still bound to the ;; <<==
;; sender of the message. ;; <<==
sender this] ;; <<==
- (binding [this (basic-object 'Message)]
- (initialize :name name
- :holder-name (find-containing-holder-symbol
- (:__left_symbol__ target)
- name)
- :args args
- :target target
- :sender sender))))) ;; <<==
-
+ (binding [this (basic-object 'ActiveMessage)]
+ (initializer :name name
+ :holder-name holder-name
+ :args args
+ :target target
+ :sender sender))))) ;; <<==
View
78 solutions/pieces/message-class-5.clj
@@ -4,7 +4,7 @@
(send-to Klass :new
- 'Message 'Anything
+ 'ActiveMessage 'Anything
{
:add-instance-values
(fn [& key-value-pairs]
@@ -15,14 +15,14 @@
:args (fn [] (:args this))
:target (fn [] (:target this))
:sender (fn [] (:sender this))
- :previous (fn [] (:previous this)) ;; <<==
- :super-count (fn [] (:super-count this)) ;; <<==
-
- :trace ;; <<==
+ :previous (fn [] (:previous this)) ;; <<==
+ :super-count (fn [] (:super-count this)) ;; <<==
+
+ :trace ;; <<==
(fn []
;; Note that I decided, just to make things more varied, that
;; the work of turning a linked list of message lists into a
- ;; sequence should be a class method of `Message`.
+ ;; sequence should be a class method of `ActiveMessage`.
(let [raw-results (send-to (send-to this :class) :message-trace-to-sequence this)
formatted-results (map (fn [result]
(select-keys result
@@ -32,29 +32,28 @@
:move-up
(fn []
- (let [holder-name (send-to this :find-containing-holder-symbol)]
- (if holder-name
+ (let [holder-name (send-to this :holder-name-above)]
+ (if holder-name
(assoc this
:holder-name holder-name
- :previous this
+ :previous this
:super-count (inc (send-to this :super-count))) ;; <<==
- (send-to this :no-message-to-move-up-to))))
-
- :find-containing-holder-symbol
- (fn []
- (find-containing-holder-symbol (send-to this :next-holder-up)
- (send-to this :name)))
-
- :next-holder-up
- (fn []
- (method-holder-symbol-above (send-to this :holder-name)))
-
- :no-message-to-move-up-to
- (fn []
- (throw (Error. (str "No superclass method `" (send-to this :name)
- "` above `" (send-to this :holder-name)
- "`."))))
+ (send-to this :spew-fail-to-move-up-error))))
+
+ ;; Private
+ :holder-name-above
+ (fn []
+ (let [symbol-above (method-holder-symbol-above (send-to this :holder-name))]
+ (find-containing-holder-symbol symbol-above (send-to this :name))))
+
+ :spew-fail-to-move-up-error
+ (fn []
+ (throw (Error. (str "No superclass method `" (send-to this :name)
+ "` above `" (send-to this :holder-name)
+ "`."))))
}
+
+ ;; Class methods
{
:message-trace-to-sequence ;; <<==
(fn [final-message]
@@ -66,20 +65,17 @@
})
-(def tentative-message
- (fn [target name args]
- (let [initialize (get (held-methods 'Message) :add-instance-values)
- previous message ;; <<==
- sender this]
- (binding [this (basic-object 'Message)]
- (initialize :name name
- :holder-name (find-containing-holder-symbol
- (:__left_symbol__ target)
- name)
- :args args
- :target target
- :sender sender
- :previous previous ;; <<==
- :super-count 0))))) ;; <<==
-
+(def send-to-Message-new ;; Supposed to remind you of (send-to Message :new ...)
+ (fn [target name args holder-name]
+ (let [initializer (get (held-methods 'ActiveMessage) :add-instance-values)
+ previous *active-message* ;; <<==
+ sender this]
+ (binding [this (basic-object 'ActiveMessage)]
+ (initializer :name name
+ :holder-name holder-name
+ :args args
+ :target target
+ :sender sender
+ :previous previous ;; <<==
+ :super-count 0))))) ;; <<==
View
71 sources/consolidation-additive.clj
@@ -1,9 +1,6 @@
(load-file "sources/dynamic.clj")
-(def ^:dynamic message {:name :undefined,
- :holder-name :undefined,
- :args :undefined,
- :target :undefined})
+(def ^:dynamic *active-message* nil)
;;; Constructing messages
@@ -13,57 +10,57 @@
(message-name (held-methods holder-symbol)))
(reverse (lineage first-candidate))))))
-(def fresh-message
+(def fresh-active-message
(fn [target name args]
- (let [tentative (assoc message
- :name name
- :holder-name (find-containing-holder-symbol (:__left_symbol__ target) name)
- :args args
- :target target)]
- (if (:holder-name tentative)
- tentative
- (fresh-message target
- :method-missing
- (vector name args))))))
-
-(def message-above
- (fn [message]
- (let [holder-name (find-containing-holder-symbol
- (method-holder-symbol-above (:holder-name message))
- (:name message))]
+ (let [holder-name (find-containing-holder-symbol (:__left_symbol__ target)
+ name)]
+ (if holder-name
+ {:name name, :holder-name holder-name, :args args, :target target}
+ (fresh-active-message target
+ :method-missing
+ (vector name args))))))
+
+
+(def using-method-above
+ (fn [active-message]
+ (let [symbol-above (method-holder-symbol-above (:holder-name active-message))
+ holder-name (find-containing-holder-symbol symbol-above
+ (:name active-message))]
(if holder-name
- (assoc message :holder-name holder-name)
- (throw (Error. (str "No superclass method `" (:name message)
- "` above `" (:holder-name message)
+ (assoc active-message :holder-name holder-name)
+ (throw (Error. (str "No superclass method `" (:name active-message)
+ "` above `" (:holder-name active-message)
"`.")))))))
-;; Activating messages
+;; Activating methods
(def method-to-run
- (fn [message]
- (get (held-methods (:holder-name message)) (:name message))))
+ (fn [active-message]
+ (get (held-methods (:holder-name active-message))
+ (:name active-message))))
-(def activate
- (fn [message]
- (binding [message message
- this (:target message)]
- (apply (method-to-run message) (:args message)))))
+(def activate-method
+ (fn [active-message]
+ (binding [*active-message* active-message
+ this (:target active-message)]
+ (apply (method-to-run active-message)
+ (:args active-message)))))
;;; Public interface
(def send-to
(fn [instance message-name & args]
- (activate (fresh-message instance message-name args))))
+ (activate-method (fresh-active-message instance message-name args))))
(def repeat-to-super
(fn []
- (activate (message-above message))))
+ (activate-method (using-method-above *active-message*))))
(def send-super
(fn [& args]
- (def mss message)
- (activate (message-above (assoc message :args args)))))
+ (let [with-replaced-args (assoc *active-message* :args args)]
+ (activate-method (using-method-above with-replaced-args)))))
;; Klass
(install (method-holder 'Klass,
@@ -73,7 +70,7 @@
:new
(fn [& args]
(let [seeded {:__left_symbol__ (:__own_symbol__ this)}]
- (apply send-to seeded :add-instance-values args))) ;; <<== change
+ (apply send-to seeded :add-instance-values args)))
:to-string
(fn []
View
76 sources/consolidation.clj
@@ -3,26 +3,24 @@
;;; Context available to all messages
(def ^:dynamic this nil)
-(def ^:dynamic message {:name :undefined,
- :holder-name :undefined,
- :args :undefined,
- :target :undefined})
+(def ^:dynamic *active-message* nil)
;;; Public interface
-(declare activate fresh-message message-above)
+(declare activate-method fresh-active-message using-method-above)
(def send-to
(fn [instance message-name & args]
- (activate (fresh-message instance message-name args))))
+ (activate-method (fresh-active-message instance message-name args))))
(def repeat-to-super
(fn []
- (activate (message-above message))))
+ (activate-method (using-method-above *active-message*))))
(def send-super
(fn [& args]
- (def mss message)
- (activate (message-above (assoc message :args args)))))
+ (activate-method (assoc (using-method-above *active-message*)
+ :args args))))
+
;;; Bootstrapping the first few classes
@@ -275,37 +273,35 @@
(message-name (held-methods holder-symbol)))
(reverse (lineage first-candidate))))))
-(def fresh-message
- "Construct the message corresponding to the
+(def fresh-active-message
+ (fn [target name args]
+ "Construct the message corresponding to the
attempt to send the particular `name` to the
`target` with the given `args`. If there is no
matching method, the message becomes one that
sends `:method-missing` to the target."
- (fn [target name args]
- (let [tentative (assoc message
- :name name
- :holder-name (find-containing-holder-symbol (:__left_symbol__ target) name)
- :args args
- :target target)]
- (if (:holder-name tentative)
- tentative
- (fresh-message target
- :method-missing
- (vector name args))))))
-
-(def message-above
+ (let [holder-name (find-containing-holder-symbol (:__left_symbol__ target)
+ name)]
+ (if holder-name
+ {:name name, :holder-name holder-name, :args args, :target target}
+ (fresh-active-message target
+ :method-missing
+ (vector name args))))))
+
+
+(def using-method-above
"Use this with a message that has already been created
needs to be re-sent to a method in `:up` from the
method holder used last. If there is no method in the
lineage above that method holder, an error is thrown."
- (fn [message]
- (let [holder-name (find-containing-holder-symbol
- (method-holder-symbol-above (:holder-name message))
- (:name message))]
+ (fn [active-message]
+ (let [symbol-above (method-holder-symbol-above (:holder-name active-message))
+ holder-name (find-containing-holder-symbol symbol-above
+ (:name active-message))]
(if holder-name
- (assoc message :holder-name holder-name)
- (throw (Error. (str "No superclass method `" (:name message)
- "` above `" (:holder-name message)
+ (assoc active-message :holder-name holder-name)
+ (throw (Error. (str "No superclass method `" (:name active-message)
+ "` above `" (:holder-name active-message)
"`.")))))))
;; Activating messages
@@ -313,17 +309,17 @@
(def method-to-run
"Convert the holder and message names in the `message` (both symbols)
to a function value to apply."
- (fn [message]
- (get (held-methods (:holder-name message)) (:name message))))
+ (fn [active-message]
+ (get (held-methods (:holder-name active-message))
+ (:name active-message))))
-(def activate
- "Cause the message to execute, making the `this` and `message` values
- available to it."
- (fn [message]
- (binding [message message
- this (:target message)]
- (apply (method-to-run message) (:args message)))))
+(def activate-method
+ (fn [active-message]
+ (binding [*active-message* active-message
+ this (:target active-message)]
+ (apply (method-to-run active-message)
+ (:args active-message)))))
;;; Non-core classes
View
113 sources/message-class-exercises.clj
@@ -7,20 +7,42 @@
:snoop
(fn [& args]
[
- (send-to message :name)
- (send-to message :holder-name)
- (send-to message :args)
- (send-to message :target)
+ (send-to *active-message* :name)
+ (send-to *active-message* :holder-name)
+ (send-to *active-message* :args)
+ (send-to *active-message* :target)
])
}
{})
-;; (def snooper (send-to Snooper :new))
-;; (send-to snooper :snoop "an arg") ; => [:snoop 'Snooper ["an arg"] snooper])
+(def snooper (send-to Snooper :new))
+(prn (send-to snooper :snoop "an arg")) ; => [:snoop 'Snooper ("an arg") snooper])
;; For exercise 3
+(comment
+ ;; Here are the two methods you are to make work.
+ ;; They're commented out so that they don't break my
+ ;; automated tests.
+(def repeat-to-super
+ (fn []
+ (activate-method (send-to *active-message* :move-up))))
+
+(def send-super
+ (fn [& args]
+ (activate-method (assoc (send-to *active-message* :move-up)
+ :args args))))
+
+ ;; Since you're replacing `using-method-above`, it's useful to
+ ;; define it to something that will blow up if there's still a
+ ;; stray call to it.
+
+(def using-message-above :ensure-that-the-function-can-no-longer-be-called)
+
+)
+
+
(send-to Klass :new
'SubSnooper 'Snooper
{
@@ -30,11 +52,11 @@
;; in the context of a method
;; that shadows a method in the
;; superclass.
- (send-to message :move-up))
+ (send-to *active-message* :move-up))
:fail-dramatically
(fn []
- (send-to message :move-up))
+ (send-to *active-message* :move-up))
:to-string
(fn []
@@ -43,21 +65,26 @@
{})
-;; (def snooper (send-to SubSnooper :new))
-;; (send-to snooper :snoop "an arg") ; => {:name :snoop,
-;; ; :holder-name Snooper,
-;; ; :args ("an arg"),
-;; ; :target {:__left_symbol__ SubSnooper},
-;; ; :__left_symbol__ Message}
+(comment
+ ;; The following is commented out because of the way my
+ ;; automated tests work. It's in a block comment to make
+ ;; it easy for you to copy it into a REPL
-;; (activate (send-to snooper :snoop "an arg")) ; => [:snoop Snooper ("an arg")
-;; ; {:__left_symbol__ SubSnooper}]
-;; (send-to snooper :fail-dramatically) ; throws Error
-;; (send-to snooper :to-string) ; => "Look! {:__left_symbol__ SubSnooper}"
+(def snooper (send-to SubSnooper :new))
+(prn (send-to snooper :snoop "an arg")) ; => {:name :snoop,
+ ; :holder-name Snooper,
+ ; :args ("an arg"),
+ ; :target {:__left_symbol__ SubSnooper},
+ ; :__left_symbol__ Message}
+(prn (activate-method (send-to snooper :snoop "an arg"))) ; => [:snoop Snooper ("an arg")
+ ; {:__left_symbol__ SubSnooper}]
+(send-to snooper :fail-dramatically) ; throws Error
+(prn (send-to snooper :to-string)) ; => "Look! {:__left_symbol__ SubSnooper}"
+)
-;; For exercise 6
+;; ;; For exercise 6
(send-to Klass :new
'Criminal 'Anything
@@ -68,9 +95,10 @@
(println "Criminal:" taunt)
(send-to copper :be-taunted taunt)))
- :be-arrested
+ :give-yourself-up
(fn []
- (println "Criminal: It's a fair cop, but society is to blame."))
+ (let [confession "It's a fair cop, but society is to blame."]
+ (println "Criminal:" confession)))
}
{})
@@ -85,19 +113,22 @@
:be-taunted
(fn [taunt]
- (let [evildoer (send-to message :sender)]
- (cl-format true "Detective ~A: Wot? Who?~%" (send-to this :name))
+ (let [evildoer (send-to *active-message* :sender)]
+ (cl-format true "Detective ~A: Wot? Who?~%"
+ (send-to this :name))
(println "<nab/>")
- (send-to evildoer :be-arrested)))
+ (send-to evildoer :give-yourself-up)))
}
{})
-;; (def criminal (send-to Criminal :new))
-;; (def police (send-to Police :new "Biggles"))
-;; (send-to criminal :taunt police)
+(comment
+(def criminal (send-to Criminal :new))
+(def police (send-to Police :new "Biggles"))
+(send-to criminal :taunt police)
+)
-;; For Exercise 7
+;; ;; For Exercise 7
(declare Bottom Middle Top)
@@ -113,8 +144,7 @@
:secondary-message (* 10 n)))
:secondary-message (fn [n] (repeat-to-super))
}
- {
- })
+ {})
(send-to Klass :new
'Middle 'Top
@@ -129,20 +159,26 @@
'Top 'Anything
{
:secondary-message (fn [n] (send-to this :tertiary-message (* 10 n)))
- :tertiary-message (fn [n] message)
+ :tertiary-message (fn [n] *active-message*)
}
{})
+(comment
+
;; It might be helpful to start with simple cases and work up.
-;; (def traceful (send-to (send-to Top :new) :tertiary-message 1))
-;; (send-to traceful :trace)
+(def traceful (send-to (send-to Top :new) :tertiary-message 1))
+traceful
+(send-to traceful :trace)
-;; (def traceful (send-to (send-to Middle :new) :tertiary-message 1))
-;; (pprint (send-to traceful :trace))
+(def traceful (send-to (send-to Middle :new) :tertiary-message 1))
+traceful
+(pprint (send-to traceful :trace))
-;; (def traceful (send-to (send-to Bottom :new "one") :chained-message 1))
-;; (pprint (send-to traceful :trace))
+(def traceful (send-to (send-to Bottom :new "one") :chained-message 1))
+traceful
+(pprint (send-to traceful :trace))
+)
;; `friendly-trace can take the output of one of the above lines and
;; print it in a more pleasing form. It shows a few new Clojure
@@ -241,6 +277,3 @@
(dorun (map println (map format-one-element renamed-trace)))
(println "-------------")
(dorun (map println (table-of-contents namings))))))
-
-
-
View
4 test/solutions/ts_message_class.clj
@@ -18,7 +18,7 @@
(fact
(let [snooper (send-to SubSnooper :new)]
- (activate (send-to snooper :snoop "an arg"))
+ (activate-method (send-to snooper :snoop "an arg"))
=> [:snoop 'Snooper ["an arg"] snooper]
(send-to snooper :fail-dramatically) => (throws Error)
(send-to snooper :to-string) => "Look! {:__left_symbol__ SubSnooper}"))
@@ -36,7 +36,7 @@
(fact
(let [snooper (send-to SubSnooper :new)]
- (activate (send-to snooper :snoop "an arg"))
+ (activate-method (send-to snooper :snoop "an arg"))
=> [:snoop 'Snooper ["an arg"] snooper]
(send-to snooper :fail-dramatically) => (throws Error)
(send-to snooper :to-string) => "Look! {:__left_symbol__ SubSnooper}"))
View
10 test/solutions/ts_message_class_continued.clj
@@ -3,13 +3,15 @@
(load-file "sources/consolidation.clj")
-(load-file "sources/message-class-exercises.clj")
;;; You should replace this file with your own.
(load-file "solutions/message-class.clj")
-;;; These are the tests for code up to the last
-;;; exercise set. They should still pass.
+(load-file "sources/message-class-exercises.clj")
+
+
+;; These are the tests for code up to the last
+;; exercise set. They should still pass.
(load-file "test/solutions/ruby-complete.clj")
;; Additional tests.
@@ -21,7 +23,7 @@
(fact
(let [snooper (send-to SubSnooper :new)]
- (activate (send-to snooper :snoop "an arg"))
+ (activate-method (send-to snooper :snoop "an arg"))
=> [:snoop 'Snooper ["an arg"] snooper]
(send-to snooper :fail-dramatically) => (throws Error)
(send-to snooper :to-string) => "Look! {:__left_symbol__ SubSnooper}"))
Please sign in to comment.
Something went wrong with that request. Please try again.