diff --git a/Makefile b/Makefile index a4ae604e..f0f67898 100644 --- a/Makefile +++ b/Makefile @@ -36,6 +36,7 @@ SMODULES = \ scheme/cyclone/util \ srfi/9 \ srfi/18 \ + srfi/27 \ srfi/69 SLDFILES = $(addsuffix .sld, $(SMODULES)) COBJECTS=$(SLDFILES:.sld=.o) diff --git a/srfi/27.sld b/srfi/27.sld new file mode 100644 index 00000000..1c3a76d4 --- /dev/null +++ b/srfi/27.sld @@ -0,0 +1,95 @@ + +;; Copyright 2016 Jason K. MacDuffie +;; License: MIT (Expat) License +;; +;; Right now this uses an LCG, and should probably be replaced +;; with a higher-quality implementation as soon as possible. +;; For casual use this will work OK. + +(define-library (srfi 27) + (import (scheme base) + (scheme case-lambda) + (scheme time)) + (export 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) + (begin + ;; Numbers taken from bsd random + (define mult 1103515245) + (define incr 12345) + (define m 536870912) + ;; Cutting off seems like a good idea + (define cutoff 100) + + (define-c next-lcg + "(void *data, int argc, closure _, object k, object seed)" + "object result = NULL; + unsigned int s = obj_obj2int(seed); + unsigned int mult = 1103515245; + unsigned int incr = 12345; + unsigned int m = 536870912; + unsigned int next_seed = ((s * mult) + incr) % m; + result = obj_int2obj(next_seed); + return_closcall1(data, k, result);") + + (define-record-type + (raw-random-source n) + random-souce? + (n random-source-val set-random-source-val!)) + + (define (make-random-source) + (raw-random-source incr)) + + (define (random-source-make-integers s) + (lambda (n) + (define nextval + (next-lcg (random-source-val s))) + (set-random-source-val! s nextval) + (modulo nextval n))) + + (define random-source-make-reals + (case-lambda + ((s) + (random-source-make-reals s (/ m))) + ((s unit) + (if (not (< 0.0 unit 1.0)) + (error "unit must be between 0.0 and 1.0 (exclusive), but got " unit)) + (let ((numgen (random-source-make-integers s))) + (define r (exact (floor (/ unit)))) + (lambda () + (* (numgen r) unit)))))) + + (define default-random-source (make-random-source)) + + (define random-integer + (random-source-make-integers default-random-source)) + + (define random-real + (random-source-make-reals default-random-source)) + + (define (random-source-state-ref s) + ;; Just return the integer + (random-source-val s)) + + (define (random-source-state-set! s state) + ;; Just set the integer + (set-random-source-val! s state)) + + (define (random-source-pseudo-randomize! s i j) + ;; Pretty bad quality, upgrade after switch to better gen + (define n1 + ((random-source-make-integers i) m)) + (define n2 + ((random-source-make-integers j) m)) + (define n3 + (abs (- n1 n2))) + (random-source-state-set! s n3)) + + (define (random-source-randomize! s) + ;; True randomness would be a good idea here + (define i (current-second)) + (define j (+ (current-second) 2)) + (random-source-pseudo-randomize! s i j)))) +