| … | … | @@ -0,0 +1,65 @@ |
| 1 | ; |
| 2 | ; random.scm - Random utilities |
| 3 | ; |
| 4 | |
| 5 | (define rand-state-fluid (make-fluid)) |
| 6 | (define-public (random-string str-length) |
| 7 | " |
| 8 | random-string -- Returns a random string of length 'str-length'. |
| 9 | |
| 10 | This is now thread-safe. I think. Its missing a unit test, |
| 11 | and tends to not actually be random when hit hard from multiple |
| 12 | threads. Ick. This and everything that touches this needs |
| 13 | review/redesign. |
| 14 | " |
| 15 | (define alphanumeric "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") |
| 16 | (define alphlen (string-length alphanumeric)) |
| 17 | (define str (format #f "~A-" (get-internal-real-time))) |
| 18 | |
| 19 | ; Attempt to make this thread-safe by giving each thread it's own |
| 20 | ; random state. |
| 21 | (if (not (fluid-ref rand-state-fluid)) |
| 22 | (fluid-set! rand-state-fluid |
| 23 | (seed->random-state (get-internal-real-time)))) |
| 24 | |
| 25 | ; XXX FIXME -- this is a stunningly slow and sloppy random-string |
| 26 | ; generator. But whatever. I don't have the hours in the day to fix |
| 27 | ; everything. |
| 28 | (while (> str-length 0) |
| 29 | (set! str (string-append str (string (string-ref alphanumeric |
| 30 | (random alphlen (fluid-ref rand-state-fluid)))))) |
| 31 | (set! str-length (- str-length 1)) |
| 32 | ) |
| 33 | str |
| 34 | ) |
| 35 | |
| 36 | (define-public (random-node-name node-type random-length prefix) |
| 37 | " |
| 38 | random-node-name TYPE LENGTH PREFIX - create a unique node. |
| 39 | |
| 40 | Create a random string, consisting of `PREFIX` followed by |
| 41 | a random string of length `LENGTH`. The string is checked, so |
| 42 | that no node of type `TYPE` exists in the atomspace at the time |
| 43 | of this call. Thus, the name is almost unique -- there still is |
| 44 | a tiny window in which a race can occur. |
| 45 | " |
| 46 | (define node-name (random-string random-length)) |
| 47 | (define prefix-length (string-length prefix)) |
| 48 | (if (> prefix-length 0) |
| 49 | (set! node-name (string-append prefix node-name)) |
| 50 | ) |
| 51 | (while (cog-node node-type node-name) |
| 52 | (if (> prefix-length 0) |
| 53 | (set! node-name (string-append prefix (random-string random-length))) |
| 54 | (set! node-name (random-string random-length)) |
| 55 | ) |
| 56 | ) |
| 57 | node-name |
| 58 | ) |
| 59 | |
| 60 | (define-public (uniquely-named-variable) |
| 61 | " |
| 62 | uniquely-named-variable -- Creates a new uniquely-named VariableNode. |
| 63 | " |
| 64 | (Variable (random-node-name 'VariableNode 24 "$")) |
| 65 | ) |