Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defmacro ^:private def-super-record
- "Defines an abstract super record that can be extended by extend-record. Also defines a protocol with the same name
- except suffixed with 'able'. The protocol contains accessor functions for each field, named by the field name prefixed
- with 'get-'."
- [name fields]
- (let [protocol-name (symbol (str name "able"))]
- `(do
- (def ~name '~fields)
- (defprotocol ~protocol-name
- ~@(for [field fields
- :let [field-accessor (symbol (str "get-" field))]]
- `(~field-accessor [~'this]))))))
- (defmacro ^:private extend-record
- "Extends a super record (by inheriting its fields and implementing its protocol). Fields in the super record may be
- accessed by a call to get-fieldname to avoid switching on the record's type."
- [name parents fields & remainder]
- (let [parent-vars (map resolve parents)]
- `(defrecord
- ~name
- ~(into [] (concat (flatten (map deref parent-vars)) fields))
- ~@(apply concat
- (for [parent parents
- :let [parent-protocol (symbol (str parent "able"))]]
- `(~parent-protocol
- ~@(for [field @(resolve parent)
- :let [field-accessor (symbol (str "get-" field))]]
- `(~field-accessor [~'this] ~field)))))
- ~@remainder)))
- => #'user/def-super-record
- => #'user/extend-record
- (def-super-record SuperRecord [super-field])
- => SuperRecordable
- (extend-record SubRecord [SuperRecord] [sub-field])
- => user.SubRecord
- (def test-subrecord (->SubRecord 0 1))
- => #'user/test-subrecord
- (when (satisfies? SuperRecordable test-subrecord) (get-super-field test-subrecord))
- => 0
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement