World: r3wp

If anyone ever wanted multi-methods or function overload in rebol 
here is the answer. Enjoy ;-)

REBOL []

define-method: func [
	'name [word!] spec [block!] locals [block!] code [block!]

 /local w type-rule spec-rule continue? register-name methods-name
][
	;; first validate the spec
	continue?: [none] ;used to stop parsing

 type-rule: [set w word! (unless datatype? attempt [get w] [continue?: 
 [end skip]])]
	spec-rule: [some [word! into [type-rule continue?]]]
    unless parse spec spec-rule [make error! "invalid spec"]

	register-name: to-word join :name '-register
	methods-name: to-word join :name '-methods?
	unless value? name [
		
		context [
			dispatch-table: copy []
			
			spec-fingerprint: func [spec [block!] /local types][
				types: copy []
				foreach itm extract/index spec 2 2 [insert tail types itm/1 ]
				types
			]
			
			values-fingerprint: func [values [block!] /local types][
				types: copy []
				foreach v values [insert tail types type?/word v]
				types
			]
			

   retrieve-func: func [values [block!]][select/only dispatch-table 
   values-fingerprint values]
			
			set :name func [values [block!]][
				do compose [(retrieve-func values) (values)]
			]
			
			set :register-name func [spec code /local fingerprint pos][
				fingerprint: spec-fingerprint spec
				either found? pos: find/only dispatch-table fingerprint [
					poke dispatch-table 1 + index? pos function spec locals code
				][

     insert tail dispatch-table reduce [fingerprint function spec locals 
     code]
				]
			]
			
			set :methods-name does [probe dispatch-table]
		]
	]

	do reduce [register-name spec code]
]

define-method f [x [integer!]] [] [x + 1]
define-method f [s [block!]] [] [attempt [pick s 2]]
define-method f [x [decimal!]] [] [sine x] 

f[5] == 6
f[[one two three]] == two
f[90.0] == 1.0

Are the above functions DEFINE-METHOD and DEFINE-OBJECT worthy for 
the rebol.org library?

Well, why not. :) I'd suggest you to upload them.

