Hi,
below some funcs and a mechanism to avoid name clobbering:
if you execute this script and you already have defined some words
this script wants to introduce, you will be asked if you want to abort
the execution before your definitions would be lost.
Any suggestions are welcomed,
Oliver Schaefer ([EMAIL PROTECTED])
REBOL [
Title: "Toolbox"
Date: 10-Dec-1999
Author: "many Rebols"
File: %toolbox.r
Purpose: {
some useful funcs.
}
]
;[registry]-----------------------------------------------------------------
;
; Purpose: to avoid name clobbering
;
if any [not value? 'registry registry/debug == true] [
use [old_words] [
either value? 'registry [
old_words: registry/words
][
old_words: copy []
]
registry: make object! [
debug: true ; change this if you aren't testing any more...
warnings: false
words: old_words ; use 'copy if you have a GC problem...
register: func ['word /local found] [
found: not none? find self/words word
either found [
either self/debug [
if self/warnings [
print ["Warning: word is already defined [registered]:" :word]
]
true ; means: overwriting 'word is okay,
; since we are testing...
][
false ; don't overwrite !
]
][
either value? word [
; warning handled in self/setup below
false ; means: don't clobber others words or builtins ...
][
insert tail self/words word
true
]
]
] ; register [function!]
setup: func ["register global words"
words_to_register [block!] /local forbidden_words [block!]
][
forbidden_words: copy []
foreach word words_to_register [
if not self/register :word [
insert forbidden_words word
]
]
if not empty? forbidden_words [
print ["Warning: some words are already defined,"
"but not registered:" mold forbidden_words
]
if confirm "Abort execution? " [
print "Execution aborted."
halt
]
]
] ; setup [function!]
] ; registry [object!]
] ; use
]
; [registry setup]----------------------------------------------------------
;
; Purpose: registers global words
;
use [words_to_register] [
words_to_register: [
composite range map mapper filter-diff filter list-dirs bench
copy-func ++ -- inc round printf
]
if not value? 'unset! [
insert registry/words 'unset!
unset!: (type?)
]
registry/setup words_to_register
]
; [global funcs]------------------------------------------------------------
;
; Purpose: some utilities ...
;
composite: func ["f(g(x))" :f "func f [x] [...]" :g "func g [x] [...]"] [
func [x] compose [(:f) (:g) :x]
]
range: func ["[start .. end]"
start [number!] end [number!] /local result [block!]
][
result: make block! (end - start + 1)
either start < end [
for i end (start - 1) -1 [ ; strange: "for i start end 1" is equivalent
insert result i
]
][
for i end (start + 1) 1 [
insert result i
]
]
]
map: func ["maps a function to a block"
:f [any-function!] block [block!] /local result [block!]
][
result: make block! (length? block)
foreach element block [
insert/only tail result f element
]
head result
]
; Example:
; print mold map odd? range 1 20
mapper: func ["map function"
f [any-function! paren! any-word!]
][
func [block [block!] /local result [block!]] compose/deep [
result: make block! length? block
foreach element block [
insert/only tail result (:f) element
]
head result
]
]
; Example:
; map-odd?: mapper 'odd?
; print mold map-odd? range 1 20
; faster than 'filter && 'difference/only (especially for large blocks)
filter-diff: func ["filter function - returns [[... filtered ...] [...
unfiltered ...]]"
:f [any-function!] block [block!] /local result [block!] diff [block!]] [
result: copy []
diff: copy []
foreach element block [
either f element [
insert/only tail result element
][
insert/only tail diff element
]
]
reduce [result diff]
]
filter: func ["filter function"
:f [any-function!] block [block!] /local result [block!]
][
result: copy []
foreach element block [
if f element [
insert/only tail result element
]
]
result
]
; adapted from a code snippet
; see "[REBOL] file list" (03-Dec-1999)
; author: Thomas Johnson <[EMAIL PROTECTED]>
list-dirs: func ["directory listing - subdirs included"
dir [file!] /filtered :filter-func [any-function!]
/local indent [string!] result [block!] _list-dirs [function!]
][
indent: copy ""
result: copy []
_list-dirs: func [dir [file!] /local files [block!]] [
files: filter-diff dir? sort read dir ; [[dirs] [files]]
foreach subdir first files [
insert tail result rejoin [indent subdir newline]
insert indent tab
_list-dirs dir/:subdir
remove indent
]
either filtered [
files: filter filter-func second files
][
files: second files
]
foreach file files [
insert tail result rejoin [indent file newline]
]
result
]
_list-dirs dir
]
comment {
Examples:
print rejoin list-dirs %./
filter-func: func [file] [found? find file ".r"]
print rejoin list-dirs/filtered %./ filter-func
}
bench: func ["wants to be a benchmark func"
block [block!] loops [integer!] /verbose [logic!] /local t [time!]
][
t: now/time
loop loops [
if verbose [prin #"-"] ; this hurts...
do block ; this too
]
if verbose [prin newline]
now/time - t
]
copy-func: func ["copies a function" :f [any-function!]] [
make function! first :f second :f
]
; I'm a C++ fan, after all...
; (just kidding)
++: func ['x] [
set x (get x) + 1
]
--: func ['x] [
set x (get x) - 1
]
inc: func ['x y] [
set x (get x) + y
]
round: func [n [number!]] [
to-integer n + pick [-.5 .5] negative? n
]
; from Gabriele Santilli <[EMAIL PROTECTED]>
printf: func ["format function"
number "thing to format"
numdigits [integer! unset!] fillchar [char! string! unset!]
][
if not value? 'numdigits [
numdigits: 6
]
if not value? 'fillchar [
fillchar: #" "
]
skip
insert
insert/dup
make string! numdigits
fillchar
numdigits
number
negate numdigits
]
comment {
*wow*
Examples:
>> printf 3000
== " 3000"
>> printf 3000 6 "0"
== "003000"
>> printf "3000" 6 "-"
== "--3000"
>> printf "this works" 5
== "works"
}
