diff options
Diffstat (limited to 'weeb/struct.scm')
| -rw-r--r-- | weeb/struct.scm | 31 |
1 files changed, 25 insertions, 6 deletions
diff --git a/weeb/struct.scm b/weeb/struct.scm index fbf90c3..c3632f4 100644 --- a/weeb/struct.scm +++ b/weeb/struct.scm @@ -17,12 +17,14 @@ ;;; License along with Weeb. If not, see <https://www.gnu.org/licenses/>. (define-module (weeb struct) + #:use-module (ice-9 match) #:use-module (ice-9 regex) #:export (define-struct make-struct instance-of? with-accessors - call-with-slots)) + call-with-slots + ref)) ;; Define a new record type with the given NAME and FIELDS. (define-syntax define-struct @@ -46,8 +48,6 @@ instantiate the record's fields." (and (record? rtd) ((record-predicate type) rtd))) -;; Bind the accessors for the fields of the record RTD to local -;; variables in BODY. RTD must be a record type descriptor. (define-syntax with-accessors (syntax-rules () ((with-accessors (rtd field ...) @@ -57,9 +57,6 @@ instantiate the record's fields." ...) body ...))))) -;; Bind the slots of the record RTD to the named variables in LAMBDA. -;; This allows for pattern-matching-like access to the fields of the -;; record. (define-syntax call-with-slots (syntax-rules () ((call-with-slots rtd @@ -69,3 +66,25 @@ instantiate the record's fields." (let ((field ((record-accessor (record-type-descriptor rtd) 'field) rtd)) ...) body ...))))) + +(define* (ref obj #:rest keys) + (match keys + (() obj) + ((key rest ...) + (if (or (not (record? obj)) + (not (record-accessor (record-type-descriptor obj) key))) + #f + (apply ref + ((record-accessor (record-type-descriptor obj) key) obj) + rest))))) + +(read-hash-extend #\. + (lambda (chr port) + (let* ((sym (read port)) + (str (symbol->string sym)) + (parts (string-split str #\.))) + (let ((symbols (map string->symbol parts))) + (let ((base-obj (car symbols)) + (fields (cdr symbols))) + (let ((quoted-fields (map (lambda (f) `',f) fields))) + `(ref ,base-obj ,@quoted-fields))))))) |