[REBOL] Re: object funnies
From: allenk:powerup:au at: 18-Oct-2001 16:35
A script from Jeff may help track it down.
Cheers,
Allen K
REBOL [
Title: "Check-leaks"
Purpose: "Check a script for word leaks"
Usage: {
DO this before you do anything else in your script.
After a little while (after things have evaluated),
call check-word-leaks which will print out words
that have leaked out to the global context and write
out a file called %word-leaks.txt
}
Author: "Jeff Kreis"
Email: [jeff--rebol--com]
data: 16-Feb-2001
]
check-word-leaks: func [
/local some-leaks
][
some-leaks: copy []
foreach word possible-leaks [
if all [not find global-leaks word value? word] [append some-leaks probe
word]
]
if not empty? some-leaks [
append global-leaks some-leaks
]
write/append %word-leaks.txt mold some-leaks
]
get-block-sets: func [
blk [block!]
/local flat flat2 sets-on nests sets
][
append flat: copy [] blk
flat2: copy []
sets: copy []
sets-on: 0
until [
nests: false
forall flat [
if sets-on > 0 [sets-on: sets-on - 1]
if flat/1 = 'set [sets-on: 2]
if all [lit-word? flat/1 sets-on > 0][
append sets to-word flat/1
]
if set-word? flat/1 [append sets to-word flat/1]
if block? flat/1 [
nests: true
append flat2 flat/1
if sets-on > 0 [ append sets flat/1]
]
] flat: head flat2
flat2: copy []
not nests
]
sets
]
wordize: func [blk [block!] /local res][
res: copy []
foreach item blk [if any-word? item [append res to-word item]]
res
]
global-leaks: copy []
possible-leaks: copy []
x-fnctn-x: :function!
function!: make x-fnctn-x [a][
reduce ['x-fnctn-x a]
]
make': :make
make: make' x-fnctn-x [type spec /local err][
if object! = type [
return make-watch object! spec
]
if all [
block? type
2 = length? type
type/1 = 'x-fnctn-x
][
;print ["Making function:" mold second type mold spec]
return make-watch/fun second type spec
]
if object? type [
return make-watch type spec
]
if set-word! <> type [
return make' type spec
]
to-set-word spec
]
make-watch: make' x-fnctn-x [
type spec
/fun
/local end res leaks poss locs
][
poss: copy []
append poss get-block-sets spec
foreach word poss [
if not value? word [
append possible-leaks word
]
]
possible-leaks: unique possible-leaks
possible-leaks
res: either fun [
make' x-fnctn-x type spec
][
make' type spec
]
:res
]
