; [ʞ] struct.scm
; ~ lexi hale <lexi@hale.su>
; © affero general public license
; > (load "lib/struct.scm")
;
; generates immutable, relatively efficient structs. declare
; a struct type x with
; (define x (struct 'field1 'field2)
; create a record y of that type with
; (define y (x 123 456))
; access field1 of record y with
; (y 'field1)
; update field2 of record y with
; (y 'field2 123) → new record (field1 = 123; field2 = 123)
;
; this unit also includes a few utility function that
; chicken scheme conveniently "forgot." i apologize for
; the implementation of (list-head). i was very tired.
; return a sub-list of lst up to ct (inverse of list-tail)
(define (list-head lst ct)
(let* ([reverse-lst (reverse lst)]
[idx (- (length lst) (+ 1 ct))])
(reverse (list-tail reverse-lst idx))))
; i'm not proud of this
; search for the first occurence of `term` in list lst.
; equal? is used by default; an alternate predicate may
; be passed after `term`
(define (member-index lst term . opt)
(let ([predicate (if (eq? '() opt) equal?
(car opt))])
(define (search idx l)
(if (eq? l '()) #f
(if (predicate (car l) term) idx
(search (+ 1 idx) (cdr l)))))
(search 0 lst)))
; generate a new struct type and return it as a function
; that may be called to instantiate that type.
(define (struct . keys)
(define (generate-record . vals)
; the function returned by a (struct) call and called
; to generate a new struct by functional-update syntax
(define (struct-ref key)
; searches the struct for the named key and if found
; return its index, otherwise return #f
(let ([query-idx (member-index keys key)])
(if (eq? #f query-idx) #f
(list-ref vals query-idx))))
(define (update-record key val)
; return a new version of this construct with the same
; field names and values except for { key = val }
(let* ([field-idx (member-index keys key)]
[new-tail (list-tail vals (+ 1 field-idx))]
[new-head (list-head vals (- field-idx 1))])
(apply generate-record (append new-head (list val) new-tail))))
; are values specified for every field and no more?
; TODO: consider loosening the restriction - could
; there be some use to allowing the used to add fields
; only accessible through the record->list facility?
(if (not (= (length vals) (length keys))) #f
(lambda access
; returned by generate-record, this function is called
; whenever a struct is accessed
(case (length access)
;determine operation to perform
((0) vals) ; return list of values
((1) (struct-ref (car access))); search for value
((2) (update-record (car access) (cadr access)))
(else #f))))) ; no other functions currently available
; keys are now stored in the closure; return the
; (generate-record) function to the user so she can
; call it to instantiate the defined struct.
generate-record)