Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

[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 ] ] ]