procgen  Artifact [517500dd79]

Artifact 517500dd7920b174b50a6d3c578560a8ec1069c173e48391aef60751f5edcf39:


; prep the random number generator
(import (chicken random))
(set-pseudo-random-seed! (random-bytes))

; generates a (case) structure that randomly returns
; one of its branches at equal probability
(define-for-syntax (@one-of case-fn strs)
  ; attach a unique integer value to every item in the
  ; list, descending from (length strs) to 0
  (define (zip lst)
	; inefficient but fun(ctional) way
	(define (long-cons acc new)
	  (cons (cons (length acc) new) acc))
	(foldl long-cons '() lst)) 

  ; return the following list structure
  `(case (pseudo-random-integer ,(length strs))
	 ,@(map case-fn (zip strs))))

; create the case structure for rule expansion
(define-for-syntax (@rewrite-patterns patterns)
  (define (nest-case pair)
	(cons (list (car pair))
		  (cdr pair)))

  (define (wrap pat) 
	(if (eq? (cdr pat) '()) ;then
		pat
		; else
		(list (cons 'string-append pat))))

  (let ([branches (map wrap patterns)])
	(@one-of nest-case branches)))


; exports

	; randomly select and return one of its arguments at runtime
	(define-macro (one-of . strs)
				  (define (flat-case pair)
					(list (list (car pair))
						  (cdr pair)))
				  (@one-of flat-case strs))

	; generates a function that picks and applies one of the
	; patterns passed to it. inner patterns can be expanded
	; with the inner macro (@)
	(define-macro (rule . body)
				  (let ([decl (car body)]
						[patterns (cdr body)])
					`(define ,decl
					   (define-macro (@ . tree) (@rewrite-patterns tree))
					   ,(@rewrite-patterns patterns))))

	(define (pick ar)
		(vector-ref ar (pseudo-random-integer (vector-length ar))))