1. David Krentzlin
  2. data-generators

Commits

certainty  committed 7f14762

readded read-syntax. Streamlined reader

  • Participants
  • Parent commits 4d8ccaa
  • Branches 3.0.0

Comments (0)

Files changed (4)

File benchmarks/gen-string.scm

View file
   (run-benchmark)
 
   (import chicken scheme)
-  (use benchmark srfi-14 srfi-69 srfi-1 (prefix random-bsd bsd:))
+  (use benchmark srfi-14 srfi-69 srfi-1 (prefix random-bsd bsd:) numbers)
 
   (include "../data-generators-impl.scm")
 
 (module test-impl
   (run-benchmark)
   (import chicken scheme)
-  (use benchmark srfi-14 srfi-69 srfi-1 (prefix random-bsd bsd:) data-structures ports)
+  (use benchmark srfi-14 srfi-69 srfi-1 (prefix random-bsd bsd:) data-structures ports numbers)
 
   (include "../data-generators-impl.scm")
 

File data-generators-literals.scm

View file
       ((_ ?start ?stop)
        (range ?start ?stop))))
 
-  (define-constant range-literal-delimiters
+  (define-constant literal-delimiters
     '((#\{ . #\}) (#\( . #\)) (#\[ . #\])))
 
-  (define (read-range-literal #!optional (port (current-input-port)))
+  (define (read-literal finish port)
     (let* ((c (read-char port))
-           (c (cond ((assq c range-literal-delimiters) => cdr)
+           (c (cond ((assq c literal-delimiters) => cdr)
                     (else c))))
-      (read-range-literal/delim c port)))
+      (finish (read-range-literal/delim c port))))
 
-  (define (read-range-literal/delim delim port)
+  (define (read-literal/delim delim port)
     (let loop ((c (peek-char port)) (exps '()))
       (cond
        ((eof-object? c)
         (error "EOF encountered while parsing range expression"))
        ((char=? c delim)
         (read-char port) ; discard
-        `(range-spec ,@(reverse exps)))
+        (reverse exps))
        ((char-whitespace? c)
         (read-char port) ; discard whitespace
         (loop (peek-char port) exps))
         (let ((exp (read port)))
           (loop (peek-char port) (cons exp exps)))))))
 
-  (define (read-generator-literal parser #!optional (port (current-input-port)))
-    (let* ((c (read-char port))
-           (c (cond ((assq c range-literal-delimiters) => cdr)
-                    (else c))))
-      (read-generator-literal/delim c port)))
+  (define (read-range-literal #!optional (port (current-input-port)))
+    (read-literal (lambda (e) `(range-spec ,@e)) port))
 
-  (define (read-generator-literal/delim delim port)
-    (let loop ((c (peek-char port)) (exps '()))
-      (cond
-       ((eof-object? c)
-        (error "EOF encountered while parsing generator expression"))
-       ((char=? c delim)
-        (read-char port) ; discard
-        `(gen (range-spec ,@(reverse exps))))
-       ((char-whitespace? c)
-        (read-char port) ; discard whitespace
-        (loop (peek-char port) exps))
-       (else
-        (let ((exp (read port)))
-          (loop (peek-char port) (cons exp exps)))))))
+  (define (read-generator-literal #!optional (port (current-input-port)))
+    (read-literal (lambda (e) `(gen (range-spec ,@e))) port))
 
   (set-sharp-read-syntax! #\i read-range-literal)
   (set-sharp-read-syntax! #\g read-generator-literal)

File data-generators.setup

View file
  '("data-generators.so" "data-generators.import.so")
  `((version ,version)))
 
-; (install-extension
-;  'data-generators-literals
-;  '("data-generators-literals.so" "data-generators-literals.import.so")
-;  `((version ,version)))
+(install-extension
+ 'data-generators-literals
+ '("data-generators-literals.so" "data-generators-literals.import.so")
+ `((version ,version)))

File examples/json.scm

View file
 (define (gen-json-doc #!optional (nesting 5))
   (generator
    (with-output-to-string
-     (lambda ()
-       (json-write (<- (gen-json-value nesting)))))))
+     (lambda ()  (json-write (<- (gen-json-value nesting)))))))
 
+;; this is the only tricky part
+;; we need to stop the recursion at a certain level of nesting and yet
+;; we want to reduce the construction of generators to a minimum
 (define (gen-json-value nesting)
-  (generator
-   (if (positive? nesting)
-       (<- (gen-sample-of (gen-json-string) (gen-json-array nesting) (gen-json-null) (gen-json-number) (gen-json-object nesting)))
-       (<- (gen-sample-of (gen-json-string) (gen-json-null) (gen-json-number))))))
+  (let ((scalar (gen-json-scalar)))
+    (if (positive? nesting)
+        (gen-sample-of (gen-json-complex (sub1 nesting)) scalar)
+        scalar)))
+
+(define (gen-json-scalar)
+  (gen-sample-of (gen-json-null) (gen-json-string) (gen-json-number)))
 
 (define (gen-json-string)
   (with-size (range 0 20)
-    (gen-string-of (gen-char char-set:letter+digit))))
-
-(define (gen-json-object nesting)
-  (with-size (range 0 5)
-    (gen-vector-of (gen-pair-of (gen-json-string) (gen-json-value (sub1 nesting))))))
+    (gen-string-of (gen-char #\A #\z))))
 
 (define (gen-json-null)
   (gen-constant (void)))
 (define (gen-json-number)
   (gen-sample-of (gen-fixnum) (gen-real)))
 
+(define (gen-json-complex nesting)
+  (gen-sample-of (gen-json-object (sub1 nesting)) (gen-json-array (sub1 nesting))))
+
+(define (gen-json-object nesting)
+  (gen-vector-of (gen-pair-of (gen-json-string) (gen-json-value (sub1 nesting)))))
+
 (define (gen-json-array nesting)
-  (with-size (range 0 5)
-    (gen-list-of (gen-json-value (sub1 nesting)))))
+  (gen-list-of (gen-json-value (sub1 nesting))))
 
-(gen-for-each 10 print (gen-json-doc))
+;; now let's see our documents
+(with-size (range 0 20)
+  (gen-for-each 10 print (gen-json-doc 10)))