git.fiddlerwoaroof.com
generate-edn.lisp
ee000f9c
 (in-package :edn.generate)
 
c5b4df0f
 (defun generate-edn-in-range (min-nodes max-nodes)
   (loop for (edn nodes) = (multiple-value-list (generate-edn))
      until (<= min-nodes nodes max-nodes)
      finally (return (values edn nodes))))
 
942890c4
 (defvar *last-edn*)
ee000f9c
 (defun generate-edn ()
942890c4
   (multiple-value-bind (edn nodes) (%generate-edn)
     (values (setf *last-edn* edn)
             nodes)))
 
 (defun last-generated ()
   (when (boundp '*last-edn*)
     *last-edn*))
 
 (defun %generate-edn ()
ee000f9c
   (case (random 3)
     (0 (generate-map))
     (1 (generate-set))
     (2 (generate-vect))))
 
 (defun generate-nil ()
c5b4df0f
   (values "nil" 1))
ee000f9c
 
 (defun prim-generate-char ()
   (code-char (+ 32 (random #.(- 128 32)))))
 
 (defun generate-string ()
c5b4df0f
   (values (loop with limit = (random 25)
              repeat limit
              collect (prim-generate-char) into chars
              finally (return (format nil "\"~a\""
                                      (serapeum:string-replace-all "\""
                                                                   (serapeum:string-replace-all
                                                                    "\\"
                                                                    (coerce chars 'string)
                                                                    "\\\\")
                                                                   "\\\""))))
           1))
ee000f9c
 
 (defun generate-int ()
c5b4df0f
   (values (princ-to-string (- (random 20000)
                               10000))
           1))
ee000f9c
 
 (defun flip-coin ()
   (= 1 (random 2)))
 
 (defun generate-float ()
c5b4df0f
   (values (format nil "~[~;-~;+~]~a.~:[~;~:*~a~]~:[~;e~:*~a~]~:[~;M~]"
                   (random 3)
                   (if (flip-coin)
                       (random 10000)
                       0)
                   (when (flip-coin)
                     (random 10000))
                   (when (flip-coin)
                     (- (random 100)
                        50))
                   (flip-coin))
           1))
ee000f9c
 
 (defun generate-character ()
c5b4df0f
   (values (format nil "\\~c" (prim-generate-char))
           1))
ee000f9c
 
 (defun generate-bool ()
c5b4df0f
   (values (if (flip-coin)
               "true"
               "false")
           1))
ee000f9c
 
 (defmacro comment (&body b)
   (declare (ignore b))
c5b4df0f
   (format nil ";foobar~%"))
ee000f9c
 
 (comment
   (or (alpha-char-p x)
       (member x '(#\! #\* #\? #\_ #\$ #\% #\& #\=))))
 
 (defun generate-capital ()
   (code-char
    (+ #.(char-code #\A)
       (random 26))))
 
 (defun generate-lower ()
   (code-char
    (+ #.(char-code #\a)
       (random 26))))
 
 (defun generate-initial-char ()
   (case (random 2)
     (0 (generate-capital))
     (1 (generate-lower))))
 
 (defun generate-middle-char ()
   (case (random 5)
     (0 (generate-capital))
     (1 (generate-lower))
     (2 (generate-capital))
     (3 (generate-lower))
     (4 (elt #(#\- #\_) (random 2)))))
 
 (defun generate-name (&optional (length 20))
   (loop repeat (+ 2 (random length))
      for char = (generate-initial-char) then (generate-middle-char)
      collect char into chars
      finally (return (coerce chars 'string))))
 
 (defun generate-symbol ()
c5b4df0f
   (values (let ((ns (generate-name 5))
                 (name (generate-name 20)))
             (if (flip-coin)
                 name
                 (format nil "~a/~a" ns name)))
           1))
ee000f9c
 
 (defun generate-keyword ()
c5b4df0f
   (values (format nil ":~a" (generate-symbol))
           1))
ee000f9c
 
 (defun generate-primitive ()
   (case (random 8)
     (0 (generate-string))
     (1 (generate-int))
     (2 (generate-bool))
     (3 (generate-float))
     (4 (generate-nil))
     (5 (generate-character))
     (6 (generate-keyword))
     (7 (generate-symbol))))
 
 (defun compound-or-primitive (&optional (primitive-func 'generate-primitive))
     (case (random 10)
942890c4
       (0 (%generate-edn))
ee000f9c
       (1 (funcall primitive-func))
       (2 (funcall primitive-func))
       (3 (funcall primitive-func))
       (4 (funcall primitive-func))
       (5 (funcall primitive-func))
       (6 (funcall primitive-func))
       (7 (funcall primitive-func))
       (8 (funcall primitive-func))
       (9 (funcall primitive-func))))
 
 (defun not-float ()
   (compound-or-primitive
    (lambda ()
      (case (random 5)
        (0 (generate-string))
        (1 (generate-int))
        (2 (generate-bool))
        (3 (generate-nil))
        (4 (generate-character))))))
 
 (defun generate-map (&optional (key-func 'not-float) (value-func 'compound-or-primitive))
   (loop
c5b4df0f
      with nodes = 0
ee000f9c
      with keys = (fset:set)
      repeat (random 10)
c5b4df0f
      for key = (loop for (next key-nodes) = (multiple-value-list (funcall key-func))
ee000f9c
                   until (not (fset:contains? keys next))
c5b4df0f
                   do (incf nodes key-nodes)
ee000f9c
                   finally
                     (fset:includef keys next)
                     (return next))
c5b4df0f
      for (value value-nodes) = (multiple-value-list (funcall value-func))
      do (incf nodes value-nodes)
ee000f9c
      collect (format nil "~a ~a" key value) into res
c5b4df0f
      finally (return (values (format nil "{~{~{~a~^~[ ~;, ~;,~; ,~]~}~}}"
                                      (mapcar (serapeum:op (list _1 (random 3)))
                                              (remove-duplicates res :test 'equal)))
                              nodes))))
ee000f9c
 
 
 (defun generate-set (&optional (value-func 'not-float))
   (loop
c5b4df0f
      with nodes = 0
ee000f9c
      repeat (random 19)
c5b4df0f
      for (value value-nodes) = (multiple-value-list (funcall value-func))
ee000f9c
      collect value into res
c5b4df0f
      do (incf nodes value-nodes)
      finally (return (values (format nil "#{~{~{~a~^~[ ~;, ~;,~; ,~]~}~}}"
                                      (mapcar (serapeum:op (list _1 (random 3)))
                                              (remove-duplicates res :test 'equal)))
                              nodes))))
ee000f9c
 
 (defun generate-vect (&optional (value-func 'compound-or-primitive))
   (loop
c5b4df0f
      with nodes = 0
ee000f9c
      repeat (random 19)
c5b4df0f
      for (value value-nodes) = (multiple-value-list (funcall value-func))
ee000f9c
      collect value into res
c5b4df0f
      do (incf nodes value-nodes)
      finally (return (values (format nil "[~{~{~a~^~[ ~;, ~;,~; ,~]~}~}]"
                                      (mapcar (serapeum:op (list _1 (random 3)))
                                              res))
                              nodes))))