r3wp [groups: 83 posts: 189283]
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

World: r3wp

[Core] Discuss core issues

Ammon
7-Apr-2005
[887]
Jaime, your REST function (AFAICT) has the same functionality as 
NEXT is there any reason that you are not using NEXT?
JaimeVargas
7-Apr-2005
[888x2]
Didn't knew about next. I will use it from now on.
Do you find define-object useful?
Ammon
7-Apr-2005
[890]
I can see how it could be useful in the right environment.
JaimeVargas
7-Apr-2005
[891x3]
;-)
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?
Gabriele
7-Apr-2005
[894x2]
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.
JaimeVargas
7-Apr-2005
[896x2]
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.
Gregg
8-Apr-2005
[898]
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!
Sunanda
8-Apr-2005
[899]
Exactly the sort of useful utility the Library exists for.
And, as Gregg says, much more likely to be found by others there.
JaimeVargas
11-Apr-2005
[900x3]
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.
Ammon
11-Apr-2005
[903x2]
I like it.
So have you put this in the library yet?
JaimeVargas
11-Apr-2005
[905x2]
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
Ammon
11-Apr-2005
[907]
Sweet!  I'll have to play with it...
Louis
11-Apr-2005
[908]
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?
Graham
12-Apr-2005
[909]
run trace/net to see what is going wrong
Sunanda
12-Apr-2005
[910]
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.
Louis
12-Apr-2005
[911x2]
Thanks, Graham.  I had forgotten about trace.


And thanks, Sunanda. system/schemes/ftp/passive: true solved my problem.
Just wondering. Why does this work?
Sunanda
12-Apr-2005
[913]
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.
Ingo
12-Apr-2005
[914x2]
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 ;-)
JaimeVargas
12-Apr-2005
[916x2]
;; 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]]
Vincent
12-Apr-2005
[918]
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]
Ingo
14-Apr-2005
[919]
Thanks Vincent
Brock
15-Apr-2005
[920x4]
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
MichaelB
15-Apr-2005
[924]
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 ?????
Volker
15-Apr-2005
[925]
probe unset? ()
probe unset? get/any 'hey-what?
Vincent
15-Apr-2005
[926]
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!]][...]
MichaelB
15-Apr-2005
[927]
- 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 :-)
Vincent
15-Apr-2005
[928x2]
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://
Brock
15-Apr-2005
[930]
Thanks for the explanations Vincent.  The best solution appears to 
be to-url dehex read clipboard://.   I totally forgot about dehex.
Louis
18-Apr-2005
[931]
Thanks, Sunanda.  Sorry to take so long to respond. I'm traveling 
and don't always have internet access.
Brock
20-Apr-2005
[932x3]
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.
Tomc
20-Apr-2005
[935]
when your compare func returns -1 0 1 instead of a bool you get stable 
sorts
Brock
20-Apr-2005
[936]
Tom, not sure I follow.  How do I check the return value of the compare 
func?