(defun random-string (length-limit)
  (let* ((length (1+ (random length-limit)))
         (str (make-string length))
         (a (char-code #\A)))
    (dotimes (i length)
      (setf (aref str i) (code-char (+ a (random 26)))))
    str))

(defun gen-grove (limit)
  (let ((stack nil) (current nil))
    (flet ((push-stack ()
             (prog1 (push current stack)
               (setq current nil)))
           (pop-stack ()
             (prog1 current
               (setq current (pop stack)))))
      (loop with depth = 1 and count = 2 and key
         while (> depth 0)
         initially (push-stack)
         for op = (random (ceiling (/ limit (log (incf count)))))
         if (> op depth)
           do (push-stack)
              (incf depth)
           and maximize depth into max-depth
         else
           do (setq key (intern (random-string 16)))
           and if (evenp op)
             do (push (cons key (random-string 32)) current)
           else
             maximize (length current) into max-width
             and do (push (cons key (pop-stack)) current)
                    (decf depth)
         finally (return (values current count max-depth max-width))))))

(defun make-and-populate-instance (class bindings)
  (let ((object (make-instance class)))
    (loop for (slot . value) in bindings
      do (setf (slot-value object slot) value))
    object))

(defun make-class (bindings)
  (let ((anonymous-class
         (make-instance 'standard-class
           :direct-superclasses (list (find-class 'standard-object))
           :direct-slots (mapcar
                          (lambda (binding) `(:name ,(car binding)))
                          bindings))))
    (#+sbcl sb-mop:remove-direct-subclass
     #+openmcl ccl:remove-direct-subclass
     (find-class 'standard-object)
     anonymous-class)
    anonymous-class))

(defun grove-to-anonymous-instance (grove)
  (let ((bindings
         (loop for (key . value) in grove
            if (consp value)
              do (setq value (grove-to-anonymous-instance value))
            collect (cons key value))))
    (make-and-populate-instance (make-class bindings) bindings)))

(defun run-test (grove-limit repeat)
  (multiple-value-bind (grove count max-depth max-width)
      (gen-grove grove-limit)
    (format *trace-output*
            ";;; Testing grove of count ~D, max-depth ~D, ~
             max-width ~D. ;;;~%"
            count max-depth max-width)
    (dotimes (i repeat)
      (format *trace-output* "~%;;; Round ~D ;;;~%" i)
      (time (grove-to-anonymous-instance grove)))))