[REBOL] Re: Core 2.6 - Last minute requests - take your chance!
From: lmecir:mbox:vol:cz at: 6-Apr-2002 18:09
Hi,
1) here is my version of the FOR function:
Rebol [
Title: "For"
File: %for.r
Date: 20/2/2001/7:21
Author: [
"Rebol Technologies"
"Ladislav Mecir"
]
Email: [lmecir--mbox--vol--cz--r]
Purpose: {
A corrected version of the Rebol mezzanine.
- tail handling repaired for series
- head handling repaired for series
- zero-pass handling repaired for series
- path handling repaired
- throw handling repaired
}
Category: [General]
]
transp-func: function [
{
Create a "local return" and "local throw" function
that is transparent for return and throw
}
[catch]
spec [block!]
body [block!]
] [init] [
spec: copy/deep spec
if not string? pick spec 1 [
insert spec "(undocumented)"
]
if not any [
block? pick spec 2
string? pick spec 2
] [
insert/only next spec "Transparent"
]
use [fnc] [
init: does [
change/only next third :fnc [throw]
]
use [local-return local-throw] [
local-return: func [[throw] result [any-type!]] [
change/only next third :fnc "Transparent"
return get/any 'result
]
local-throw: func [error [error!]] [
change/only next third :fnc [catch]
throw error
]
body: bind/copy body 'local-return
]
fnc: throw-on-error [func spec reduce [:init :do :body]]
]
]
for: transp-func [
{Repeats a block over a range of values.}
'word [word!] {Variable to hold current value}
start [number! series! money! time! date! char!] {Starting value}
end [number! series! money! time! date! char!] {Ending value}
bump [number! money! time! char!] {Amount to skip each time}
body [block!] {Block to evaluate}
/local result do-body op
] [
if (type? :start) <> (type? :end) [
local-throw make error! reduce ['script 'expect-arg 'for 'end type?
:start]
]
do-body: func reduce [[throw] word] body
op: either positive? bump [:greater-or-equal?] [:lesser-or-equal?]
either series? :start [
if not same? head :start head :end [
local-throw make error! reduce ['script 'invalid-arg :end]
]
if op index? :end index? :start [
while [
set/any 'result do-body :start
op (index? :end) - bump index? :start
] [start: skip :start bump]
]
] [
while [op end start] [
set/any 'result do-body start
start: start + bump
]
] get/any 'result
]
{
Examples:
for i 1 4 1 [
if i = 3 [break]
print i
]
for i s: 'a/b/c tail :s 1 [
print :i
]
for i s: [a b c d] tail :s 1 [
print mold i
]
for i s: [a b c d] tail :s -1 [
print mold i
]
pokus: function [[catch] block [block!]] [elem] [
for i 1 length? block 1 [
if error? set/any 'elem first block [
throw make error! {Dangerous element}
]
block: next block
]
]
pokus head insert copy [] make error! "Neco"
}
2) Rounding functions are missing in Rebol, my versions are:
Rebol [
Title: "Rounding"
Purpose: {Rounding functions}
Author: "Ladislav Mecir"
Date: 5/4/2002/8:55
Email: [lmecir--mbox--vol--cz]
File: %rounding.r
Category: [Math]
]
mod: function [
{Compute a non-negative remainder}
a [number!]
b [number!]
] [r] [
either negative? r: a // b [r + abs b] [r]
]
round: func [
{Round a number}
n [number!]
/to
factor [number!] {the number a multiply of which to round to}
] [
if not to [factor: 1]
n: 0.5 * factor + n
n - mod n factor
]
floor: func [
n [number!]
/to
factor [number!] {the number a multiply of which to get}
] [
if not to [factor: 1]
n - mod n factor
]
ceiling: func [
n [number!]
/to
factor [number!] {the number a multiply of which to get}
] [
if not to [factor: 1]
n + mod (- n) factor
]
truncate: func [
n [number!]
/to
factor [number!] {the number a multiply of which to get}
] [
if not to [factor: 1]
n - (n // factor)
]
3) same? for blocks should be repaired. At least it should be as safe as:
same-block?: func [
[catch]
a [any-block!]
b [any-block!]
] [
throw-on-error [
found? all [
same? tail :a tail :b
equal? index? :a index? :b
]
]
]
