World: r3wp

writing my own faq

I hope this is useful for someone

REBOL []

rest: func [s [series!]][skip s 1]

define-object: func [
	spec [block!] 
	/local 

  arg-spec ctx-spec object-name constructor-name predicate-name attributes
		spec-rule type-spec continue? w
][
	arg-names: copy []

	continue?: [none] ;used to stop parsing
	name-rule: [set w word! (insert tail arg-names w)]

 type-rule: [set w word! (unless datatype? attempt [get w] [continue?: 
 [end skip]])]

 spec-rule: [name-rule some [name-rule opt [into [some [type-rule 
 continue?]]]]]

	if any [
		not parse spec spec-rule
		arg-names <> unique arg-names
	][
		make error! "invalid spec"
	]

    object-name: to-string first arg-names
	constructor-name: to-word join 'make- object-name
	predicate-name: to-word join first arg-names '?
	attributes: rest arg-names

	arg-spec: copy []
	foreach itm attributes [
		insert tail arg-spec reduce [
			to-word join itm '-value
			either block? w: select spec itm [w][[any-type!]]
		]
	]

	ctx-spec: copy []
	arg-names: extract arg-spec 2 1
	repeat i length? attributes [

  insert tail ctx-spec reduce [to-set-word attributes/:i to-get-word 
  arg-names/:i]
	]

	;create constructor function
	set constructor-name make function! 

  compose [(reform ["Makes a new" uppercase object-name "object with 
  attributes" mold attributes]) (arg-spec)]
		compose/only [make object! (ctx-spec)] ;body

	;create predicate function
	set predicate-name make function! 

  compose [(reform ["Determines if value is a" uppercase object-name 
  "object"]) value [object!] /local types]
		compose/deep/only [
			either (attributes) = rest first value [
				foreach itm (attributes) [
					unless any [

      [any-type!] = types: select (arg-spec) to-word join itm '-value
						find types type?/word value/:itm
					][return false]
				]
				true
			][
				false
			]
		] 
]

With it you can create objects that are type checked when constructed.

;; usage
define-object [name attribute1 [datatype1 ...] ...]
;; creates two functions
make-name
name?

;; example untyped
define-object [point x y]
point? probe o: make-point 1 2
point? probe o: context [x: 1 y: "two"]

;; example typed
define-object [point x [integer!] y [integer!]]
point? probe o: make-point 1 2
point? probe o: context [x: 1 y: "two"]

Jaime, your REST function (AFAICT) has the same functionality as 
NEXT is there any reason that you are not using NEXT?

Didn't knew about next. I will use it from now on.

Do you find define-object useful?

I can see how it could be useful in the right environment.

;-)

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.