Note that I have something vaguely similar to both in my YourValues 
code (http://www.colellachiara.com/soft/YourValues/), though that's 
probably not general enough for your needs.

Making a few modifications two define-method it will be possible 
to have multiple inheritance and object based dispatch in rebol. 
I need to think for a good name to post this in rebol.org.

Rebol never ends to amaze me. The src code for both functions combined 
is under 120 lines including comments and tests.

Please do put them on REBOL.org! No bookmarks in AltME yet, and others 
will find them there.  Wish I had time to play with them right now!

Exactly the sort of useful utility the Library exists for.
And, as Gregg says, much more likely to be found by others there.

I had been teaching a few more tricks to DEFINE-METHOD. This is what 
it is capable off:

;define-method creates a "fingerprint" for each parameter-spec
;and evals corresponding code according to "fingerprint"
define-method f [x: integer!] [x + 1]
define-method f [s: block!] [attempt [pick s 2]]
define-method f [x: decimal!] [sine x]

>> f[1] == 2
>> f[[one two three]] == two
>> b: [one two three]
>> f[b] == two
>> f[90.0] == 1.0

;instrospection one can always see the methods of a function
>> f-methods?
[integer!] -> [x + 1]
[block!] -> [attempt [pick s 2]]
[decimal!] -> [sine x]

;singleton parameter specs are posible.
;This allows for "rule" based programming
define-method fact [n: 0] [1]
define-method fact [n: integer!][n * fact[n - 1]]

>> fact-methods? 
[0] -> [1]
[integer!] -> [n * fact [n - 1]]


define-method fact-memoize [n: 0] [1]
define-method fact-memoize [n: integer! /local r ][
	r: n * fact[n - 1]
	define-method fact-memoize compose [n: (:n)] reduce [r]
	r
]

>> time-it [fact[12]] == 0:00:00.000434         ;no memoization

>> time-it [fact-memoize[12]] == 0:00:00.000583 ;first invoication
>> time-it [fact-memoize[12]] == 0:00:00.000087 ;cache lookup

;dispatch for undefined type signals error
>> fact[1.0] 
** User Error: Don't have a method to handle: [decimal!]
** Near: fact [1.0]


;moization is more dramatic when calculating the fibonacci sequence
define-method fib [n: 1] [1]
define-method fib [n: 2] [1]
define-method fib [n: integer!][ add fib[n - 2] fib[n - 1] ]

define-method fib-memoize [n: 1] [1]
define-method fib-memoize [n: 2] [1]
define-method fib-memoize [n: integer! /local r][
	r: add fib-memoize[n - 1] fib-memoize[n - 2]
	define-method fib-memoize compose [n: (:n)] reduce [r]
	r
]

;without memoization
>> time-it [fib [20]] == 0:00:00.32601
>> time-it [fib [19]] == 0:00:00.207066

;dramatic gains due to memoization
>> time-it [fib-memoize[20]] == 0:00:00.002187 ;first invoication
>> time-it [fib-memoize[20]] == 0:00:00.000096 ;cache lookup
>> time-it [fib-memoize[19]] == 0:00:00.0001   ;cache lookup

;it is possible to overload some natives!
define-method add [x: issue! y: issue!][join x y]
add[1 1] == 2
add[1.0.0 1] == 2.1.1
add[#abc #def] == #abcdef

So I think polyformism in rebol is quite possible. I wonder how difficult 
it will be to have something like DEFINE-METHOD implemented natively.

I like it.

So have you put this in the library yet?

It will be ther in a few minutes.

DEFINE-METHOD and DEFINE-OBJECT posted to the library. http://www.rebol.org/cgi-bin/cgiwrap/rebol/view-script.r?script=multi-methods.r

Sweet!  I'll have to play with it...

Several scripts I have been using for several years to ftp files 
to our web server are not working now.  I get no error message; the 
script just sits there.  But FTPGadget still works.  I phoned our 
isp and he can't see anything wrong.  He can ftp to the server. What 
could be causing this problem with my scripts?

run trace/net to see what is going wrong

Louis, I had a similar problem earlier this week.
It might be a firewall issue: try
system/schemes/ftp/passive: true


In the case I looked at, it seems to be just cruft build-up.....Many 
things are not working on that machine, and FTP has now broken too. 
We "solved" the problem by installing SmartFTP -- it works every 
2nd time you run it on that machine.

Thanks, Graham.  I had forgotten about trace.


And thanks, Sunanda. system/schemes/ftp/passive: true solved my problem.

Just wondering. Why does this work?

Either your ISP doesn't allow FTP to negotiate ports -- which is 
what active means
Or your firewall doesn't like it.

Passive FTP uses fixed port numbers, so everyone should be happy 
with it.

Does anyone know about documentation for the system port?

I know I used it once, but don't remember how, and what I did with 
it ;-)

;; nexted-foreach a simple way of generating nexted foreach loops


compose-foreach: func [var data code][reduce ['foreach var data code]]

nexted-foreach: func [vars blocks code /local var][
	if empty? blocks [return code]

 compose-foreach first vars first blocks nexted-foreach next vars 
 next blocks code
]

;; it can be used like this
do nexted-foreach [x y] [[1 2 3] [a b c]] [print [x y]]

Ingo: on the 'system port, no official doc. Some info:
rebolist thread (rebol.org) :

    http://www.rebol.org/cgi-bin/cgiwrap/rebol/ml-display-thread.r?m=rmlMYFJ
'signal demo script :

    http://www.rebol.org/cgi-bin/cgiwrap/rebol/ml-display-thread.r?m=rmlNFFJ
drag-and-drop demo script: 

    http://www.rebol.org/cgi-bin/cgiwrap/rebol/view-script.r?script=sys-port-drag-accept.r
systray demo script:

    http://compkarori.com/vanilla/display/System+Tray+Functionality

It's different for each OS. For MS-WIn, there is:
    get-modes system/ports/system 'system-modes
    ;== [window winmsg tray endian]
where:
    'window : REBOL console window handle,
    'winmsg : OS message block,
    'tray : systray definition block
    'endian : CPU byte order ('big or 'little)

For Linux:
    get-modes system/ports/system 'system-modes
    ;== [signal read-fd write-fd except-fd signal-names endian]

Thanks Vincent

Is this a bug?

1)  I read a directory on our ftp server and return a set of files 
of which  02 EN AR final.pdf is one of them

2)  I then copy a URL address that returns a 404 indicating it couldn't 
find the file in question ie.  http://www.cpcpension.com/files/2002EN AR final.pdf

3)  I do a  split-paths to-url on the contents of the clipboard:// 
that contains item in step 2)

4)  I compare the file names for equality either using "=" or equal? 
and both return false
5)  I check the type of each file, they are both 'file' types

6)  I check the length of each file, the one from step 1) returns 
20, step 2) returns 26


So, somewhere it is changing the   representation of a space into 
the actual string " ".
Any ideas?
6)

When I execute this command...

print second split-path to-file to-string http://www.cpcpension.com/files/2002EN AR fin
al.pdf
it returns.... 2002 EN AR final.pdf
it converted the  's in the URL

oops... url wrapped above

