procgen  Check-in [ee227e70ef]

Added lib/bot-gambit.scm version [85a6f672ec].

            1  +(define-macro (rule . body)
            2  +  (define (make-cases ct body acc)
            3  +    (if (eq? body '()) acc
            4  +      (make-cases (+ ct 1) (cdr body)
            5  +		(cons (list (list ct) (cons 'string-append (car body))) acc))))
            6  +  (list 'define (car body)
            7  +	(cons 'case (cons (list 'random-integer (length (cdr body)))
            8  +	  (make-cases 0 (cdr body) '()) ))))
            9  +
           10  +(define (pick ar)
           11  +  (vector-ref ar (random-integer (vector-length ar))))
           12  +
           13  +(define-macro (one-of . body)
           14  +	(define (make-cases ct body acc) ; accumulator func
           15  +	; this could probably be done much more cleanly through
           16  +	; judicious use of fold or whatever it's called but my
           17  +	; brain is too broken
           18  +		(if (eq? body '()) ; then
           19  +			acc 
           20  +		; else
           21  +			(make-cases (+ 1 ct) (cdr body) ; recurse!
           22  +				(cons `((,ct) ,(car body)) acc)))) ; the rule
           23  +
           24  +	`(case (random-integer ,(length body)) ; final output
           25  +		,@(make-cases 0 body '()))
           26  +)
           27  +(random-source-randomize! default-random-source)

Added lib/bot.scm version [517500dd79].

            1  +; prep the random number generator
            2  +(import (chicken random))
            3  +(set-pseudo-random-seed! (random-bytes))
            4  +
            5  +; generates a (case) structure that randomly returns
            6  +; one of its branches at equal probability
            7  +(define-for-syntax (@one-of case-fn strs)
            8  +  ; attach a unique integer value to every item in the
            9  +  ; list, descending from (length strs) to 0
           10  +  (define (zip lst)
           11  +	; inefficient but fun(ctional) way
           12  +	(define (long-cons acc new)
           13  +	  (cons (cons (length acc) new) acc))
           14  +	(foldl long-cons '() lst)) 
           15  +
           16  +  ; return the following list structure
           17  +  `(case (pseudo-random-integer ,(length strs))
           18  +	 ,@(map case-fn (zip strs))))
           19  +
           20  +; create the case structure for rule expansion
           21  +(define-for-syntax (@rewrite-patterns patterns)
           22  +  (define (nest-case pair)
           23  +	(cons (list (car pair))
           24  +		  (cdr pair)))
           25  +
           26  +  (define (wrap pat) 
           27  +	(if (eq? (cdr pat) '()) ;then
           28  +		pat
           29  +		; else
           30  +		(list (cons 'string-append pat))))
           31  +
           32  +  (let ([branches (map wrap patterns)])
           33  +	(@one-of nest-case branches)))
           34  +
           35  +
           36  +; exports
           37  +
           38  +	; randomly select and return one of its arguments at runtime
           39  +	(define-macro (one-of . strs)
           40  +				  (define (flat-case pair)
           41  +					(list (list (car pair))
           42  +						  (cdr pair)))
           43  +				  (@one-of flat-case strs))
           44  +
           45  +	; generates a function that picks and applies one of the
           46  +	; patterns passed to it. inner patterns can be expanded
           47  +	; with the inner macro (@)
           48  +	(define-macro (rule . body)
           49  +				  (let ([decl (car body)]
           50  +						[patterns (cdr body)])
           51  +					`(define ,decl
           52  +					   (define-macro (@ . tree) (@rewrite-patterns tree))
           53  +					   ,(@rewrite-patterns patterns))))
           54  +
           55  +	(define (pick ar)
           56  +		(vector-ref ar (pseudo-random-integer (vector-length ar))))

Added lib/lisp-macro.scm version [abec99f409].

            1  +; [ʞ] lisp-macro
            2  +; enable use of the define-macro syntax
            3  +; - example -
            4  +; 		(define-macro (if-or-f . body)
            5  +;			`(if ,(car body) ,(cadr body) #f))
            6  +
            7  +(define-syntax define-macro
            8  +	(er-macro-transformer (lambda (exp r c)
            9  +		`(define-syntax ,(caadr exp)
           10  +			(er-macro-transformer
           11  +				(lambda (,(cdadr exp) id-rename id-compare)
           12  +					(let ((,(cdadr exp) (cdr ,(cdadr exp))))
           13  +			 			,@(cddr exp))))))))