suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

new files

Browse Source 
svn: r9706
This commit is contained in:
Sam Tobin-Hochstadt 2008-05-06 22:53:30 +00:00
parent 03d2cb7dd9
commit 6825658675
5 changed files with 1227 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
collects/tests/typed-scheme/succeed/foldo.scm Normal file
View File

@ -0,0 +1,58 @@
(module foldo mzscheme
(require (lib "file.ss")(lib "match.ss"))
(provide apply-to-scheme-files)
(define-syntax (define-excluder stx)
(define (path->clause c)
(syntax-case c ()
[(item ...)
#`[`(#,@(reverse (syntax-e #'(item ...))) ,_ (... ...)) #t]]
[item
#`[`(item) #t]]))
(syntax-case stx ()
[(_ name path ...)
(with-syntax ([(match-clause ...) (map path->clause (syntax-e #'(path ...)))])
#`(define (name p )
(let* ([dirnames (map path->string (explode-path p))])
(match (reverse dirnames) ; goofy backwards matching because ... matches greedily
match-clause ...
[_ #f]))))]))
(define-excluder default-excluder
"compiled" ".svn" #;("collects" "drscheme") #;("collects" "framework"))
(define exclude-directory? (make-parameter default-excluder))
;; ----------------------------------------
;; apply-to-scheme-files: (path[file] -> X) path[directory] -> (listof X)
;; applies the given function to each .ss or .scm file in the given directory
;; hierarchy; returns all results in a list
(define (apply-to-scheme-files f root )
;;FOLD-FILES
(fold-files
(lambda (path kind acc)
(case kind
[(file)
(let ([extension (filename-extension path)])
(cond
[(not extension) acc ]
[(regexp-match #rx"(ss|scm)$" extension)
(let ([resl (f path)])
(if resl
(cons resl acc)
acc ))]
[else acc ]))]
[(dir)
(let* ([p (normalize-path path root)])
(if ((exclude-directory?) p)
(values acc #f)
acc ))]
[(link) acc ]
[else (error "never happen")]))
'()
root
))
)

6
collects/tests/typed-scheme/succeed/list-ref-vec.ss Normal file
View File

@ -0,0 +1,6 @@
#lang typed-scheme
(: x : (Listof (Vectorof Integer)))
(define x (list (vector 1 2 3)))
(list-ref x 0)

539
collects/tests/typed-scheme/succeed/metrics.ss Normal file
View File

@ -0,0 +1,539 @@
#lang typed-scheme
(provide results run-all-tests)
#;(require "../list.scm"
"../etc.ss")
(require/typed apply-to-scheme-files
((Path -> (Listof (Listof (U #f (Listof (U Number #f))))))
Path
-> (Listof (U #f (Listof (Listof ( U #f (Listof (U Number #f)))))))) "foldo.scm")
(define-type-alias top Any)
(define-type-alias str String)
(require/typed filename-extension (Path -> (U #f Bytes)) (lib "file.ss"))
(require/typed normalize-path (Path Path -> Path) (lib "file.ss"))
(require/typed explode-path (Path -> (Listof Path)) (lib "file.ss"))
(require/typed srfi48::format ( Port String String top .. -> top) "patch.ss")
;; FIXME - prefix
#;(require/typed srfi48:format ( Port String String top .. -> top) (prefix srfi48: (lib "48.ss" "srfi")))
(require (lib "match.ss")
;(lib "file.ss")
;(lib "list.ss")
;(lib "etc.ss")
(prefix-in srfi13: (lib "13.ss" "srfi"))
;(prefix srfi48: (lib "48.ss" "srfi"))
)
(define-type-alias Sexpr Any)
(define-type-alias number Number)
(define-type-alias boolean Boolean)
(define-type-alias NumF (U number #f))
(define-type-alias NumB (U boolean number))
;;C is either Sexpr or Listof Sepr
;;X = (Listof (U number #f)) - not needed as a parameter
(define-type-alias (Unit X C) ((C -> X) -> (Path -> (Listof (U #f X)))))
;; ============================================================
;; CONFIG
(define: COLLECTS-PATH : (Parameter Path Path ) (make-parameter (build-path "/proj/scheme/plt/collects" #;"~/svn/plt/collects/")))
(define: PLANET-CODE-PATH : (Parameter Path Path) (make-parameter (build-path "~/Desktop/most-recent-archives/" #;"~/local/src/planet/most-recent-archives/")))
; collects-path : a path to the collects directory to compare
; planet-code-path : a path to the "other" code to compare (i.e. unpacked, most recent versions
; of all planet packages)
;; ============================================================
;; STATS
;; t-test : (listof number) (listof number) -> number
;; computes t value for the given sequences. t-tests measure
;; the extent to which difference in mean between two sets of
;; _interval-valued_ samples (e.g. distances, times, weights, counts ...)
;; can be explained by chance. Generally speaking, higher absolute
;; values of t correspond to higher confidence that an observed difference
;; in mean cannot be explained by chance.
(define: (t-test [seqA : (Listof number)] [seqB : (Listof number)]) : number
(manual-t-test
(avg seqA) (avg seqB)
(variance seqA) (variance seqB)
(length seqA) (length seqB)))
(define: (manual-t-test [avga : number] [avgb : number] [vara : number]
[varb : number] [cta : number] [ctb : number]) : number
(/ (- avga avgb)
(sqrt (+ (/ vara cta) (/ varb ctb)))))
;; chi-square : (listof [0,1]) (listof [0,1]) -> number
;; chi-square is a simple measure of the extent to which the
;; difference in the frequency of 0's and 1's in the first
;; sequence and their frequency in the second sequence can
;; be explained by chance. higher numbers means higher confidence
;; that they cannot.
(define: (chi-square [seqA : (Listof number)] [seqB : (Listof number)]) : number
(with-handlers ([exn:fail? (lambda: ([e : str]) +nan.0)])
(let* ([ct-a (length seqA)]
[ct-b (length seqB)]
[total-subjects (+ ct-a ct-b)]
[a-hits (apply + seqA)]
[b-hits (apply + seqB)] ;; these assume that the data is coded as 1 = present, 0 = not present
[a-misses (- ct-a a-hits)]
[b-misses (- ct-b b-hits)]
[table
`((,a-hits ,b-hits)
(,a-misses ,b-misses))]
[expected (lambda: ([i : Integer] [j : Integer])
(/ (* (row-total i table) (col-total j table)) total-subjects))])
(exact->inexact
(table-sum
(lambda: ([i : Integer] [j : Integer])
(/ (sqr (- (expected i j) (table-ref i j table))) (expected i j)))
table)))))
;; ============================================================
;; UNITS OF MEASUREMENT IMPLEMENTATIONS
;; per-module : path ((listof expr) -> (number | #f)) -> (path -> (listof (number | #f))) === Unit P
(pdefine: (X) (per-module [f : ((Listof Sexpr) -> X )]) : (Path -> (cons (U #f X) '()))
(lambda: ([path : Path])
(with-handlers ([exn:fail:read? (lambda: ([e : Void]) (list #f))]) ;; with handler
(let ([initial-sexp (with-input-from-file path read)])
(match initial-sexp
[`(module ,_ ,_ . , (? list? bodies)) ;; FIXME - use ... instead of .
(list (f bodies))]
[_ (list #f)])))))
;; per-module-top-level-expression : path (expr -> (number | #f)) -> (path -> (listof (number | #f)))
(define: (per-module-top-level-expression [f : (Sexpr -> (Listof NumF))] ) : ( Path -> (Listof (U #f (Listof NumF))))
(let ([calc (per-module (lambda: ([exprs : (Listof Sexpr)]) (map f exprs)))])
(lambda: ([p : Path]) (let* ([r (calc p)]
[carr (car r)]) ;;carr added
(if carr carr
(list carr)))))) ;; list carr instead of r
;; ============================================================
;; BASIC CALCULATIONS
;; (for use with metric definitions below)
;; ----------------------------------------
;; depth
(define: (sexp-depth [sexp : Any]) : number
(cond
[(list? sexp) ;; (pair? sexp)
(+ (max-sexp-depth sexp) 1)]
[else 0]))
(define: (max-sexp-depth [losx : (Listof Any)]) : number
(improper-foldr (lambda: ([t : Any] [r : number]) (max (sexp-depth t) r)) 0 losx))
(define: (avg-sexp-depth [sexps : (Listof Any)]) : number
(cond
[(null? sexps) 0]
[else (avg (map sexp-depth sexps))]))
;; ----------------------------------------
;; setbang counts
(define-type-alias (IList e) (mu x (Un e '() (cons e x))))
;; count-setbangs/ilist : ((ilistof expr) -> number)
(define: (count-setbangs/ilist [exprs : (Listof Any)]) : number
(apply + (imap count-setbangs/expr exprs)))
;; FIXME - changes having to do with match ...
(define: (count-setbangs/expr [expr : Any]) : number
(match expr
[`(,(? setbang?) . ,rest ) ;(,(? setbang?) ,rest ...)
(if (list? rest)
(+ 1 (count-setbangs/ilist rest))
0)] ;; mostly occurs in syntax patterns
[('quote _) 0]
[('quasiquote _) 0] ; undercount potentially, but how many `,(set! ...)'s can there be?
[`(,e1 . ,e2)
(if (list? expr)
(count-setbangs/ilist expr)
(error " l" expr ))] ;;FIXME - do something intelligent here
[_ 0]))
;; setbang? : sexp -> boolean
(define: (setbang? [v : Any]) : Any
(and (symbol? v)
(regexp-match #rx"^set(-.*)?!" (symbol->string v))))
;; count-fns
(define: (count-fns-with-setbangs [exprs : (Listof Sexpr)]) : number
(apply + (map (lambda: ([e : Sexpr]) (if (= (count-setbangs/expr e) 0) 0 1)) exprs)))
(define: (module-has-setbangs? [exprs : (Listof Sexpr)]) : Boolean
(ormap expr-uses-setbangs? exprs))
(define: (expr-uses-setbangs? [expr : Sexpr]) : Boolean
(not (= (count-setbangs/expr expr) 0)))
(define: (setbangs-per-1000-atoms [exprs : (Listof Any)]) : NumF
(if (null? exprs)
#f
(let ([set!s (count-setbangs/ilist exprs)]
[atoms (atoms exprs)])
(* (/ set!s atoms) 1000.0))))
;; ----------------------------------------
;; contracts
(define: (uses-contracts [exprs : (Listof Sexpr)]) : Boolean
(ormap (lambda: ([e : Sexpr])
(match e
[`(provide/contract . ,_) #t]
[_ #f]))
exprs))
(define: (contracted-provides [exprs : (Listof Sexpr)]): number
(foldl
(lambda: ([t : Sexpr] [r : number])
(match t
;; FIXME match ...
[`(provide/contract . ,p ) ;(provide/contract ,p ...)
(if (list? p)
(+ (length p) r)
r)] ;; extra case added
[_ r]))
0
exprs))
;; FIXME - same problem with match ...
(define: (uncontracted-provides [exprs : (Listof Sexpr)]) : number
(foldl
(lambda: ([t : Sexpr] [r : number])
(match t
[`(provide . ,p ) ;(provide ,p ...)
(if (list? p)
(+ (length p) r)
r)]
[_ r]))
0
exprs))
;; ----------------------------------------
;; macros
(define: (number-of-macro-definitions [expr : Sexpr]) : number
(match expr
[`(define-syntax ,_ ...) 1]
[`(define-syntaxes (,s . ,r ). ,_ ) ;`(define-syntaxes (,s ...) ,_ ...)
(if (and (list? expr)(list? r))
(length (cons s r));;s -> cadr expr
(error "corrupted file"))]
[`(define-syntax-set (,s . ,r) . ,_ ) ;(define-syntax-set (,s ...) ,_ ...)
(if (and (list? expr) (list? r))
(length (cons s r))
(error "corrupted file"))]
[_ 0]))
(define: (num-of-define-syntax [exprs : (Listof Sexpr)]) : number
(foldl (lambda: ([t : Sexpr] [r : number]) (+ (number-of-macro-definitions t) r)) 0 exprs))
;; ----------------------------------------
;; expression size
(define: (atoms [sexp : Any]) : number
(cond
[(null? sexp) 0]
[(not (pair? sexp)) 1]
[else (+ (atoms (car sexp)) (atoms (cdr sexp)))]))
(define: (max-atoms [exprs : (Listof Sexpr)]) : NumF
(let ([atom-counts (map atoms exprs)])
(if (null? atom-counts)
#f
(apply max 0 atom-counts)))) ;; FIXME: expected at least 2 argument---> 0 added !!!
(define: (avg-atoms [exprs : (Listof Sexpr)]) : NumF
(let ([atom-counts (map atoms exprs)])
(if (null? atom-counts)
#f
(avg (map atoms exprs)))))
(define: (total-atoms [exprs : (Listof Sexpr)]) : number
(apply + (map atoms exprs)))
;; ============================================================
;; METRIC DEFINITIONS
;; 'a 'b metric : (string * (listof sexp -> 'a option) * ((listof 'a) (listof 'a) -> 'b)
(define-typed-struct (b c d) metric ([analysis-unit : (Unit (Listof NumF) c)]
[computation : (c -> d)]
[>display : ((Listof d) (Listof d) -> b)]))
(define-type-alias Metric metric)
(define-type-alias Table (Listof (Listof Number)))
(define-type-alias Atom-display (cons Symbol (Listof Number)))
(define: (standard-display [name : Symbol]
[summarize : ((Listof number) -> number)]
[significance-test : ((Listof number)(Listof number) -> number)])
: ((Listof NumF) (Listof NumF) -> Atom-display)
;; FIXME - use lambda instead of (define ((
(lambda: ([seqA : (Listof NumF)] [seqB : (Listof NumF)])
(let ([clean-seqA (nonfalses seqA)]
[clean-seqB (nonfalses seqB)])
(list name (summarize clean-seqA) (summarize clean-seqB) (significance-test clean-seqA clean-seqB)))))
(pdefine: (c) (interval [u : (Unit (Listof NumF) c)]
[name : Symbol]
[compute : (c -> NumF)])
: (Metric Atom-display c NumF)
(make-metric u compute (standard-display name avg t-test)))
(pdefine: (c) (count [u : (Unit (Listof NumF) c)]
[name : Symbol]
[compute : (c -> Boolean)])
: (Metric Atom-display c NumF)
(make-metric u (lambda: ([es : c]) #{(if (compute es) 1 0) :: NumF}) (standard-display name avg chi-square)))
(pdefine: (c) (combine-metrics [ms : (Listof (Metric Atom-display c NumF))])
: (Metric (Listof Atom-display) c (Listof NumF))
(let ([u (metric-analysis-unit (car ms))])
;; This test now redundant b/c of typechecking
(unless (andmap (lambda: ([m : (Metric Atom-display c NumF) ]) (eq? u (metric-analysis-unit m))) ms)
(error 'combine-metrics "all combined metrics must operate on the same unit of analysis"))
(make-metric
u
(lambda: ([exprs : c] ) (map (lambda: ([m : (Metric Atom-display c NumF)]) ((metric-computation m) exprs)) ms))
(lambda: ([seqA : (Listof (Listof NumF))] [seqB : (Listof (Listof NumF))])
(map (lambda: ([m : (Metric Atom-display c NumF)]
[sA : (Listof NumF)]
[sB : (Listof NumF)])
((metric->display m) sA sB)) ms (pivot seqA) (pivot seqB))))))
;; FIXME - should go in helper file
;; FIXME - (filter (lambda (x) x) l)
(pdefine: (X) (nonfalses [l : (Listof (U #f X))]) : (Listof X)
(let: loop : (Listof X) ([lst :(Listof (U #f X)) l])
(if (null? lst)
'()
(let ([x (car lst)])
(if x
(cons x (loop (cdr lst)))
(loop (cdr lst)))))))
(define: (avg [l : (Listof number)]) : number
(/ (exact->inexact (apply + l)) (length l)))
(define: (avg* [l : (Listof number)]) : number
(avg (nonfalses l)))
(define-syntax define-metrics
(syntax-rules ()
[(define-metrics all-metrics-id unit-of-analysis type (name kind fn) ...) ;;TYPE ADDED !!!!
(begin
(define: u : ((type -> (Listof NumF)) -> (Path -> (Listof (U #f(Listof NumF))))) unit-of-analysis )
(define: name : (Metric Atom-display type NumF) (kind u 'name fn )) ...
(define: all-metrics-id : (Metric (Listof Atom-display) type (Listof NumF)) (combine-metrics (list name ...))))]))
(define-metrics module-metrics #{ per-module @ (Listof NumF)} (Listof Sexpr)
(maximum-sexp-depth interval max-sexp-depth)
(average-sexp-depth interval avg-sexp-depth)
(number-of-setbangs/mod interval count-setbangs/ilist)
(number-of-exprs interval #{length @ (Listof Sexpr)})
(uses-setbang?/mod count module-has-setbangs?)
(uses-contracts? count uses-contracts)
(number-of-contracts interval contracted-provides)
(num-uncontracted-provides interval uncontracted-provides)
(number-of-macro-defs interval num-of-define-syntax)
(maximum-num-atoms interval max-atoms)
(average-num-atoms interval avg-atoms)
(total-num-atoms/mod interval total-atoms)
(set!s-per-1000-atoms interval setbangs-per-1000-atoms))
(define-metrics tl-expr-metrics per-module-top-level-expression Sexpr
(uses-setbang?/fn count expr-uses-setbangs?)
(number-of-setbangs/fn interval count-setbangs/expr)
(total-num-atoms/fn interval atoms))
(define: all-metrics : (cons (Metric (Listof Atom-display) (Listof Sexpr) (Listof NumF))
(cons (Metric (Listof Atom-display) Sexpr (Listof NumF))
'() ))
(list module-metrics tl-expr-metrics))
;; ============================================================
;; EXPERIMENT RUNNING
;; FIXME - everything in untyped file (foldo.ss) b/c fold-files has terrible api
#;(define-syntax (define-excluder stx)
(define (path->clause c)
(syntax-case c ()
[(item ...)
#`[`(#,@(reverse (syntax-e #'(item ...))) ,_ (... ...)) #t]]
[item
#`[`(item) #t]]))
(syntax-case stx ()
[(_ name path ...)
(with-syntax ([(match-clause ...) (map path->clause (syntax-e #'(path ...)))])
#`(define: (name [p : Path]) : top
(let* ([dirnames (map path->string (explode-path p))])
(match (reverse dirnames) ; goofy backwards matching because ... matches greedily
match-clause ...
[_ #f]))))]))
#;(define-excluder default-excluder
"compiled" ".svn" #;("collects" "drscheme") #;("collects" "framework"))
#;(define: exclude-directory? : (Parameter (Path -> Any)) (make-parameter default-excluder))
;; ----------------------------------------
;; apply-to-scheme-files: (path[file] -> X) path[directory] -> (listof X)
;; applies the given function to each .ss or .scm file in the given directory
;; hierarchy; returns all results in a list
#;(define: (apply-to-scheme-files [f : (Path -> (Listof(Listof(Listof NumF))))]
[root : Path])
: (Listof (Listof(Listof(Listof NumF)))) ;;FOLD-FILES
(fold-files
(lambda: ([path : Path] [kind : Symbol]
[acc : (Listof (Listof(Listof(Listof NumF))))])
(case kind
[(file)
(let ([extension (filename-extension path)])
(cond
[(not extension) #;acc (values acc #t)]
[(regexp-match #rx"(ss|scm)$" extension)
(let ([resl (f path)])
(if resl
#;(cons resl acc) (values (cons resl acc) #t) ;;values added
#;acc (values acc #t)))]
[else #;acc (values acc #t)]))]
[(dir)
(let* ([p (normalize-path path root)])
(if ((exclude-directory?) p)
#; acc (values acc #f)
#;acc (values acc #t)))] ;; values added
[(link) #;acc (values acc #t)]
[else (error "never happen")])) ;;error added
'()
root
#t)) ;;value added
(define-typed-struct (a b c) result ([metric : (Metric b c a)] [seqA : (Listof a)] [seqB : (Listof a)]))
(define-type-alias Result result)
;; get-sequences : (listof 'a metric) path -> (listof (listof 'a))
(pdefine: (b c C) (get-sequences [metrics : (Listof (U(Metric b c (Listof NumF))(Metric b C (Listof NumF))))]
[path : Path])
: (Listof (Listof (Listof NumF)))
(let* ([metric-fns ; : (Listof (Path -> (Listof (U #f(Listof NumF)))))
(map (lambda: ([m : (Metric b c (Listof NumF))])
((metric-analysis-unit m)
(metric-computation m))) metrics)]
[result-seqs ; : (Listof (U #f (Listof (Listof ( U #f (Listof NumF))))))
(apply-to-scheme-files
(lambda: ([file : Path])
(map (lambda: ([fn : (Path -> (Listof (U #f (Listof NumF))))]) (fn file)) metric-fns)) path)])
(map (lambda: ([l : (Listof(Listof (Listof NumF)))])
;; FIXME - problem with inference and ordering
(#{nonfalses @ (Listof NumF)} (apply append l)))
(pivot (#{nonfalses @ (Listof(Listof (U #f (Listof NumF))))} result-seqs)))))
;; compare : (listof metric) -> (listof result)
(pdefine: ( b c C) (compare* [metrics : (Listof (U (Metric b c (Listof NumF)) (Metric b C (Listof NumF))))]) : (Listof (U (Result (Listof NumF) b C)(Result (Listof NumF) b c)))
(let* ([seqAs (get-sequences metrics (COLLECTS-PATH))]
[seqBs (get-sequences metrics (PLANET-CODE-PATH))])
(map #{make-result @ (Listof NumF) b c} metrics seqAs seqBs)))
(pdefine: (a b c) (show [result : (Result a b c)]) : b
((metric->display (result-metric result))
(result-seqA result )
(result-seqB result )))
(define: (pretty-print-result [result : (Result (Listof NumF) (Listof Atom-display) Any)]) : Void
(for-each
(lambda: ([l : (Listof top)])
(apply srfi48::format ;;sfri48:format
(current-output-port)
"~26F | ~8,2F | ~6,2F | ~12,2F\n"
(format "~a" (car l))
(cdr l)))
#{(list* '("test name" "collects" "planet" "significance") ;;list instead of list*
'("---------" "--------" "------" "------------")
(show result )) :: List}))
;; applies only to the combined metric [or more generally to listof-answer results]
(pdefine: (a b c) (total [experiment-number : Integer] [result : (Result (Listof number) b c)]) : (Listof number)
(define: (total/s [s : Table]) : number (apply + (list-ref (pivot s) experiment-number)))
(list (total/s (result-seqA result)) (total/s (result-seqB result))))
;; ============================================================
;; UTILITY
(pdefine: (X Y) (imap [f : (X -> Y)] [il : (Listof X)]) : (Listof Y)
(cond
[(null? il) '()]
[(not (pair? il)) (list (f il))]
[else (cons (f (car il)) (imap f (cdr il)))]))
(pdefine: (X) (pivot [l : (Listof (Listof X))]): (Listof (Listof X))
(cond
[(null? l) '()]
[else
(let ([n (length (car l))])
(build-list n (lambda: ([i : Integer]) (map (lambda: ([j : (Listof X)]) (list-ref j i)) l))))]))
(define: (sqr [x : number]) : number (* x x))
(define: (variance [xs : (Listof number)]): number
(let ([avg (/ (apply + xs) (length xs))])
(/ (apply + (map (lambda: ([x : number]) (sqr (- x avg))) xs))
(sub1 (length xs)))))
(define: (table-ref [i : Integer] [j : Integer] [table : Table]): number
(list-ref (list-ref table i) j))
(define: (row-total [i : Integer] [table : Table]) : number
(apply + (list-ref table i)))
(define: (col-total [j : Integer] [table : Table]) : number
(apply + (map (lambda: ([x : (Listof number)]) (list-ref x j)) table)))
(define: (table-sum [f : (Integer Integer -> number)] [table : Table]) : number
(let ([rows (length table)]
[cols (length (car table))])
(let: loop : number ([i : Integer 0] [j : Integer 0] [sum : number 0])
(cond
[(>= j cols) sum]
[(>= i rows) (loop 0 (add1 j) sum)]
[else (loop (add1 i) j (+ sum (f i j)))]))))
(pdefine: (Y) (improper-foldr [f : (Any Y -> Y)] [b : Y] [l : Any]) : Y
(cond
[(null? l) b]
[(not (pair? l))
(f l b)]
[else
(f (car l) (improper-foldr f b (cdr l)))]))
;; unused (and untypeable)
#;(define: (/* . [args : (Listof number)]) : number ;;((number)) against (number) and USELESS
(apply map (lambda: ([ns : number]) (apply / ns)) args))
;; ============================================================
;; MAIN ENTRY POINT
(define: results :
Any
;; FIXME bug in typed scheme when this type is used
#;
(Listof (U (Result (Listof NumF) (Listof Atom-display) (Listof Sexpr))
(Result (Listof NumF) (Listof Atom-display) Sexpr)))
'())
; just in case i want to do some more analysis on the results afterwards,
; so i don't have to waste a minute if i forget to bind the return value to something
(define: (run-all-tests) : top
(let: ([rs : (Listof (U (Result (Listof NumF) (Listof Atom-display) (Listof Sexpr))
(Result (Listof NumF) (Listof Atom-display) Sexpr)))
(compare*
#{all-metrics ::
(Listof (U (Metric (Listof Atom-display) (Listof Sexpr) (Listof NumF))
(Metric (Listof Atom-display) Sexpr (Listof NumF))))})])
(set! results rs)
(for-each pretty-print-result rs)
rs))

3
collects/tests/typed-scheme/succeed/patch.ss Normal file
View File

@ -0,0 +1,3 @@
(module patch scheme
(define srfi48::format format)
(provide srfi48::format))

621
collects/tests/typed-scheme/succeed/random-bits.ss Normal file
View File

@ -0,0 +1,621 @@
; MODULE DEFINITION FOR SRFI-27
; =============================
;
; Sebastian.Egner@philips.com, Mar-2002, in PLT 204
;
; This file contains the top-level definition for the 54-bit integer-only
; implementation of SRFI 27 for the PLT 204 DrScheme system.
;
; 1. The core generator is implemented in 'mrg32k3a-a.scm'.
; 2. The generic parts of the interface are in 'mrg32k3a.scm'.
; 3. The non-generic parts (record type, time, error) are here.
;
; load the module with
; (require (lib "random-bits.ss" "srfi"))
;
; history of this file:
; SE, 17-May-2003: initial version
(module random-bits typed-scheme
#;(require (lib "9.ss" "srfi"))
#;(require (lib "23.ss" "srfi"))
(provide
random-integer random-real default-random-source
make-random-source random-source? random-source-state-ref
random-source-state-set! random-source-randomize!
random-source-pseudo-randomize!
random-source-make-integers random-source-make-reals)
(define-type-alias Nb Integer)
(define-type-alias Flt Number)
(define-type-alias Nbs (Listof Nb))
(define-type-alias State (Vectorof Integer))
(define-type-alias SpList (cons 'lecuyer-mrg32k3a (Listof Nb)))
(define-typed-struct :random-source (
[state-ref : ( -> SpList)]
[state-set! : ((Listof Nb)-> Void)]
[randomize! : ( -> Void)]
[pseudo-randomize! : (Integer Integer -> Void)]
[make-integers : (-> (Integer -> Integer)) ]
[make-reals : ( Nb .. -> ( -> Number))]))
(define-type-alias Random :random-source)
(define: (:random-source-make
[state-ref : ( -> SpList)]
[state-set! : ((Listof Nb)-> Void)]
[randomize! : ( -> Void)]
[pseudo-randomize! : (Integer Integer -> Void)]
[make-integers : (-> (Integer -> Integer)) ]
[make-reals : (Nb .. -> (-> Number))])
: Random
(make-:random-source state-ref state-set! randomize! pseudo-randomize! make-integers make-reals ))
#;(define-record-type :random-source
(:random-source-make
state-ref
state-set!
randomize!
pseudo-randomize!
make-integers
make-reals)
:random-source?
(state-ref :random-source-state-ref)
(state-set! :random-source-state-set!)
(randomize! :random-source-randomize!)
(pseudo-randomize! :random-source-pseudo-randomize!)
(make-integers :random-source-make-integers)
(make-reals :random-source-make-reals))
(define: :random-source-current-time : ( -> Nb )
current-milliseconds) ;;on verra apres
; implementation begins here
; 54-BIT INTEGER IMPLEMENTATION OF THE "MRG32K3A"-GENERATOR
; =========================================================
;
; Sebastian.Egner@philips.com, Mar-2002.
;
; This file is an implementation of Pierre L'Ecuyer's MRG32k3a
; pseudo random number generator. Please refer to 'mrg32k3a.scm'
; for more information.
;
; compliance:
; Scheme R5RS with integers covering at least {-2^53..2^53-1}.
;
; history of this file:
; SE, 18-Mar-2002: initial version
; SE, 22-Mar-2002: comments adjusted, range added
; SE, 25-Mar-2002: pack/unpack just return their argument
; the actual generator
(define: (mrg32k3a-random-m1 [state : State]) : Nb
(let ((x11 (vector-ref state 0))
(x12 (vector-ref state 1))
(x13 (vector-ref state 2))
(x21 (vector-ref state 3))
(x22 (vector-ref state 4))
(x23 (vector-ref state 5)))
(let ((x10 (modulo (- (* 1403580 x12) (* 810728 x13)) 4294967087))
(x20 (modulo (- (* 527612 x21) (* 1370589 x23)) 4294944443)))
(vector-set! state 0 x10)
(vector-set! state 1 x11)
(vector-set! state 2 x12)
(vector-set! state 3 x20)
(vector-set! state 4 x21)
(vector-set! state 5 x22)
(modulo (- x10 x20) 4294967087))))
; interface to the generic parts of the generator
(define: (mrg32k3a-pack-state [unpacked-state : State]) : State
unpacked-state)
(define: (mrg32k3a-unpack-state [state : State] ) : State
state)
(define: (mrg32k3a-random-range) : Integer ; m1
4294967087)
(define: (mrg32k3a-random-integer [state : State] [range : Nb]) : Nb ; rejection method
(let* ((q (quotient 4294967087 range))
(qn (* q range)))
(do: : Nb ((x : Nb (mrg32k3a-random-m1 state) (mrg32k3a-random-m1 state))) ;;no alias accepted
((< x qn) (quotient x q)))))
(define: (mrg32k3a-random-real [state : State]) : Number ; normalization is 1/(m1+1)
(* 0.0000000002328306549295728 (+ 1.0 (mrg32k3a-random-m1 state))))
; GENERIC PART OF MRG32k3a-GENERATOR FOR SRFI-27
; ==============================================
;
; Sebastian.Egner@philips.com, 2002.
;
; This is the generic R5RS-part of the implementation of the MRG32k3a
; generator to be used in SRFI-27. It is based on a separate implementation
; of the core generator (presumably in native code) and on code to
; provide essential functionality not available in R5RS (see below).
;
; compliance:
; Scheme R5RS with integer covering at least {-2^53..2^53-1}.
; In addition,
; SRFI-23: error
;
; history of this file:
; SE, 22-Mar-2002: refactored from earlier versions
; SE, 25-Mar-2002: pack/unpack need not allocate
; SE, 27-Mar-2002: changed interface to core generator
; SE, 10-Apr-2002: updated spec of mrg32k3a-random-integer
; Generator
; =========
;
; Pierre L'Ecuyer's MRG32k3a generator is a Combined Multiple Recursive
; Generator. It produces the sequence {(x[1,n] - x[2,n]) mod m1 : n}
; defined by the two recursive generators
;
; x[1,n] = ( a12 x[1,n-2] + a13 x[1,n-3]) mod m1,
; x[2,n] = (a21 x[2,n-1] + a23 x[2,n-3]) mod m2,
;
; where the constants are
; m1 = 4294967087 = 2^32 - 209 modulus of 1st component
; m2 = 4294944443 = 2^32 - 22853 modulus of 2nd component
; a12 = 1403580 recursion coefficients
; a13 = -810728
; a21 = 527612
; a23 = -1370589
;
; The generator passes all tests of G. Marsaglia's Diehard testsuite.
; Its period is (m1^3 - 1)(m2^3 - 1)/2 which is nearly 2^191.
; L'Ecuyer reports: "This generator is well-behaved in all dimensions
; up to at least 45: ..." [with respect to the spectral test, SE].
;
; The period is maximal for all values of the seed as long as the
; state of both recursive generators is not entirely zero.
;
; As the successor state is a linear combination of previous
; states, it is possible to advance the generator by more than one
; iteration by applying a linear transformation. The following
; publication provides detailed information on how to do that:
;
; [1] P. L'Ecuyer, R. Simard, E. J. Chen, W. D. Kelton:
; An Object-Oriented Random-Number Package With Many Long
; Streams and Substreams. 2001.
; To appear in Operations Research.
;
; Arithmetics
; ===========
;
; The MRG32k3a generator produces values in {0..2^32-209-1}. All
; subexpressions of the actual generator fit into {-2^53..2^53-1}.
; The code below assumes that Scheme's "integer" covers this range.
; In addition, it is assumed that floating point literals can be
; read and there is some arithmetics with inexact numbers.
;
; However, for advancing the state of the generator by more than
; one step at a time, the full range {0..2^32-209-1} is needed.
; Required: Backbone Generator
; ============================
;
; At this point in the code, the following procedures are assumed
; to be defined to execute the core generator:
;
; (mrg32k3a-pack-state unpacked-state) -> packed-state
; (mrg32k3a-unpack-state packed-state) -> unpacked-state
; pack/unpack a state of the generator. The core generator works
; on packed states, passed as an explicit argument, only. This
; allows native code implementations to store their state in a
; suitable form. Unpacked states are #(x10 x11 x12 x20 x21 x22)
; with integer x_ij. Pack/unpack need not allocate new objects
; in case packed and unpacked states are identical.
;
; (mrg32k3a-random-range) -> m-max
; (mrg32k3a-random-integer packed-state range) -> x in {0..range-1}
; advance the state of the generator and return the next random
; range-limited integer.
; Note that the state is not necessarily advanced by just one
; step because we use the rejection method to avoid any problems
; with distribution anomalies.
; The range argument must be an exact integer in {1..m-max}.
; It can be assumed that range is a fixnum if the Scheme system
; has such a number representation.
;
; (mrg32k3a-random-real packed-state) -> x in (0,1)
; advance the state of the generator and return the next random
; real number between zero and one (both excluded). The type of
; the result should be a flonum if possible.
; Required: Record Data Type
; ==========================
;
; At this point in the code, the following procedures are assumed
; to be defined to create and access a new record data type:
;
; (:random-source-make a0 a1 a2 a3 a4 a5) -> s
; constructs a new random source object s consisting of the
; objects a0 .. a5 in this order.
;
; (:random-source? obj) -> bool
; tests if a Scheme object is a :random-source.
;
; (:random-source-state-ref s) -> a0
; (:random-source-state-set! s) -> a1
; (:random-source-randomize! s) -> a2
; (:random-source-pseudo-randomize! s) -> a3
; (:random-source-make-integers s) -> a4
; (:random-source-make-reals s) -> a5
; retrieve the values in the fields of the object s.
; Required: Current Time as an Integer
; ====================================
;
; At this point in the code, the following procedure is assumed
; to be defined to obtain a value that is likely to be different
; for each invokation of the Scheme system:
;
; (:random-source-current-time) -> x
; an integer that depends on the system clock. It is desired
; that the integer changes as fast as possible.
; Accessing the State
; ===================
(define: (mrg32k3a-state-ref [packed-state : State ]) : (cons 'lecuyer-mrg32k3a (Listof Nb))
(cons 'lecuyer-mrg32k3a
(vector->list (mrg32k3a-unpack-state packed-state))))
(define: (mrg32k3a-state-set [external-state : (Listof Nb)]) : State
(define: (check-value [x : Nb] [m : Nb]) : Boolean
(if (and (integer? x)
(exact? x)
(<= 0 x (- m 1)))
#t
(error "illegal value" x)))
(if (and (list? external-state)
(= (length external-state) 7)
(eq? (car external-state) 'lecuyer-mrg32k3a))
(let: ((s : (Listof Nb) (cdr external-state)))
(check-value (list-ref s 0) mrg32k3a-m1)
(check-value (list-ref s 1) mrg32k3a-m1)
(check-value (list-ref s 2) mrg32k3a-m1)
(check-value (list-ref s 3) mrg32k3a-m2)
(check-value (list-ref s 4) mrg32k3a-m2)
(check-value (list-ref s 5) mrg32k3a-m2)
(when (or (zero? (+ (list-ref s 0) (list-ref s 1) (list-ref s 2)))
(zero? (+ (list-ref s 3) (list-ref s 4) (list-ref s 5))))
(error "illegal degenerate state" external-state))
(mrg32k3a-pack-state (list->vector s)))
(error "malformed state" external-state)))
; Pseudo-Randomization
; ====================
;
; Reference [1] above shows how to obtain many long streams and
; substream from the backbone generator.
;
; The idea is that the generator is a linear operation on the state.
; Hence, we can express this operation as a 3x3-matrix acting on the
; three most recent states. Raising the matrix to the k-th power, we
; obtain the operation to advance the state by k steps at once. The
; virtual streams and substreams are now simply parts of the entire
; periodic sequence (which has period around 2^191).
;
; For the implementation it is necessary to compute with matrices in
; the ring (Z/(m1*m1)*Z)^(3x3). By the Chinese-Remainder Theorem, this
; is isomorphic to ((Z/m1*Z) x (Z/m2*Z))^(3x3). We represent such a pair
; of matrices
; [ [[x00 x01 x02],
; [x10 x11 x12],
; [x20 x21 x22]], mod m1
; [[y00 y01 y02],
; [y10 y11 y12],
; [y20 y21 y22]] mod m2]
; as a vector of length 18 of the integers as writen above:
; #(x00 x01 x02 x10 x11 x12 x20 x21 x22
; y00 y01 y02 y10 y11 y12 y20 y21 y22)
;
; As the implementation should only use the range {-2^53..2^53-1}, the
; fundamental operation (x*y) mod m, where x, y, m are nearly 2^32,
; is computed by breaking up x and y as x = x1*w + x0 and y = y1*w + y0
; where w = 2^16. In this case, all operations fit the range because
; w^2 mod m is a small number. If proper multiprecision integers are
; available this is not necessary, but pseudo-randomize! is an expected
; to be called only occasionally so we do not provide this implementation.
(define: mrg32k3a-m1 : Nb 4294967087) ; modulus of component 1
(define: mrg32k3a-m2 : Nb 4294944443) ; modulus of component 2
(define: mrg32k3a-initial-state : (Vectorof Nb); 0 3 6 9 12 15 of A^16, see below
'#( 1062452522
2961816100
342112271
2854655037
3321940838
3542344109))
(define: mrg32k3a-generators : (Listof State) '(#(0 0 0 0 0)) ) ; computed when needed -> Changer #f by a State to hava right type.
(define: (mrg32k3a-pseudo-randomize-state [i : Integer] [j : Integer]) : State
(define: (product [A : State] [B : State]) : State ; A*B in ((Z/m1*Z) x (Z/m2*Z))^(3x3)
(define: w : Nb 65536) ; wordsize to split {0..2^32-1}
(define: w-sqr1 : Nb 209) ; w^2 mod m1
(define: w-sqr2 : Nb 22853) ; w^2 mod m2
(define: (lc [i0 : Nb] [i1 : Nb] [i2 : Nb] [j0 : Nb] [j1 : Nb] [j2 : Nb] [m : Nb ] [w-sqr : Nb ]): Nb ; linear combination
(let ((a0h (quotient (vector-ref A i0) w))
(a0l (modulo (vector-ref A i0) w))
(a1h (quotient (vector-ref A i1) w))
(a1l (modulo (vector-ref A i1) w))
(a2h (quotient (vector-ref A i2) w))
(a2l (modulo (vector-ref A i2) w))
(b0h (quotient (vector-ref B j0) w))
(b0l (modulo (vector-ref B j0) w))
(b1h (quotient (vector-ref B j1) w))
(b1l (modulo (vector-ref B j1) w))
(b2h (quotient (vector-ref B j2) w))
(b2l (modulo (vector-ref B j2) w)))
(modulo
(+ (* (+ (* a0h b0h)
(* a1h b1h)
(* a2h b2h))
w-sqr)
(* (+ (* a0h b0l)
(* a0l b0h)
(* a1h b1l)
(* a1l b1h)
(* a2h b2l)
(* a2l b2h))
w)
(* a0l b0l)
(* a1l b1l)
(* a2l b2l))
m)))
(vector
(lc 0 1 2 0 3 6 mrg32k3a-m1 w-sqr1) ; (A*B)_00 mod m1
(lc 0 1 2 1 4 7 mrg32k3a-m1 w-sqr1) ; (A*B)_01
(lc 0 1 2 2 5 8 mrg32k3a-m1 w-sqr1)
(lc 3 4 5 0 3 6 mrg32k3a-m1 w-sqr1) ; (A*B)_10
(lc 3 4 5 1 4 7 mrg32k3a-m1 w-sqr1)
(lc 3 4 5 2 5 8 mrg32k3a-m1 w-sqr1)
(lc 6 7 8 0 3 6 mrg32k3a-m1 w-sqr1)
(lc 6 7 8 1 4 7 mrg32k3a-m1 w-sqr1)
(lc 6 7 8 2 5 8 mrg32k3a-m1 w-sqr1)
(lc 9 10 11 9 12 15 mrg32k3a-m2 w-sqr2) ; (A*B)_00 mod m2
(lc 9 10 11 10 13 16 mrg32k3a-m2 w-sqr2)
(lc 9 10 11 11 14 17 mrg32k3a-m2 w-sqr2)
(lc 12 13 14 9 12 15 mrg32k3a-m2 w-sqr2)
(lc 12 13 14 10 13 16 mrg32k3a-m2 w-sqr2)
(lc 12 13 14 11 14 17 mrg32k3a-m2 w-sqr2)
(lc 15 16 17 9 12 15 mrg32k3a-m2 w-sqr2)
(lc 15 16 17 10 13 16 mrg32k3a-m2 w-sqr2)
(lc 15 16 17 11 14 17 mrg32k3a-m2 w-sqr2)))
(define: (power [A : State ] [e : Nb]) : State ; A^e
(cond
((zero? e)
'#(1 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 0 1))
((= e 1)
A)
((even? e)
(power (product A A) (quotient e 2)))
(else
(product (power A (- e 1)) A))))
(define: (power-power [A : State] [b : Nb]) : State ; A^(2^b)
(if (zero? b)
A
(power-power (product A A) (- b 1))))
(define: A : State ; the MRG32k3a recursion
'#( 0 1403580 4294156359
1 0 0
0 1 0
527612 0 4293573854
1 0 0
0 1 0))
; check arguments
(when (not (and (integer? i)
(exact? i)
(integer? j)
(exact? j)))
(error "i j must be exact integer" i j))
; precompute A^(2^127) and A^(2^76) only once
(when #t #;(not mrg32k3a-generators)
(set! mrg32k3a-generators
(list (power-power A 127)
(power-power A 76)
(power A 16))))
; compute M = A^(16 + i*2^127 + j*2^76)
(let ((M (product
(list-ref mrg32k3a-generators 2)
(product
(power (list-ref mrg32k3a-generators 0)
(modulo i (expt 2 28)))
(power (list-ref mrg32k3a-generators 1)
(modulo j (expt 2 28)))))))
(mrg32k3a-pack-state
(vector
(vector-ref M 0)
(vector-ref M 3)
(vector-ref M 6)
(vector-ref M 9)
(vector-ref M 12)
(vector-ref M 15)))))
; True Randomization
; ==================
;
; The value obtained from the system time is feed into a very
; simple pseudo random number generator. This in turn is used
; to obtain numbers to randomize the state of the MRG32k3a
; generator, avoiding period degeneration.
(define: (mrg32k3a-randomize-state [state : State]) : State
; G. Marsaglia's simple 16-bit generator with carry
(define: m : Nb 65536)
(define: x : Nb (modulo (:random-source-current-time) m))
(define: (random-m) : Nb
(let ((y (modulo x m)))
(set! x (+ (* 30903 y) (quotient x m)))
y))
(define: (random [n : Nb]) : Nb ; m < n < m^2
(modulo (+ (* (random-m) m) (random-m)) n))
; modify the state
(let ((m1 mrg32k3a-m1)
(m2 mrg32k3a-m2)
(s (mrg32k3a-unpack-state state)))
(mrg32k3a-pack-state
(vector
(+ 1 (modulo (+ (vector-ref s 0) (random (- m1 1))) (- m1 1)))
(modulo (+ (vector-ref s 1) (random m1)) m1)
(modulo (+ (vector-ref s 2) (random m1)) m1)
(+ 1 (modulo (+ (vector-ref s 3) (random (- m2 1))) (- m2 1)))
(modulo (+ (vector-ref s 4) (random m2)) m2)
(modulo (+ (vector-ref s 5) (random m2)) m2)))))
; Large Integers
; ==============
;
; To produce large integer random deviates, for n > m-max, we first
; construct large random numbers in the range {0..m-max^k-1} for some
; k such that m-max^k >= n and then use the rejection method to choose
; uniformly from the range {0..n-1}.
(define: mrg32k3a-m-max : Integer
(mrg32k3a-random-range))
(define: (mrg32k3a-random-power [state : State] [k : Nb]) : Nb ; n = m-max^k, k >= 1
(if (= k 1)
(mrg32k3a-random-integer state mrg32k3a-m-max)
(+ (* (mrg32k3a-random-power state (- k 1)) mrg32k3a-m-max)
(mrg32k3a-random-integer state mrg32k3a-m-max))))
(define: (mrg32k3a-random-large [state : State] [n : Nb]) : Nb ; n > m-max
(do: : Integer ((k : Integer 2 (+ k 1))
(mk : Integer (* mrg32k3a-m-max mrg32k3a-m-max) (* mk mrg32k3a-m-max)))
((>= mk n)
(let* ((mk-by-n (quotient mk n))
(a (* mk-by-n n)))
(do: : Integer ((x : Integer (mrg32k3a-random-power state k)
(mrg32k3a-random-power state k)))
((< x a) (quotient x mk-by-n)))))))
; Multiple Precision Reals
; ========================
;
; To produce multiple precision reals we produce a large integer value
; and convert it into a real value. This value is then normalized.
; The precision goal is unit <= 1/(m^k + 1), or 1/unit - 1 <= m^k.
; If you know more about the floating point number types of the
; Scheme system, this can be improved.
(define: (mrg32k3a-random-real-mp [state : State] [unit : Number]) : Number
(do: : Number ((k : Integer 1 (+ k 1))
(u : Number (- (/ 1 unit) 1) (/ u mrg32k3a-m1)))
((<= u 1)
(/ (exact->inexact (+ (mrg32k3a-random-power state k) 1))
(exact->inexact (+ (expt mrg32k3a-m-max k) 1))))))
; Provide the Interface as Specified in the SRFI
; ==============================================
;
; An object of type random-source is a record containing the procedures
; as components. The actual state of the generator is stored in the
; binding-time environment of make-random-source.
(define: (make-random-source) : Random
(let: ((state : State (mrg32k3a-pack-state ; make a new copy
(list->vector (vector->list mrg32k3a-initial-state)))))
(:random-source-make
(lambda: ()
(mrg32k3a-state-ref state))
(lambda: ([new-state : (Listof Integer)])
(set! state (mrg32k3a-state-set new-state)))
(lambda: ()
(set! state (mrg32k3a-randomize-state state)))
(lambda: ([i : Integer] [j : Integer])
(set! state (mrg32k3a-pseudo-randomize-state i j)))
(lambda: ()
(lambda: ([n : Nb])
(cond
((not (and (integer? n) (exact? n) (positive? n)))
(error "range must be exact positive integer" n))
((<= n mrg32k3a-m-max)
(mrg32k3a-random-integer state n))
(else
(mrg32k3a-random-large state n)))))
(lambda: [args : Nb]
(cond
((null? args)
(lambda ()
(mrg32k3a-random-real state)))
((null? (cdr args))
(let: ((unit : Flt (car args)))
(cond
((not (and (real? unit) (< 0 unit 1)))
(error "unit must be real in (0,1)" unit))
((<= (- (/ 1 unit) 1) mrg32k3a-m1)
(lambda: ()
(mrg32k3a-random-real state)))
(else
(lambda: ()
(mrg32k3a-random-real-mp state unit))))))
(else
(error "illegal arguments" args)))))))
(define: random-source? : (Any -> Boolean : Random)
:random-source?)
(define: (random-source-state-ref [s : Random]) : SpList
((:random-source-state-ref s)))
(define: (random-source-state-set! [s : Random] [state : Nbs]) : Void
((:random-source-state-set! s) state))
(define: (random-source-randomize! [s : Random]) : Void
((:random-source-randomize! s)))
(define: (random-source-pseudo-randomize! [s : Random] [i : Nb] [j : Nb]): Void
((:random-source-pseudo-randomize! s) i j))
; ---
(define: (random-source-make-integers [s : Random]): (Nb -> Nb)
((:random-source-make-integers s)))
(define: (random-source-make-reals [s : Random] . [unit : Nb]) : ( -> Flt)
(apply (:random-source-make-reals s) unit))
; ---
(define: default-random-source : Random
(make-random-source))
(define: random-integer : (Nb -> Nb)
(random-source-make-integers default-random-source))
(define: random-real : ( -> Flt )
(random-source-make-reals default-random-source))
) ; module ends