procgen  fn-struct.scm at tip

File lib/fn-struct.scm from the latest check-in


; [ʞ] fn-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)