X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Frandom.lisp;h=446f7109b2bd4dcbb7b62fdf215c75b63a9848b0;hb=869a1f5516006aba36b927d447206f686206fbc1;hp=f91ca4671535a10dbfd11c021ee75c5ff061ecf0;hpb=dd25ec9992371a9aa37e2dfdec64d9a149c54e79;p=fiveam.git

diff --git a/src/random.lisp b/src/random.lisp
index f91ca46..446f710 100644
--- a/src/random.lisp
+++ b/src/random.lisp
@@ -1,6 +1,6 @@
-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
 
-(in-package :it.bese.FiveAM)
+(in-package :it.bese.fiveam)
 
 ;;;; ** Random (QuickCheck-ish) testing
 
@@ -66,7 +66,7 @@ Examples:
   (for-all (((a b) (gen-two-integers)))
     (is (integerp a))
     (is (integerp b)))"
-  (with-unique-names (test-lambda-args)
+  (with-gensyms (test-lambda-args)
     `(perform-random-testing
       (list ,@(mapcar #'second bindings))
       (lambda (,test-lambda-args)
@@ -77,7 +77,7 @@ Examples:
               (throw 'run-once
                 (list :guard-conditions-failed))))))))
 
-;;;; *** Implementation 
+;;;; *** Implementation
 
 ;;;; We could just make FOR-ALL a monster macro, but having FOR-ALL be
 ;;;; a preproccessor for the perform-random-testing function is
@@ -183,7 +183,7 @@ BOUND)."
                             (double-float most-positive-double-float)
                             (long-float most-positive-long-float)))
            (bound (or bound (max most-positive (- most-negative)))))
-      (coerce 
+      (coerce
        (ecase (random 2)
          (0 ;; generate a positive number
           (random (min most-positive bound)))
@@ -200,16 +200,16 @@ CODE must be a generator of random integers. ALPHANUMERICP, if
 non-NIL, limits the returned chars to those which pass
 alphanumericp."
   (lambda ()
-    (if alphanumericp            
-        (loop
-           for count upfrom 0
-           for char = (code-char (funcall code))
-           until (alphanumericp char)
-           when (= 1000 count)
-             do (error "After 1000 iterations ~S has still not generated an alphanumeric character :(."
-                       code)
-           finally (return char))
-        (code-char (funcall code)))))
+    (loop
+       for count upfrom 0
+       for char = (code-char (funcall code))
+       until (and char
+                  (or (not alphanumericp)
+                      (alphanumericp char)))
+       when (= 1000 count)
+       do (error "After 1000 iterations ~S has still not generated ~:[a valid~;an alphanumeric~] character :(."
+                 code alphanumericp)
+       finally (return char))))
 
 (defun gen-string (&key (length (gen-integer :min 0 :max 80))
                         (elements (gen-character))
@@ -235,6 +235,21 @@ producs objects."
        repeat (funcall length)
        collect (funcall elements))))
 
+(defun gen-tree (&key (size 20)
+                      (elements (gen-integer :min -10 :max 10)))
+  "Returns a generator which producs random trees. SIZE control
+the approximate size of the tree, but don't try anything above
+ 30, you have been warned. ELEMENTS must be a generator which
+will produce the elements."
+  (labels ((rec (&optional (current-depth 0))
+             (let ((key (random (+ 3 (- size current-depth)))))
+               (cond ((> key 2)
+                      (list (rec (+ current-depth 1))
+                            (rec (+ current-depth 1))))
+                     (t (funcall elements))))))
+    (lambda ()
+      (rec))))
+
 (defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
                         (element-type '(unsigned-byte 8))
                         (elements (gen-integer :min 0 :max (1- (expt 2 8)))))