when I execute this command...
print second split-path to-file to-string read clipboard://
where I have copied the URL above into the clipboard://
it returns.... 2002 EN AR final.pdf

Could someone just show me how to get the 'unset? function return 
true ?! Maybe I'm a bit stupid, but I simply don't get it working. 
Isn't really important, but should still work.
e.g.
unset 'a
bl: [a]
unset? 'a
unset? first bl

????? shouldn't this return true ?????

probe unset? ()
probe unset? get/any 'hey-what?

MichaelB:

unset? 'a <=> is the word 'a an unset! value -> no it's a word! value

unset? first bl <=> is the first element of bl an unset! value -> 
no it's a word! value
to know if a word as a value: value? 'word
value? 'a == false
but

    unset? () == true ; paren! are auto-evaluated, empty paren! -> unset! 
    unset? print 2 == true ; 'print returns no value -> unset!

    unset? get/any 'a == true ; but as "a" is undefined, unset? a -> 
    error!
    unset? unset 'a == true ; 'unset returns unset!
'unset? -> _value_'s datatype! = unset!

unset! is for absence of value too: my-func [an-opt-arg [integer! 
unset!]][...]

- thank you for the answers, I knew there is something like that, 
just couldn't figure it out any more

- actually I tried the unset? get .. version, but of course without 
the any refinement ... so couldn't work

- I didn't know (or forgot) about the optional value possibility, 
good to know 

thanks again :-)

Brock: 'to-url converts a string into an url without escaping, escaping 
is only done when showing the url string: 

to-url "http://www.cpcpension.com/files/2002EN AR final.pdf" ; works 

== http://www.cpcpension.com/files/2002EN AR final.pdf ; blanks 
->  

to-url "http://www.cpcpension.com/files/2002EN AR final.pdf" 
; don't works

== http://www.cpcpension.com/files/2002EN AR final.pdf ; only 
looks the same, but contains "%" "2" "0"
you can use 'do or 'load to interpret the string in clipboard:
do read clipboard://
load read clipboard://
(same with 'to-file)

Off course, I forgot:
to-url dehex read clipboard://

Thanks for the explanations Vincent.  The best solution appears to 
be to-url dehex read clipboard://.   I totally forgot about dehex.

Thanks, Sunanda.  Sorry to take so long to respond. I'm traveling 
and don't always have internet access.

I was thinking of adding a Cookbook entry along the following topic....

; Sorting Unordered Key/Value Pairs

;unordered key/value pairs, keys in each record aren't in the same 
order
data: [
	[fld1 "c" fld2 "1" fld3 "b2"]
	[fld1 "b" fld3 "a1" fld2 "3"]
	[fld3 "c" fld2 "2"  fld1 "a"]
]

; sorts on first text found, value is not sorted
sort data

; notice reverse sort on first text found, value is not sorted
sort/reverse data

; sort on value for fld1 key - ascending order
sort/compare data func[a b] [a/fld1 < b/fld1]

; sort on value for fld1 key - descending order
sort/compare data func[a b] [a/fld1 > b/fld1]

; sort on value for fld2 key - ascending order
sort/compare data func[a b] [a/fld2 < b/fld2]

; sort on value for fld2 key - descending order
sort/compare data func[a b] [a/fld2 > b/fld2]

Any comments or suggestions of items to include/change prior to submitting.

when your compare func returns -1 0 1 instead of a bool you get stable 
sorts

Tom, not sure I follow.  How do I check the return value of the compare 
func?

Your /compare func is returning a boolean value because '< returns 
a boolean value.  If you have it return -1 0 1 then you get a stable 
sort.

Okay, I think I am following.  If my parameters to the function were 
numbers, then using the [sign? a/1 - b/1] would provide a more accurate 
sort due to the tri-state return of the sign? function.  However, 
since I am sorting strings and can AFAIK only compare using <>=, 
are you suggesting I should test all of the states and return 1,0,-1 
as appropriate?

By the way, I was lead to my above solution and similar comments 
thanks to responses by Tom and Volker to Graham's question on AltME 
Rebol world - Core Group, 13 Aug,2004 @ 7:47pm.  Thanks all.

; is this what I am after for the compare function?
[ if a/1 > b/1 [return 1]
  if a/1 = b/1 [return 0]
  if a/1 < b/1 [return -1]
]

You got it!.
And a little shorter, and maybe faster:
  [ if a/1 > b/1 [return 1]
    if a/1 < b/1 [return -1]
    return 0
  ]

Of course, you only need to worry about stable sorting if you have 
duplicate keys and need to retain the original entry sequence for 
them. Other wise [return a/1 < b/1] is fine and fast.