; 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))))