procgen  interlace.scm at tip

File lib/interlace.scm from the latest check-in


; [ʞ] interlace.scm
;  ~ lexi hale <lexi@hale.su>
;  © affero general public license
;  > (load "lib/lisp-macro.scm")
;    (load "lib/interlace.scm")

; (interlace) solves  an old  problem. what kind  of data
; structure do  you use when  you need both  an aggregate
; (a  list,  a vector)  of  items  but  also to  be  able
; to  individually refer  to  those items  by name?  this
; problem is effectively unsolvable  in C and C++ without
; inordinate  runtime  overhead,  and there's  no  native
; syntax for it in Scheme. however, by rewriting the AST,
; we can implement a clean, performant, low-cost solution
; ourselves, thanks to the  fact that (let*) bindings are
; expressions.
;
; interlace takes  a constructor function,  e.g. (vector)
; or (list), a  list of items, and  returns an expression
; calling that constructor on a list of all items defined
; in it. if an item is proceded by an atom that ends in a
; period (e.g.  “name.”), it  is defined within  a (let*)
; expression,  and its  name is  then included  among the
; arguments passed to the constructor function.
;
; the upshot  of this is  that items can  reference other
; items  by  name  *as   they  are  being  defined*.  for
; instance:
;
; ex:	(define verbs (interlace vector
;			talk. (verb "talk" "talking" "talked")
;				(phrasal-verb talk "to")
;				(phrasal-verb talk "about")
;			(verb "say" "saying" "said)))
;
; here, the function to  generate a phrasal verb exhibits
; backreference to  an existing verb  contained alongside
; it  in the  vector.  note that  the  name bindings  are
; ephemeral; they do not survive the immediate context of
; the constructor.

(define-macro (interlace . body)
  ; given a list with both named and nameless members, identify
  ; which is which and instate the vector.
  (define (name? term)
	; given a symbol, determine wheter it is a name, and if so return
	; that name as a string and without the name-marking suffix ‹.›
	; otherwise, return #f
	(define (coda str) (substring str
								  (- (string-length str) 1)
								  (string-length str)))
	(if (not (symbol? term)) #f
		(let* ([term-string (symbol->string term)]
			   [final-char (coda term-string)])
		  (if (not (equal? final-char ".")) #f
			  (string->symbol(substring term-string 0 (- (string-length term-string) 1)))))))

  (define (divide-entries lst @named @nameless)
	; given a list, return a pair [ x . y ] such that x is a list
	; of named terms ( name . term ) and y is a list of nameless
	; terms.
	(if (eq? lst '()) (cons @named @nameless)
		(let* ([head (car lst)]
			   [tail (cdr lst)]
			   [name (name? head)])
		  (if (eqv? name #f)
			  ; there's no name term; add this to the nameless
			  ; list and move on the next iteration
			  (divide-entries tail @named (cons head @nameless))

			  ; head is a name, so determine its value, cons them
			  ; together, and add that cons to the list of named
			  ; lists
			  (let* ([val (car tail)]
					 [new-tail (cdr tail)]
					 [named (list name val)])
				(divide-entries new-tail
					(cons named @named) @nameless))))))
  (let* ([structure          (car body)]
		 [-structure-entries (cdr body)]
		 [-divided-lists     (divide-entries -structure-entries '() '())]
		 [named-terms        (car -divided-lists)]
		 [nameless-terms     (cdr -divided-lists)])
	`(let* ,(reverse named-terms)
	  (,structure ,@nameless-terms
				  ,@(map car named-terms)))))