Created
December 11, 2020 01:02
-
-
Save subsetpark/c5daba32f6e3116c3735de6ac2f83a4f to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defmacro | |
defclass | |
` | |
Define a CLOS-style class. | |
` | |
[name parent & attributes] | |
(def forms @[]) | |
(let [init-args @[] | |
names-with-defaults (mapcat |[(keyword ($0 0)) (($0 1) :default)] | |
attributes)] | |
(each [attr-name attrs] attributes | |
# Define getters | |
(array/push forms ~(defn ,attr-name | |
,(string "Get " attr-name " from a " name) | |
[,name] (,name ,(keyword attr-name)))) | |
# Assemble list of arguments to constructor | |
(when (attrs :init?) (array/push init-args attr-name))) | |
# Define predicate | |
(array/push forms ~(defn ,(symbol name "?") | |
[obj] | |
(and (table? obj) (deep= (table/getproto obj) ,name)))) | |
(let [# Define constructor that requires any argument specified as :init? | |
init ~(fn ,(symbol "new-" name) | |
[self ,;init-args &keys attrs] | |
(let [inst @{}] | |
(merge-into inst (table ,;names-with-defaults)) | |
(merge-into inst (table ,;(mapcat |[(keyword $0) $0] init-args))) | |
(merge-into inst attrs) | |
(table/setproto inst self))) | |
# Define class prototype | |
proto ~(def ,name | |
,(string/format "%s class.\nFields: %q" | |
(string name) | |
names-with-defaults) | |
(table | |
:_fields ',(tuple/slice (map |(keyword ($0 0)) attributes)) | |
:new ,init))] | |
(array/push forms proto))) | |
forms) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment