[functional-tests] start a (generators) library

This commit is contained in:
Joe Thornber 2017-08-17 12:13:57 +01:00
parent 0730016cc2
commit a7d0e687e8
2 changed files with 22 additions and 15 deletions

View File

@ -0,0 +1,18 @@
(library
(generators)
(export make-const-generator
make-uniform-generator)
(import (rnrs)
(srfi s27 random-bits))
(define (make-const-generator n)
(lambda () n))
(define (make-uniform-generator low hi)
(assert (<= low hi))
(let ((range (- hi low)))
(lambda ()
(+ low (random-integer range))))))

View File

@ -3,23 +3,12 @@
(export generate-xml)
(import (rnrs)
(list-utils)
(generators)
(xml)
(fmt fmt)
(only (srfi s1 lists) iota)
(srfi s27 random-bits))
;;;----------------------------------------
(define (make-const-generator n)
(lambda () n))
(define (make-uniform-generator low hi)
(assert (<= low hi))
(let ((range (- hi low)))
(lambda ()
(+ low (random-integer range)))))
(define (div-down n d)
(floor (/ n d)))
@ -30,9 +19,9 @@
(creation-time . 0)
(snap-time . 0))
(tag 'range_mapping `((origin-begin . 0)
(data-begin . ,data-offset)
(length . ,nr-mappings)
(time . 1)))))
(data-begin . ,data-offset)
(length . ,nr-mappings)
(time . 1)))))
(define (generate-xml max-thins max-mappings)
(let ((nr-thins ((make-uniform-generator 1 max-thins)))