REBOL [
    Title: "Your Values! main file (for prebol.r)" 
    Purpose: "^/        Main file for building Your Values!^/    " 
    Author: "Gabriele Santilli" 
    EMail: giesse@rebol.it 
    File: %main.r 
    License: {
Copyright (C) 2003  Gabriele Santilli

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

http://www.gnu.org/copyleft/gpl.html
    } 
    Date: 9-Nov-2004 
    Version: 1.2.0 
    History: [
        19-Oct-2004 1.1.0 "History start" 
        9-Nov-2004 1.2.0 "Added prevalent-object.r"
    ]
] %/c/rebol/link/colellachiara/projects/your-values-/docs/developer.txt 
export: 
func [
    "Export local words in the global context" 
    words [word! block!] 
    /to dest [object!] "Export to this object instead of SYSTEM/WORDS" 
    /local word
] [
    dest: any [dest system/words] 
    fortype word! to-block words func [word] [
        set/any in dest word get/any word
    ]
] 
import: 
func [
    "Import words from an object" 
    words [word! block!] 
    source [object!]
] [
    fortype word! to-block words func [word] [
        set/any word get/any in source word
    ]
] 
vid-context: 
func [
    "Localize the words in the VID code" 
    vid-block [block!] 
    /to word [word!] "Set this word to the context created" 
    /local ctx
] [
    ctx: clear [] 
    word: any [word 'ctx] 
    fortype set-word! vid-block func [word] [
        insert tail ctx :word
    ] 
    insert tail ctx none 
    bind vid-block in set word context ctx 'self
] 
get-all: 
func [
    "Get (without evaluating) all words in a block" [catch] 
    words [block!]
] [
    words: copy words 
    if not parse words [any [words: word! (change/only words get/any words/1)] end] [
        invalid-argument pick words 1
    ] 
    head words
] 
localize: 
func [
    {Defines words local to a block, but keeps their value} [catch] 
    words [block!] 
    body [block!]
] [
    use words reduce [
        'set copy words throw-on-error [get-all words] 
        'do body
    ]
] 
closure: 
func [
    "Defines a closure with given spec and body." [catch] 
    spec [block!] {Help string (opt) followed by arg words (and opt type and string)} 
    body [block!] "The body block of the closure" 
    /local word words
] [
    words: make block! 2 + length? spec 
    parse spec [
        any [
            set word [word! | refinement!] (insert tail words to word! word) 
            | skip
        ]
    ] 
    throw-on-error [
        make function! spec reduce [
            'localize words 'copy/deep body
        ]
    ]
] 
fortype: 
func [
    {Evaluate a function for each value of a given datatype in a block} 
    datatype [datatype!] 
    block [block!] 
    f [any-function!] 
    /local value
] [
    parse block [
        some [
            to datatype 
            set value datatype (f :value)
        ]
    ]
] 
context [
    ceil: 
    func [num [number!]] [either num > num: to integer! num [num + 1] [num]] 
    nforeach: 
    func [
        {Evaluates a block for each value(s) in one or more series} [catch] 
        args [block!] "Words and series" 
        body [block!] "Block to evaluate each time" 
        /local bargs words end word
    ] [
        bargs: copy [body] 
        words: make block! 16 
        end: 0 
        while [not tail? args] [
            word: pick args 1 
            if not any [
                word? :word block? :word all [get-word? :word any [word? word: get :word block? :word]]
            ] [
                invalid-argument :word
            ] 
            use [series] [
                set [series args] do/next next args 
                if not series? :series [
                    invalid-argument :series
                ] 
                insert tail words word 
                either block? word [
                    repeat j length? word [
                        insert insert insert insert tail bargs [pick :series i - 1 *] length? word '+ j
                    ] 
                    end: max end ceil divide length? :series length? word
                ] [
                    insert tail bargs [pick :series i] 
                    end: max end length? :series
                ]
            ]
        ] 
        if any [empty? words empty? bargs] [return none] 
        body: func words body 
        repeat i end bargs
    ] 
    export 'nforeach
] 
context [
    config: context [] 
    setconf: func [conf [block! object!]] [config: :conf] 
    load-config: 
    func [
        "Load configuration values from a file" 
        file [file! url! block!]
    ] [
        attempt [setconf load file] 
        if block? config [
            config: construct config
        ] 
        config
    ] 
    save-config: 
    func [
        "Save configuration values to a file" 
        file [file! url!]
    ] [
        save/all file config
    ] 
    get-config: 
    func [
        "Get a configuration value" 
        word [word!] "The name of the configuration value" 
        /default default' "Use this default value instead of NONE" 
        /accept types [datatype! block!] {Only accept the value if it is of one of the given types}
    ] [
        either all [
            word: in config word 
            any [not types find reduce to block! types type? get/any word]
        ] [
            get/any word
        ] [
            :default'
        ]
    ] 
    set-config: 
    func [
        "Set a configuration value" 
        word [word!] "The name of the configuration value" 
        value 
        /save file [file! url!] "Save the configuration after setting the value"
    ] [
        if not in config word [
            config: make config reduce [
                to set-word! word none
            ]
        ] 
        set/any in config word :value 
        if save [save-config file] 
        :value
    ] 
    merge-config: 
    func [
        {Merge a configuration object into the current configuraion} 
        values [object! block!]
    ] [
        if block? values [values: construct values] 
        foreach word next first values [
            set-config word get in values word
        ]
    ] 
    export [
        load-config "Load configuration values from a file" 
        save-config "Save configuration values to a file" 
        get-config "Get a configuration value" 
        set-config "Set a configuration value" 
        merge-config "Merge new configuration values"
    ]
] 
get-current-platform: 
func [
    "Return name of current platform as a word"
] [
    pick [
        Amiga Mac Windows Linux BeOS BSDi FreeBSD NetBSD OpenBSD Solaris Irix HP-UX
    ] pick system/version 4
] 
zero-padded: 
func [
    "Left pad a number or string with zeros." 
    n [number! string!] "Number to pad" 
    len [integer!] {Desired length (the number will be truncated if it is longer!)}
] [
    copy skip 
    insert 
    insert/dup 
    clear "" 
    #"0" 
    len 
    n 
    negate len
] 
substitute: 
func [
    "Do variable substitution inside a string" 
    string [any-string!] 
    vars [object! block!] 
    /local rule out start end emit
] [
    out: make string 2 + length? string 
    emit: func [str] [insert tail out :str] 
    rule: make block! 256 
    if block? vars [vars: context vars] 
    foreach word next first vars [
        insert tail rule compose/deep [
            (either empty? rule [] ['|]) 
            (form word) ">" (to paren! bind compose [emit (word)] in vars 'self)
        ]
    ] 
    parse/all string [
        any [
            start: 
            to "<" end: (insert/part tail out start end) 
            ["<" rule | skip (emit "<")]
        ] 
        (insert tail out start)
    ] 
    out
] 
if-error: 
func [
    "Tries to DO code, then DOes on-error if it fails" [throw] 
    code [block!] 
    on-error [block!] "The word 'error will refer to the error" 
    /local result
] [
    on-error: func [[throw] error [error!]] on-error 
    either error? set/any 'result try code [on-error :result] [get/any 'result]
] 
invalid-argument: 
func [
    {Throw an "Invalid argument" error} 
    arg
] [
    throw make error! join [script invalid-arg] :arg
] 
form-error: 
func [
    "Forms an error message" 
    errobj [object!] "Disarmed error" 
    /all "Use the same format as the REBOL console" 
    /local errtype text
] [
    errtype: get in system/error get in errobj 'type 
    text: get in errtype get in errobj 'id 
    if block? text [text: reform bind/copy text in errobj 'self] 
    either all [
        rejoin [
            "** " get in errtype 'type ": " text newline 
            either get in errobj 'where [join "** Where: " [mold get in errobj 'where newline]] [""] 
            either get in errobj 'near [join "** Near: " [mold/only get in errobj 'near newline]] [""]
        ]
    ] [
        text
    ]
] 
context [
    log-level: 0 
    log-file: %default.log 
    set-log: 
    func [
        "Set logging options" 
        file [file!] "Log file name" 
        level [integer!] "Log file level"
    ] [
        log-level: level 
        log-file: file
    ] 
    append-log: 
    func [
        "Append a line to the log file" 
        level [integer!] "Line level" 
        line [string! block!]
    ] [
        if level <= log-level [
            write/append/lines log-file append rejoin ["[" now "] "] reduce line
        ]
    ] 
    export [
        set-log "Function to set logging options" 
        append-log "Function to append a line to the log file"
    ]
] 
rsa-new-keypair: 
has [k] [
    k: rsa-make-key 
    rsa-generate-key k 1024 3 
    k
] 
rsa-save-key: 
func [
    "Encrypts and saves a RSA key object" 
    file [file! url! object! block! port!] "File to save to" 
    k [object!] "RSA key" 
    passphrase [any-string!] {Pass phrase to use to encrypt the key (at least 16 characters long)} 
    /local crypt-port
] [
    crypt-port: make port! [
        scheme: 'crypt 
        algorithm: 'rijndael 
        direction: 'encrypt 
        strength: 128 
        key: copy/part checksum/secure passphrase 16 
        padding: true
    ] 
    open crypt-port 
    insert crypt-port mold/all k 
    update crypt-port 
    write/binary file copy crypt-port 
    close crypt-port
] 
rsa-load-key: 
func [
    "Decrypts and loads a RSA key object" 
    file [file! url! object! block! port!] "File to load from" 
    passphrase [any-string!] "Pass phrase used to encrypt the key" 
    /local crypt-port k
] [
    crypt-port: make port! [
        scheme: 'crypt 
        algorithm: 'rijndael 
        direction: 'decrypt 
        strength: 128 
        key: copy/part checksum/secure passphrase 16 
        padding: true
    ] 
    open crypt-port 
    insert crypt-port read/binary file 
    update crypt-port 
    k: attempt [load to string! copy crypt-port] 
    close crypt-port 
    k
] 
rsa-load-public-key: 
func [
    {Creates a RSA key object from a public key binary data} 
    public-key [binary!] 
    /local k
] [
    k: rsa-make-key 
    k/e: 3 
    k/n: public-key 
    k
] 
rsa-check-signature: 
func [
    {Checks some data against a RSA signature, returns TRUE if it's valid} 
    k [object!] "Public key" 
    data [any-string!] 
    signature [binary!]
] [
    all [
        signature: attempt [rsa-encrypt/decrypt k signature] 
        signature = checksum/secure data
    ]
] 
rsa-make-signature: 
func [
    "Generates a RSA signature for the given data" 
    k [object!] "Private key" 
    data [any-string!]
] [
    rsa-encrypt/private k checksum/secure data
] 
{STUFF FROM LADISLAV ------------------------------------------------} 
include: :comment 
comment [
    ex1: function [[catch]] [r] [
        set/any 'r throw-on-error a 
        do b
    ] 
    ex2: function [[catch]] [r] [
        if none? set/any 'r attempt a [
            throw make error! "error"
        ] 
        do b
    ] 
    ex3: function [[catch]] [r] [
        set/any 'r default a 'error [throw error] 
        do b
    ] 
    a: [return "OK"] 
    b: ["KO"] 
    ex1 
    ex2 
    ex3 
    a: [()] 
    b: ["OK"] 
    ex1 
    ex2 
    ex3 
    a: [none] 
    b: ["OK"] 
    ex1 
    ex2 
    ex3
] 
default: func [
    "Execute code. If error occurs, execute fault." 
    [throw] 
    code [block!] "Code to execute" 
    error [word!] "The error variable" 
    fault [block!] "Error handler"
] [
    either error? set/any 'code try code [
        do make function! reduce [[throw] error [error!]] fault code
    ] [get/any 'code]
] 
get-e: func [
    "get an error attribute" 
    error [error!] 
    attribute [word!]
] [
    get in disarm error attribute
] 
set-e: func [
    "set an error attribute" 
    error [error!] 
    attribute [word!] 
    value
] [
    set in disarm error attribute value
] 
comment [
    throw-on-error: func [
        {Evaluates a block. If it results in an error, throws the error.} 
        [throw] 
        blk [block!]
    ] [
        if error? set/any 'blk try blk [throw blk] 
        get/any 'blk
    ]
] 
comment [
    default2: tfunc [
        code [block!] 
        fault [block!] 
        /good pass [block!] 
        /local result error code2
    ] [
        transp-while [not tail? code] [
            if error? error: try [
                code2: second do/next compose [
                    error? set/any 'result (code)
                ] 
                code: skip code (index? code2) - 3
            ] [code: tail code]
        ] 
        either error? error [
            fault: func [[throw] error [error!]] fault 
            fault error
        ] [
            do any [pass [local-return get/any 'result]]
        ]
    ]
] 
include %default.r 
tfunc: func [
    {
            Create a function, which:
            - is transparent for return, exit, throw
            - can return any value using return'
            - can exit using exit'
            - can handle errors using throw'
            - is transparent for "foreign" return', exit', throw'
        } 
    [catch] 
    spec [block!] {Help string (opt) followed by arg words (and opt type and string)} 
    body [block!] "The body block of the function"
] [
    spec: copy spec 
    unless string? pick spec 1 [insert spec "(undocumented)"] 
    unless any [
        block? pick spec 2 
        string? pick spec 2
    ] [insert/only next spec "tfunc"] 
    use [f spc] [
        use [return' exit' throw'] [
            return': make function! [[throw] value [any-type!]] [
                spc/2: "tfunc" 
                return get/any 'value
            ] 
            exit': make function! [[throw]] [
                spc/2: "tfunc" 
                exit
            ] 
            throw': make function! [error [error!]] [
                spc/2: [catch] 
                throw error
            ] 
            body: bind/copy body 'return' 
            f: default [make function! spec compose [1 2 (body)]] 'error [
                throw error
            ] 
            spc: third :f 
            change second :f [spc/2: [throw]] 
            :f
        ]
    ]
] 
tbody: func [
    "the body of a Tfunc" 
    f [function!]
] [
    skip second :f 2
] 
system/error/throw: make system/error/throw [
    no-tfunc: "Return', exit' or throw' not in a tfunc"
] 
return': func [[catch]] [throw make error! [throw no-tfunc]] 
exit': func [[catch]] [throw make error! [throw no-tfunc]] 
throw': func [[catch]] [throw make error! [throw no-tfunc]] 
include %tfunc.r 
comment [
    f: func [x [any-type!]] [type? get/any 'x] 
    b: pass-args :f 'x 
    x: 1 
    b 
    unset 'x 
    b 
    x: first [:x] 
    b 
    f: func [:x [any-type!]] [type? get/any 'x] 
    b: pass-args :f 'x 
    x: 1 
    b 
    unset 'x 
    b 
    x: first [:x] 
    b 
    f: func ['x [any-type!]] [type? get/any 'x] 
    b: pass-args :f 'x 
    x: 1 
    b 
    unset 'x 
    b 
    x: first [:x] 
    b 
    anti-function: func [
        "create a function returning negated result of F" 
        f [any-function!] 
        /local result context
    ] [
        use [call] [
            context: to word! any [pick first :f 1 'none] 
            result: make function! load mold third :f reduce [context] 
            context: first second :result 
            change clear second :result [not call] 
            call: pass-args :f context 
            :result
        ]
    ]
] 
comment [
    [
        path: to path! 'fn 
        call: make block! 8 
        insert call [return'] 
        insert/only tail call path 
        insert tail call args 
        if ref [
            insert tail path 'ref 
            insert tail call args
        ] 
        do call
    ]
] 
pass-args: function [
    {Create a function passing arguments and refinements to given function} 
    f [any-function!] 
    context [any-word! object! port!]
] [item item2 args body1 body2 pass] [
    use [fn path call return'] [
        pass: tfunc [] [return'] 
        return': first tbody :pass 
        fn: :f 
        body1: copy [
            path: to path! 'fn 
            call: make block! 8 
            insert call return' 
            insert/only tail call path
        ] 
        args: make block! 0 
        body2: compose [
            insert tail call (reduce [args])
        ] 
        parse first :f [
            any [
                set item word! (
                    item: bind to lit-word! item context 
                    insert tail args compose [get/any (:item)]
                ) | set item refinement! (
                    item: bind to word! item context 
                    args: make block! 0 
                    insert tail body2 compose/deep [
                        if (item) [
                            insert tail path (to lit-word! item) 
                            insert tail call (reduce [args])
                        ]
                    ]
                ) | set item lit-word! (
                    item: bind :item context 
                    item2: bind to get-word! :item context 
                    insert p: tail args none 
                    insert tail body1 compose/deep [
                        change (reduce [p]) either value? (:item) [
                            first [(item2)]
                        ] [
                        ]
                    ]
                ) | set item get-word! (
                    item: bind to word! item context 
                    insert tail args item
                )
            ]
        ] 
        change tbody :pass compose [
            (body1) 
            (body2) 
            do call
        ] 
        :pass
    ]
] 
{END STUFF FROM LADISLAV --------------------------------------------} 
type?*: 
func [
    "Extended TYPE? function; always returns a WORD!" 
    value [any-type!]
] [
    either object? get/any 'value [
        either in value 'type [
            value/type
        ] [
            'object!
        ]
    ] [
        type?/word get/any 'value
    ]
] 
custom-type?: 
func [
    "Returns TRUE if the value is of a custom type" 
    value [any-type!]
] [
    found? all [object? get/any 'value in value 'type in value 'actions]
] 
define-action: 
func [
    "Defines a user action with given spec" [catch] 
    name [word!] "Action name" 
    spec [block!] {Help string (opt) followed by arg words (and opt type and string)} 
    /local first-arg name' native
] [
    if not parse spec [opt string! opt block! set first-arg word! to end] [
        invalid-argument spec
    ] 
    name': form name 
    if #"*" = last name' [remove back tail name'] 
    native: to word! name' 
    if all [value? native action? get native] [native: get native] 
    name': to word! append name' #"'" 
    use [magic] [
        set name func spec compose/deep/only [
            (to lit-word! first-arg) 
            either custom-type? (to get-word! first-arg) [
                (head insert insert insert make path! 4 first-arg 'actions name')
            ] [
                magic
            ]
        ] 
        either action? :native [
            magic: pass-args :native first second get name
        ] [
            magic: does compose [invalid-argument (fourth second get name)]
        ]
    ]
] 
use [i] [
    i: 1 
    foreach name [
        first second third fourth fifth sixth seventh eighth ninth tenth
    ] [
        set to word! join name "*" func compose [
            (rejoin ["Returns the " name " value of a series."]) [catch] 
            series
        ] compose [
            pick* :series (i)
        ] 
        i: i + 1
    ]
] 
foreach [name spec] [add* [
        "Returns the result of adding two values." [catch] 
        value1 [number! pair! char! money! date! time! tuple! object!] 
        value2 [number! pair! char! money! date! time! tuple! object!]
    ] subtract* [
        {Returns the second value subtracted from the first.} [catch] 
        value1 [number! pair! char! money! date! time! tuple! object!] 
        value2 [number! pair! char! money! date! time! tuple! object!]
    ] multiply* [
        "Returns the first value multiplied by the second." [catch] 
        value1 [number! pair! char! money! time! tuple! object!] 
        value2 [number! pair! char! money! time! tuple! object!]
    ] divide* [
        "Returns the first value divided by the second." [catch] 
        value1 [number! pair! char! money! time! tuple! object!] 
        value2 [number! pair! char! money! time! tuple! object!]
    ] remainder* [
        {Returns the remainder of first value divided by second.} [catch] 
        value1 [number! pair! char! money! time! tuple! object!] 
        value2 [number! pair! char! money! time! tuple! object!]
    ] power* [
        {Returns the first number raised to the second number.} [catch] 
        number [number! object!] 
        exponent [number! object!]
    ] and~* [
        "Returns the first value ANDed with the second." [catch] 
        value1 [logic! number! char! tuple! binary! image! object!] 
        value2 [logic! number! char! tuple! binary! image! object!]
    ] or~* [
        "Returns the first value ORed with the second." [catch] 
        value1 [logic! number! char! tuple! binary! image! object!] 
        value2 [logic! number! char! tuple! binary! image! object!]
    ] xor~* [
        {Returns the first value exclusive ORed with the second.} [catch] 
        value1 [logic! number! char! tuple! binary! image! object!] 
        value2 [logic! number! char! tuple! binary! image! object!]
    ] same?* [
        "Returns TRUE if the values are identical." [catch] 
        value1 
        value2
    ] equal?* [
        "Returns TRUE if the values are equal." [catch] 
        value1 value2
    ] strict-equal?* [
        {Returns TRUE if the values are equal and of the same datatype.} [catch] 
        value1 value2
    ] not-equal?* [
        "Returns TRUE if the values are not equal." [catch] 
        value1 value2
    ] strict-not-equal?* [
        {Returns TRUE if the values are not equal and not of the same datatype.} [catch] 
        value1 value2
    ] greater?* [
        {Returns TRUE if the first value is greater than the second value.} [catch] 
        value1 value2
    ] lesser?* [
        {Returns TRUE if the first value is less than the second value.} [catch] 
        value1 value2
    ] greater-or-equal?* [
        {Returns TRUE if the first value is greater than or equal to the second value.} [catch] 
        value1 value2
    ] lesser-or-equal?* [
        {Returns TRUE if the first value is less than or equal to the second value.} [catch] 
        value1 value2
    ] negate* [
        "Changes the sign of a number." [catch] 
        number [number! pair! money! time! bitset! object!]
    ] complement* [
        "Returns the one's complement value." [catch] 
        value [logic! number! char! tuple! bitset! object!]
    ] random* [
        "Returns a random value of the same datatype." [catch] 
        value "Maximum value of result" 
        /seed "Restart or randomize" 
        /secure "Returns a cryptographically secure random number." 
        /only "Return single value from series."
    ] odd?* [
        "Returns TRUE if the number is odd." [catch] 
        number [number! char! date! money! time! object!]
    ] even?* [
        "Returns TRUE if the number is even." [catch] 
        number [number! char! date! money! time! object!]
    ] negative?* [
        "Returns TRUE if the number is negative." [catch] 
        number [number! char! money! time! object!]
    ] positive?* [
        "Returns TRUE if the value is positive." [catch] 
        number [number! char! money! time! object!]
    ] zero?* [
        "Returns TRUE if the number is zero." [catch] 
        number [number! pair! char! money! time! tuple! object!]
    ] head* [
        "Returns the series at its head." [catch] 
        series [series! port! object!]
    ] tail* [
        {Returns the series at the position after the last value.} [catch] 
        series [series! port! object!]
    ] head?* [
        "Returns TRUE if a series is at its head." [catch] 
        series [series! port! object!]
    ] tail?* [
        "Returns TRUE if a series is at its tail." [catch] 
        series [series! port! bitset! object!]
    ] next* [
        "Returns the series at its next position." [catch] 
        series [series! port! object!]
    ] back* [
        "Returns the series at its previous position." [catch] 
        series [series! port! object!]
    ] skip* [
        {Returns the series forward or backward from the current position.} [catch] 
        series [series! port! object!] 
        offset [number! logic! pair!] "Can be positive, negative, or zero."
    ] at* [
        "Returns the series at the specified index." [catch] 
        series [series! port! object!] 
        index [number! logic! pair!] "Can be positive, negative, or zero."
    ] index?* [
        {Returns the index number of the current position in the series.} [catch] 
        series [series! port! object!]
    ] length?* [
        {Returns the length of the series from the current position.} [catch] 
        series [series! port! tuple! bitset! struct! object!]
    ] pick* [
        {Returns the value at the specified position in a series.} [catch] 
        series [series! pair! event! money! date! time! object! port! tuple! any-function!] 
        index [number! logic! pair!]
    ] last* [
        "Returns the last value of a series." [catch] 
        series [series! port! tuple! object!]
    ] find* [
        {Finds a value in a series and returns the series at the start of it.} [catch] 
        series [series! port! bitset! object!] 
        value [any-type!] 
        /part "Limits the search to a given length or position." 
        range [number! series! port! object!] 
        /only "Treats a series value as a single value." 
        /case "Characters are case-sensitive." 
        /any "Enables the * and ? wildcards." 
        /with "Allows custom wildcards." 
        wild [string!] "Specifies alternates for * and ?" 
        /skip "Treat the series as records of fixed size" 
        size [integer!] 
        /match {Performs comparison and returns the tail of the match.} 
        /tail "Returns the end of the string." 
        /last "Backwards from end of string." 
        /reverse "Backwards from the current position."
    ] select* [
        {Finds a value in the series and returns the value or series after it.} [catch] 
        series [series! port! object!] 
        value [any-type!] 
        /part "Limits the search to a given length or position." 
        range [number! series! port! object!] 
        /only "Treats a series value as a single value." 
        /case "Characters are case-sensitive." 
        /any "Enables the * and ? wildcards." 
        /with "Allows custom wildcards." 
        wild [string!] "Specifies alternates for * and ?" 
        /skip "Treat the series as records of fixed size" 
        size [integer!]
    ] make* [
        "Constructs and returns a new value." [catch] 
        type [any-type!] "The datatype or example value." 
        spec [any-type!] "The attributes of the new value."
    ] copy* [
        "Returns a copy of a value." [catch] 
        value [series! port! bitset! object!] "Usually a series" 
        /part "Limits to a given length or position." 
        range [number! series! port! pair! object!] 
        /deep "Also copies series values within the block."
    ] insert* [
        {Inserts a value into a series and returns the series after the insert.} [catch] 
        series [series! port! bitset! object!] "Series at point to insert" 
        value [any-type!] "The value to insert" 
        /part "Limits to a given length or position." 
        range [number! series! port! pair! object!] 
        /only "Inserts a series as a series." 
        /dup "Duplicates the insert a specified number of times." 
        count [number! pair!]
    ] remove* [
        {Removes value(s) from a series and returns after the remove.} [catch] 
        series [series! port! bitset! none! object!] 
        /part "Removes to a given length or position." 
        range [number! series! port! pair! object!]
    ] change* [
        {Changes a value in a series and returns the series after the change.} [catch] 
        series [series! port! object!] "Series at point to change" 
        value [any-type!] "The new value" 
        /part {Limits the amount to change to a given length or position.} 
        range [number! series! port! pair! object!] 
        /only "Changes a series as a series." 
        /dup "Duplicates the change a specified number of times." 
        count [number! pair!]
    ] poke* [
        {Returns value after changing its data at the given index. (See manual)} [catch] 
        value [series! money! date! time! object! port! tuple!] 
        index [number! logic! pair!] 
        data "new value"
    ] clear* [
        {Removes all values from the current index to the tail. Returns at tail.} [catch] 
        series [series! port! bitset! none! object!]
    ] trim* [
        {Removes whitespace from a string. Default removes from head and tail.} [catch] 
        series [series! port! object!] 
        /head "Removes only from the head." 
        /tail "Removes only from the tail." 
        /auto "Auto indents lines relative to first line." 
        /lines "Removes all line breaks and extra spaces." 
        /all "Removes all whitespace." 
        /with str [char! string!] "Same as /all, but removes characters in 'str'."
    ] sort* [
        "Sorts a series." [catch] 
        series [series! port! object!] 
        /case "Case sensitive sort." 
        /skip "Treat the series as records of fixed size." 
        size [integer!] "Size of each record." 
        /compare "Comparator offset, block or function." 
        comparator [integer! block! function!] 
        /part "Sort only part of a series." 
        length [integer!] "Length of series to sort." 
        /all "Compare all fields" 
        /reverse "Reverse sort order"
    ] min* [
        "Returns the lesser of the two values." [catch] 
        value1 [number! pair! char! money! date! time! tuple! series! object!] 
        value2 [number! pair! char! money! date! time! tuple! series! object!]
    ] max* [
        "Returns the greater of the two values." [catch] 
        value1 [number! pair! char! money! date! time! tuple! series! object!] 
        value2 [number! pair! char! money! date! time! tuple! series! object!]
    ] abs* [
        "Returns the absolute value." [catch] 
        value [number! pair! money! time! object!]
    ] empty?* [
        "Returns TRUE if a series is at its tail." [catch] 
        series [series! port! bitset! object!]
    ] 
    dismantle [
        {Dismantles the value into pieces that can be used by REBUILD to recreate it} 
        value [object!]
    ] 
    series?* ["Returns TRUE for series values." value [any-type!]]] [
    define-action name spec
] 
rebuild: 
func [
    "Rebuild a dismantled value" 
    pieces [block!] 
    /local type
] [
    'pieces 
    if 'dismantled <> pick pieces 1 [invalid-argument pieces] 
    if not all [word? type: pick pieces 2 custom-type? get/any type] [invalid-argument pieces] 
    type: get type 
    type/actions/rebuild'
] 
get-in: 
func [
    "Get an attribute of a value" [catch] 
    value [object!] 
    attribute 
    /default defval "Default value to return (instead of NONE)"
] [
    'value 
    if paren? :attribute [attribute: do attribute] 
    either custom-type? value [
        value/actions/get-in'
    ] [
        get any [in value attribute 'defval]
    ]
] 
set-in: 
func [
    "Set an attribute of a value" [catch] 
    target [object!] 
    attribute 
    value
] [
    'target 
    if paren? :attribute [attribute: do attribute] 
    either custom-type? target [
        target/actions/set-in'
    ] [
        set in target attribute :value
    ]
] 
get*: 
func [
    "Gets the value of a path." [catch] 
    path [path!] 
    /local value
] [
    value: first path 
    path: next path 
    value: throw-on-error [get value] 
    while [not tail? path] [
        either custom-type? :value [
            value: get-in value first path 
            path: next path
        ] [
            path: head insert copy path 'value 
            value: do path 
            path: tail path
        ]
    ] 
    :value
] 
set*: 
func [
    "Sets the value of a path." [catch] 
    path [path!] 
    value 
    /local target
] [
    throw-on-error [
        target: get* copy/part path -1 + length? path 
        set-in target last path value
    ]
] 
context [
    conversions: context [] 
    set 'define-conversion func [
        "Define a type conversion" 
        from-type [word!] "Converts from this type..." 
        to-type [word!] "...to this type" 
        locals [block!] 
        body [block!] "Conversion code (gets bound to the context of TO*)" 
        /local f
    ] [
        f: has locals body 
        conversions: make conversions compose/deep [
            (to set-word! to-type) make either value? (to lit-word! to-type) [(to-type)] [object!] [
                (to set-word! from-type) :f
            ]
        ] 
        bind second :f to*-context
    ] 
    tmp: none 
    set 'to* func [
        {Constructs and returns a new value after conversion.} [catch] 
        type [any-type!] "The datatype or example value." 
        spec [any-type!] "The attributes of the new value."
    ] [
        tmp: either datatype? get/any 'type [to word! type] [type?* get/any 'type] 
        if not tmp: in conversions tmp [
            invalid-argument get/any 'type
        ] 
        tmp: get tmp 
        if not tmp: in tmp type?* get/any 'spec [
            invalid-argument get/any 'spec
        ] 
        do get tmp
    ] 
    to*-context: third sixth second :to*
] 
define-type: 
func [
    "Define a custom type" [catch] 
    name [word!] "Type name" 
    ctx [block!] "Type context definition" 
    actions' [block!] "Type actions definition" 
    /local name* global-action
] [
    set name context compose [
        type: (to lit-word! name) 
        actions: [] 
        foreach [name locals body] actions' [
            name*: form name 
            if #"'" <> last name* [invalid-argument name] 
            remove back tail name* 
            if not function? set/any 'global-action get/any to word! name* [
                if not function? set/any 'global-action get/any to word! join name* "*" [
                    invalid-argument name
                ]
            ] 
            insert/only insert/only insert insert tail actions to set-word! name 'has locals bind body first second :global-action
        ] 
        actions: context actions 
        (ctx)
    ]
] 
prevalent?: 
func [
    {Returns true if the value is prevalent (i.e. is of one of the Prevayler-alike persistent types)} 
    value [any-type!]
] [
    'value 
    either all [custom-type? get/any 'value in value/actions 'prevalent?'] [
        value/actions/prevalent?'
    ] [
        false
    ]
] 
define-action 'id? [
    "Returns the ID of a prevalent value" 
    value [object!]
] 
define-type 'reference! [] [
    rebuild' [] [
        pick-value third pieces
    ]
] 
define-type 'series-reference! [] [
    rebuild' [] [
        at* head* pick-value third pieces fourth pieces
    ]
] 
dismantle*: 
func [
    "Special version of DISMANTLE for prevalent values" 
    value [object!]
] [
    if not prevalent? value [invalid-argument value] 
    reduce either series?* value [
        ['dismantled 'series-reference! id? value index?* value]
    ] [
        ['dismantled 'reference! id? value]
    ]
] 
dismantle-block: 
func [block [any-block!] /world] [
    forall block [
        case [
            all [prevalent? pick block 1 not world] [
                block/1: dismantle* block/1
            ] 
            custom-type? pick block 1 [
                block/1: dismantle block/1
            ] 
            all [any-block? pick block 1 'dismantled <> pick block/1 1] [
                dismantle-block block/1
            ]
        ]
    ] 
    head block
] 
rebuild-block: 
func [block [any-block!]] [
    forall block [
        case [
            all [block? pick block 1 'dismantled = pick block/1 1] [
                block/1: rebuild block/1
            ] 
            any-block? pick block 1 [
                rebuild-block block/1
            ]
        ]
    ] 
    head block
] 
context [
    world: [] 
    recovering: false 
    log-operation: 
    func [op [block!]] [
        if recovering [exit] 
        if not exists? %data/ [make-dir %data/] 
        write/lines/append %data/log.txt mold/all dismantle-block op
    ] 
    recover: 
    does [
        if not exists? %data/log.txt [exit] 
        recovering: yes 
        foreach step load/all %data/log.txt [
            do rebuild-block step
        ] 
        recovering: no
    ] 
    register-value: 
    func [value] [
        either id? value [
            poke world id? value value 
            id? value
        ] [
            insert tail world :value 
            length? world
        ]
    ] 
    pick-value: 
    func [id /local value] [
        value: pick world id 
        if block? value [
            value: rebuild value
        ] 
        value
    ] 
    save-world: 
    has [world2] [
        dismantle-block/world world2: copy world 
        if not exists? %data/ [make-dir %data/] 
        save/all %data/world2.txt world2 
        if exists? %data/world.txt [delete %data/world.txt] 
        if exists? %data/log.txt [delete %data/log.txt] 
        rename %data/world2.txt %world.txt
    ] 
    init-world: 
    does [
        if exists? %data/world.txt [
            world: load %data/world.txt
        ] 
        recover
    ] 
    export [log-operation register-value pick-value save-world init-world]
] 
define-type 'pblock! [
    id: none 
    values: []
] [
    add' 
    [] 
    [
        invalid-argument :value1
    ] 
    subtract' 
    [] 
    [
        invalid-argument :value1
    ] 
    multiply' 
    [] 
    [
        invalid-argument :value1
    ] 
    divide' 
    [] 
    [
        invalid-argument :value1
    ] 
    remainder' 
    [] 
    [
        invalid-argument :value1
    ] 
    power' 
    [] 
    [
        invalid-argument :number
    ] 
    and~' 
    [] 
    [
        invalid-argument :value1
    ] 
    or~' 
    [] 
    [
        invalid-argument :value1
    ] 
    xor~' 
    [] 
    [
        invalid-argument :value1
    ] 
    same?' 
    [] 
    [
        same? :value1 :value2
    ] 
    equal?' 
    [] 
    [
        either custom-type? :value2 [
            equal?* value2 value1/values
        ] [
            throw-on-error [equal? value1/values :value2]
        ]
    ] 
    strict-equal?' 
    [] 
    [
        all ['pblock! = type?* :value2 value1/values = value2/values]
    ] 
    not-equal?' 
    [] 
    [
        either custom-type? :value2 [
            not-equal?* value2 value1/values
        ] [
            throw-on-error [not-equal? value1/values :value2]
        ]
    ] 
    strict-not-equal?' 
    [] 
    [
        any ['pblock! <> type?* :value2 value1/values <> value2/values]
    ] 
    greater?' 
    [] 
    [
        invalid-argument :value1
    ] 
    lesser?' 
    [] 
    [
        invalid-argument :value1
    ] 
    greater-or-equal?' 
    [] 
    [
        invalid-argument :value1
    ] 
    lesser-or-equal?' 
    [] 
    [
        invalid-argument :value1
    ] 
    negate' 
    [] 
    [
        invalid-argument :number
    ] 
    complement' 
    [] 
    [
        invalid-argument :value
    ] 
    random' 
    [] 
    [
        if seed [invalid-argument :value] 
        value: value/values 
        value: do sixth second :random* 
        either only [
            :value
        ] [
            make* pblock! :value
        ]
    ] 
    odd?' 
    [] 
    [
        invalid-argument :number
    ] 
    even?' 
    [] 
    [
        invalid-argument :number
    ] 
    negative?' 
    [] 
    [
        invalid-argument :number
    ] 
    positive?' 
    [] 
    [
        invalid-argument :number
    ] 
    zero?' 
    [] 
    [
        invalid-argument :number
    ] 
    head' 
    [] 
    [
        make series [values: head series/values]
    ] 
    tail' 
    [] 
    [
        make series [values: tail series/values]
    ] 
    head?' 
    [] 
    [
        head? series/values
    ] 
    tail?' 
    [] 
    [
        tail? series/values
    ] 
    next' 
    [] 
    [
        make series [values: next series/values]
    ] 
    back' 
    [] 
    [
        make series [values: back series/values]
    ] 
    skip' 
    [] 
    [
        make series [values: skip series/values offset]
    ] 
    at' 
    [] 
    [
        make series [values: at series/values index]
    ] 
    index?' 
    [] 
    [
        index? series/values
    ] 
    length?' 
    [] 
    [
        length? series/values
    ] 
    pick' 
    [] 
    [
        pick series/values index
    ] 
    last' 
    [] 
    [
        last series/values
    ] 
    find' 
    [] 
    [
        if object? range [
            if not all ['pblock! = type?* range same? head series/values head range/values] [
                invalid-argument range
            ] 
            range: range/values
        ] 
        make series [
            set 'series series/values 
            values: do sixth second :find* 
            if not values [return none]
        ]
    ] 
    select' 
    [] 
    [
        if object? range [
            if not all ['pblock! = type?* range same? head series/values head range/values] [
                invalid-argument range
            ] 
            range: range/values
        ] 
        series: series/values 
        do sixth second :select*
    ] 
    make' 
    [] 
    [
        switch/default type?* get/any 'spec [
            block! [spec: copy spec] 
            pblock! [spec: copy spec/values]
        ] [
            spec: to* block! :spec
        ] 
        log-operation compose/only [
            make* pblock! (spec)
        ] 
        make pblock! [
            id: register-value self 
            values: spec
        ]
    ] 
    copy' 
    [] 
    [
        if object? range [
            either all ['pblock! = type?* range same? head value/values head range/values] [
                range: range/values
            ] [
                invalid-argument range
            ]
        ] 
        value: value/values 
        make* pblock! do sixth second :copy*
    ] 
    insert' 
    [path operation] 
    [
        if object? range [
            if not all ['pblock! = type?* range same? head series/values head range/values] [
                invalid-argument range
            ]
        ] 
        operation: reduce [path: make path! [insert*] series 'first reduce [get/any 'value]] 
        if part [
            insert tail path 'part 
            insert/only tail operation range
        ] 
        if only [insert tail path 'only] 
        if dup [
            insert tail path 'dup 
            insert tail operation count
        ] 
        log-operation operation 
        if object? range [range: range/values] 
        make series [
            set 'series series/values 
            values: do sixth second :insert*
        ]
    ] 
    remove' 
    [path operation] 
    [
        if object? range [
            if not all ['pblock! = type?* range same? head series/values head range/values] [
                invalid-argument range
            ]
        ] 
        operation: reduce [path: make path! [remove*] series] 
        if part [
            insert tail path 'part 
            insert/only tail operation range
        ] 
        log-operation operation 
        if object? range [range: range/values] 
        make series [
            set 'series series/values 
            values: do sixth second :remove*
        ]
    ] 
    change' 
    [path operation] 
    [
        if object? range [
            if not all ['pblock! = type?* range same? head series/values head range/values] [
                invalid-argument range
            ]
        ] 
        operation: reduce [path: make path! [change*] series 'first reduce [get/any 'value]] 
        if part [
            insert tail path 'part 
            insert/only tail operation range
        ] 
        if only [insert tail path 'only] 
        if dup [
            insert tail path 'dup 
            insert tail operation count
        ] 
        log-operation operation 
        if object? range [range: range/values] 
        make series [
            set 'series series/values 
            values: do sixth second :change*
        ]
    ] 
    poke' 
    [] 
    [
        log-operation reduce [
            'poke* value index 'first reduce [:data]
        ] 
        poke value/values index :data
    ] 
    clear' 
    [] 
    [
        log-operation reduce [
            'clear* series
        ] 
        clear series/values
    ] 
    trim' 
    [] 
    [
        invalid-argument :series
    ] 
    sort' 
    [path operation orig] 
    [
        operation: reduce [path: make path! [sort*] series] 
        if case [insert tail path 'case] 
        if skip [
            insert tail path 'skip 
            insert tail operation size
        ] 
        if compare [
            insert tail path 'compare 
            insert tail operation reduce ['first reduce [:comparator]]
        ] 
        if part [
            insert tail path 'part 
            insert tail operation length
        ] 
        if all [insert tail path 'all] 
        if reverse [insert tail path 'reverse] 
        log-operation operation 
        orig: series 
        series: series/values 
        do sixth second :sort* 
        orig
    ] 
    min' 
    [] 
    [
        invalid-argument :value1
    ] 
    max' 
    [] 
    [
        invalid-argument :value1
    ] 
    abs' 
    [] 
    [
        invalid-argument :value
    ] 
    empty?' 
    [] 
    [
        empty? series/values
    ] 
    prevalent?' 
    [] 
    [
        true
    ] 
    id?' 
    [] 
    [
        value/id
    ] 
    dismantle' 
    [] 
    [
        reduce [
            'dismantled 
            'pblock! 
            value/id 
            dismantle-block copy/deep value/values
        ]
    ] 
    rebuild' 
    [value] 
    [
        value: make pblock! [
            id: third pieces 
            values: copy/deep fourth pieces
        ] 
        register-value value 
        rebuild-block value/values 
        value
    ] 
    series?' 
    [] 
    [
        true
    ] 
    get-in' 
    [] 
    [
        either integer? :attribute [
            pick* value attribute
        ] [
            select* value :attribute
        ]
    ] 
    set-in' 
    [] 
    [
        either integer? :attribute [
            poke* target attribute :value
        ] [
            if not target: find* target :attribute [invalid-argument :attribute] 
            change*/only next* target :value 
            :value
        ]
    ]
] 
define-type 'pobject! [
    id: none 
    values: context []
] [
    add' 
    [] 
    [
        invalid-argument :value1
    ] 
    subtract' 
    [] 
    [
        invalid-argument :value1
    ] 
    multiply' 
    [] 
    [
        invalid-argument :value1
    ] 
    divide' 
    [] 
    [
        invalid-argument :value1
    ] 
    remainder' 
    [] 
    [
        invalid-argument :value1
    ] 
    power' 
    [] 
    [
        invalid-argument :number
    ] 
    and~' 
    [] 
    [
        invalid-argument :value1
    ] 
    or~' 
    [] 
    [
        invalid-argument :value1
    ] 
    xor~' 
    [] 
    [
        invalid-argument :value1
    ] 
    same?' 
    [] 
    [
        same? :value1 :value2
    ] 
    equal?' 
    [] 
    [
        either custom-type? :value2 [
            equal?* value2 value1/values
        ] [
            throw-on-error [equal? value1/values :value2]
        ]
    ] 
    strict-equal?' 
    [] 
    [
        all ['pobject! = type?* :value2 value1/values = value2/values]
    ] 
    not-equal?' 
    [] 
    [
        either custom-type? :value2 [
            not-equal?* value2 value1/values
        ] [
            throw-on-error [not-equal? value1/values :value2]
        ]
    ] 
    strict-not-equal?' 
    [] 
    [
        any ['pobject! <> type?* :value2 value1/values <> value2/values]
    ] 
    greater?' 
    [] 
    [
        invalid-argument :value1
    ] 
    lesser?' 
    [] 
    [
        invalid-argument :value1
    ] 
    greater-or-equal?' 
    [] 
    [
        invalid-argument :value1
    ] 
    lesser-or-equal?' 
    [] 
    [
        invalid-argument :value1
    ] 
    negate' 
    [] 
    [
        invalid-argument :number
    ] 
    complement' 
    [] 
    [
        invalid-argument :value
    ] 
    random' 
    [] 
    [
        invalid-argument :value
    ] 
    odd?' 
    [] 
    [
        invalid-argument :number
    ] 
    even?' 
    [] 
    [
        invalid-argument :number
    ] 
    negative?' 
    [] 
    [
        invalid-argument :number
    ] 
    positive?' 
    [] 
    [
        invalid-argument :number
    ] 
    zero?' 
    [] 
    [
        invalid-argument :number
    ] 
    head' 
    [] 
    [
        invalid-argument :series
    ] 
    tail' 
    [] 
    [
        invalid-argument :series
    ] 
    head?' 
    [] 
    [
        invalid-argument :series
    ] 
    tail?' 
    [] 
    [
        invalid-argument :series
    ] 
    next' 
    [] 
    [
        invalid-argument :series
    ] 
    back' 
    [] 
    [
        invalid-argument :series
    ] 
    skip' 
    [] 
    [
        invalid-argument :series
    ] 
    at' 
    [] 
    [
        invalid-argument :series
    ] 
    index?' 
    [] 
    [
        invalid-argument :series
    ] 
    length?' 
    [] 
    [
        invalid-argument :series
    ] 
    pick' 
    [] 
    [
        invalid-argument :series
    ] 
    last' 
    [] 
    [
        invalid-argument :series
    ] 
    find' 
    [] 
    [
        invalid-argument :series
    ] 
    select' 
    [] 
    [
        invalid-argument :series
    ] 
    make' 
    [] 
    [
        if not any [block? :spec object? :spec] [invalid-argument :spec] 
        spec: make type/values spec 
        log-operation compose/only [
            make* pobject! (third spec)
        ] 
        make pobject! [
            id: register-value self 
            values: spec
        ]
    ] 
    copy' 
    [] 
    [
        invalid-argument :value
    ] 
    insert' 
    [] 
    [
        invalid-argument :series
    ] 
    remove' 
    [] 
    [
        invalid-argument :series
    ] 
    change' 
    [] 
    [
        invalid-argument :series
    ] 
    poke' 
    [] 
    [
        invalid-argument :value
    ] 
    clear' 
    [] 
    [
        invalid-argument :series
    ] 
    trim' 
    [] 
    [
        invalid-argument :series
    ] 
    sort' 
    [] 
    [
        invalid-argument :series
    ] 
    min' 
    [] 
    [
        invalid-argument :value1
    ] 
    max' 
    [] 
    [
        invalid-argument :value1
    ] 
    abs' 
    [] 
    [
        invalid-argument :value
    ] 
    empty?' 
    [] 
    [
        invalid-argument :series
    ] 
    prevalent?' 
    [] 
    [
        true
    ] 
    id?' 
    [] 
    [
        value/id
    ] 
    dismantle' 
    [] 
    [
        reduce [
            'dismantled 
            'pobject! 
            value/id 
            dismantle-block third value/values
        ]
    ] 
    rebuild' 
    [value] 
    [
        value: make pobject! [
            id: third pieces 
            values: fourth pieces
        ] 
        register-value value 
        rebuild-block value/values 
        value/values: construct value/values 
        value
    ] 
    series?' 
    [] 
    [
        false
    ] 
    get-in' 
    [] 
    [
        if not word? :attribute [invalid-argument :attribute] 
        get any [in value/values attribute 'defval]
    ] 
    set-in' 
    [word] 
    [
        if not word? :attribute [invalid-argument :attribute] 
        log-operation reduce [
            'set-in target to lit-word! attribute 'first reduce [:value]
        ] 
        either word: in target/values attribute [
            set word :value
        ] [
            target/values: make target/values reduce [
                to set-word! attribute :first reduce [:value]
            ] 
            :value
        ]
    ]
]