set+: func [ ; Inspired by Erlang's list model.
        "Like SET, but words block is dialected."
        words  [any-block!] "Word after | gets remainder of series."
        series [series!]
        /local word= rule=
    ][
        word=: [set word word!]
        rule=: [
            any [
                '| word= (set word series) to end
                | word= (
                    set word pick series 1
                    series: next series
                )
            ]
        ]
        parse words rule=
    ]
    ;set+ [a | rest] [1 2 3 4 5]
    ;set+ [a b | rest] [1 2 3 4 5]
    ;set+ [a b c] [1 2]

    cast: func [ ; convert coerce
        "Convert a value referenced by a word to a new datatype."
        input [block!] "A word, and the target datatype."
        /local words type val
    ] [
        parse input [
            some [
                copy words to 'to skip set type any-type! (
                    ;while [pos: find words 'and] [remove pos]
                    remove-each word words [word = 'and]
                    foreach word words [
                        val: get/any word
                        set/any word to either word? type [get type] [type] val
                    ]
                )
            ]
        ]
    ]
    comment {
        a: "A-0001"
        b: #B002
        c: 300
        d: <H1>
        e: 'test
        cast [a to issue!]      print mold :a
        cast [b to tag!]        print mold :b
        cast [c to decimal!]    print mold :c
        cast [a b c to string!] print remold [:a :b :c]
        cast [a b and c to issue!] print remold [:a :b :c]
        cast [
            a b and c to tag!
            and
            d and e to issue!
        ] print remold [:a :b :c :d :e]
        cast [a b c to <x>  d e to "x"] print remold [:a :b :c :d :e]
    } 

file-size-comparison-ctx: context [
    =negate-op?: none
    =or-equal?: none
    =op: none
    =size: 0
    =size-mul: 1
    =parse-end-mark: none

    make-lit-word: func [val] [to lit-word! :val]
    lit-lesser: make-lit-word "<"
    lit-greater: make-lit-word ">"
    lit-lesser-or-equal: make-lit-word "<="
    lit-greater-or-equal: make-lit-word ">="

    size=: [
        (=size-mul: 1)
        set =size number!
        opt [
            'bytes ; no change to size-mul
            | ['kilobytes | 'KB] (=size-mul: 1024.0)
            | ['megabytes | 'MB] (=size-mul: 1048576.0)
            | ['gigabytes | 'GB] (=size-mul: 1073741824.0)
        ]
        (=size: =size * =size-mul)
    ]
    word-comparison=: [
        [
            ['more | 'bigger | 'larger | 'greater] (=op: 'greater)
            | ['less | 'smaller] (=op: 'lesser)
        ] 'than
        opt ['or 'equal 'to (=or-equal?: true)]
    ]
    lit-comparison=: [
        lit-lesser             (=or-equal?: false  =op: 'lesser)
        | lit-greater          (=or-equal?: false  =op: 'greater)
        | lit-lesser-or-equal  (=or-equal?: true   =op: 'lesser)
        | lit-greater-or-equal (=or-equal?: true   =op: 'greater)
    ]
    rules=: [
        (=negate-op?: =or-equal?: =op: =parse-end-mark: none)
        opt 'if opt ['size | size?]
        opt [['no | 'not] (=negate-op?: true)]
        [word-comparison= | lit-comparison=]
        (if =negate-op? [=op: pick [greater lesser] =op = 'lesser])
        (=op: to word! rejoin [=op either =or-equal? ['-or-equal] [""] '?])
        size=
        =parse-end-mark:
    ]

    set 'size-comparison-cmd? func [input [block!]] [
        parse input rules=
        return =parse-end-mark
    ]

    set 'make-file-size-comparison-func func [spec] [
        parse spec rules=
        either =parse-end-mark [
            func [file] reduce [=op 'size? 'file =size]
        ] [none]
    ]

    set 'files-matching-size-spec func [
        files [block!]
        spec [block!]
    ][
        if match?: make-file-size-comparison-func spec [
            collect 'keep [
                foreach file files [if match? file [keep: file]]
            ]
        ]
    ]
]
;foreach file files-matching-size-spec read %. [>= 64 kb] [print [file size? file]]

file-date-comparison-ctx: context [
    =negate-op?: none
    =or-equal?: none
    =op: none
    =parse-end-mark: none
    =attr: 'modification-date
    =date: none

    make-lit-word: func [val] [to lit-word! :val]
    lit-equal: make-lit-word "="
    lit-lesser: make-lit-word "<"
    lit-greater: make-lit-word ">"
    lit-lesser-or-equal: make-lit-word "<="
    lit-greater-or-equal: make-lit-word ">="

    attr=: [
        ['changed | 'modified | 'upated | 'modification-date]
        | ['created | 'creation-date | 'create-date] (=attr: 'creation-date)
        | ['accessed | 'access-date] (=attr: 'access-date)
    ]
    date=: [
        [
            set =date date!
            | set =date file!      (=date: get-modes =date =attr)
            | 'yesterday (=date: now/date - 1)
            | 'today     (=date: now/date)
            | 'tomorrow  (=date: now/date + 1)
        ]
    ]
    word-comparison=: [
        [
            ['after | 'since | 'newer 'than] (=op: 'greater)
            | ['before | 'older 'than] (=op: 'lesser)
        ]
        opt ['or 'equal 'to (=or-equal?: true)]
    ]
    lit-comparison=: [
        lit-equal              (=or-equal?: false  =op: 'equal)
        | lit-lesser           (=or-equal?: false  =op: 'lesser)
        | lit-greater          (=or-equal?: false  =op: 'greater)
        | lit-lesser-or-equal  (=or-equal?: true   =op: 'lesser)
        | lit-greater-or-equal (=or-equal?: true   =op: 'greater)
    ]
    rules=: [
        (
            =negate-op?: =or-equal?: =op: =parse-end-mark: =date: none
            =attr: 'modification-date
        )
        opt 'if opt ['date | 'date?]
        opt [['no | 'not] (=negate-op?: true)]
        opt ['date | 'date?]
        opt attr=
        [word-comparison= | lit-comparison=]
        (if =negate-op? [=op: pick [greater lesser] =op = 'lesser])
        (=op: to word! rejoin [=op either =or-equal? ['-or-equal] [""] '?])
        date=
        =parse-end-mark:
    ]

    set 'date-comparison-cmd? func [input [block!]] [
        parse input rules=
        return =parse-end-mark
    ]

    set 'make-file-date-comparison-func func [spec] [
        parse spec rules=
        either =parse-end-mark [
            func [file] reduce [=op  'get-modes 'file to lit-word! =attr  =date]
        ] [none]
    ]

    set 'files-matching-date-spec func [
        files [block!]
        spec [block!]
    ][
        if match?: make-file-date-comparison-func spec [
            collect 'keep [
                foreach file files [if match? file [keep: file]]
            ]
        ]
    ]
]
;foreach file files-matching-date-spec read %. [accessed after 1-jan-2006] [print [file modified? file]]
;foreach file files-matching-date-spec read %. [date < 1-jan-2006] [print [file modified? file]]

parse-int-values: func [
    "Parses and returns integer values, each <n> chars long in a string."
    input [any-string!]
    spec [block!] "Dialected block of commands: <n>, skip <n>, done, char, or string"
    /local
        gen'd-rules ; generated rules
        result      ; what we return to the caller
        emit emit-data-rule emit-skip-rule emit-literal-rule emit-data
        digit= n= literal=
        int-rule= skip-rule= literal-rule= done= build-rule=
        data-rule skip-rule
][
    ; This is where we put the rules we build; our gernated parse rules.
    gen'd-rules: copy []
    ; This is where we put the integer results
    result: copy []

    ; helper functions
    emit: func [rule n] [append gen'd-rules replace copy rule 'n n]
    emit-data-rule: func [n] [emit data-rule n]
    emit-skip-rule: func [n] [emit skip-rule n]
    emit-literal-rule: func [value] [append gen'd-rules value]
    emit-data: does [append result to integer! =chars]

    ; Rule templates; used to generate rules
    ;data-rule: [copy =chars n digit= (append result to integer! =chars)]
    data-rule: [copy =chars n digit= (emit-data)]
    skip-rule: [n skip]

    ; helper parse rules
	digit=: charset [#"0" - #"9"]
    n=: [set n integer!]
    literal=: [set lit-val [char! | any-string!]]

    ; Rule generation helper parse rules
    int-rule=: [n= (emit-data-rule n)]
    skip-rule=: ['skip n= (emit-skip-rule n)]
    literal-rule=: [literal= (emit-literal-rule lit-val)]
    done=: ['done (append gen'd-rules [to end])]

    ; This generates the parse rules used against the input
    build-rule=: [some [skip-rule= | int-rule= | literal-rule=] opt done=]

    ; We parse the spec they give us, and use that to generate the
    ; parse rules used against the actual input. If the spec parse
    ; fails, we return none (maybe we should throw an error though);
    ; if the data parse fails, we return false; otherwise they get
    ; back a block of integers. Have to decide what to do if they
    ; give us negative numbers as well.
    either parse spec build-rule= [
        either parse input gen'd-rules [result] [false]
    ] [none]
]
comment {
    test: func [val spec] [print mold parse-int-values val spec]
    test "20060228T190000" [4 2 2 skip 1 2 2 2]
    test "20060228T190000" [4 2 2 #"T" 2 2 2]
    test "20060228T190000Z" [4 2 2 #"T" 2 2 2 #"Z"]
    test "20060228T190000Z" [4 2 2 #"T" 2 2 2 done]
    test %2006021509450004.jpg [4 2 2 2 2 4 skip 4]
    test %2006021509450004.jpg [4 2 2 2 2 4 done]
    ; tests that *should* fail
    ; Bad spec
    test "20060228T190000Z" [4 2 x #"T" 2 2 2]
    test "20060228T190000Z" [4 2 2 #"T" 2.5 2 2]
    ; Bad input
    test "20060228T190000Z" [4 2 2 #"T" 2 2 2]
    test "2000228T190000Z" [4 2 2 #"T" 2 2 2 done]
    test "20060228x190000Z" [4 2 2 #"T" 2 2 2 done]
}

; Localizing a dialect; obviously just a basic idea.

alias 'who   "welche"
alias 'where "wo"
alias 'when  "wann"

rule: [
    some [
        'who   set persons [word! | block!] |
        'where set place string! |
        'when  set time time!
    ]
    to end
]

time: place: persons: none
parse [
    who   Fred
    where "Your house"
    when  9:30
] rule
print [time place persons]

time: place: persons: none
parse [
    welche Karl
    wo     "Euer Haus"
    wann   11:30
] rule
print [time place persons]

REBOL [
    Title:   "#define dialected function"
    File:    %define-dialect.r
    Author:  "Gregg Irwin"
    Version: 0.0.1
    Date:    23-sep-2003
    Purpose: {
        Make it easier to map C #define statements. Eliminates
        the need to manually call datatype conversion functions 
        for each item.
    }
    Comment: {
        The block you pass to the function is a dialect. In the
        dialect you can specify word-value pairs and functions
        used to map different types of values as they are
        processed.

        MAP is used to tell the processor what function to call
        when it encounters a particular datatype value. The
        function specified should take a single value.

            'map datatype function-name

            ; call to-integer when a binary! value is found.
            [map binary! to-integer]

        Other than that, just specify a word followed by a value.
        The resulting block will contain set-word! values for
        each word, followed by its value - which may have been
        converted by a function that was mapped to its original
        datatype.
    }
    Example: {
        do define [
            map binary! to-integer
            map issue!  to-integer

            my-name "Gregg"
            mapped-binary  #{00000001}
            mapped-issue   #000fffff
        ]
        print [my-name mapped-binary mapped-issue]
    }
    library: [
        level:    'intermediate
        platform: 'all
        type:     [function]
        domain:   [dialect parse external-library]
        tested-under: [view 1.2.8.3.1 on W2K]
        support:  none
        license:  none
        see-also: none
    ]
]


define: func [
    block [any-block!]
    /local type fn word val result map
] [
    result: make block length? block
    map: copy []
    either parse block [
        some [
            'map set type word! set fn word! (
                type: do type
                either word: find/skip map type 2 [
                    change next word get fn
                ][
                    append map reduce [type get fn]
                ]
            )
            | set word any-word! set val any-type! (
                append result reduce [
                    to set-word! word
                    either fn: select map type? val [fn val][val]
                ]
            )
        ]
        to end
    ] [result][none]
]


comment [ ; test examples
    print mold defs: define [
        map binary!  to-integer
        map issue!   to-integer

        PFD_DOUBLEBUFFER  #{00000001}
        PFD_STEREO  #{00000002}
        PFD_DRAW_TO_WINDOW  #00000004
        GL_ALL_ATTRIB_BITS  #000fffff
    ]
    do defs
    print [
        PFD_DOUBLEBUFFER
        PFD_STEREO
        PFD_DRAW_TO_WINDOW
        GL_ALL_ATTRIB_BITS
    ]

    halt
]

REBOL [
    Title:  "Library Interface Dialect"
    File:   %lib-dialect.r
    Author: "Gregg Irwin"
    Purpose: {
        Allow for a more concise way to define library routine 
        interfaces.
    }
]

lib-dialect-ctx: context [
;     lib-ctx: make object! [file: lib: none free: does [free lib]]
;     lib-spec: none

    lib: none
    def-rtn-type: none

    name-mods: copy []
    mod-name: func [name] [do join name-mods name]

    ; dump/trace option to show generated code?

    ;has-rtn-type?: does [all [rtn-type  'none <> rtn-type]]
    ; lib is a global word reference in this func.
    make-dll-func: func [reb-name spec rtn-type name] [
        spec: copy any [spec []]
        if all [rtn-type  'none <> rtn-type] [
            append spec compose/deep [return: [(rtn-type)]]
        ]
        ;print ['make-dll-func reb-name mold spec rtn-type mold  mod-name any [name  form reb-name]]
        set reb-name make routine! spec lib  mod-name any [name  form reb-name]
    ]

    data-type: [
        'none | 'char | 'short | 'long | 'integer! | 'string! | 'decimal!
        ; TBD add struct support ?
    ]

    func-decl: [
        (spec: name: none  rtn-type: def-rtn-type)
        set reb-name word!          ;(print reb-name)
        any [
              [set spec block!]     ;(print mold spec)
            | [opt ['returns | 'as] set rtn-type data-type]  ;(print rtn-type)
            | [opt 'calls set name string!]    ;(print name)
        ]
        (make-dll-func reb-name spec rtn-type name)
    ]

    ; You can use this multiple times, e.g. grouping functions by return
    ; type and using it before each group.
    set-def-rtn-type: [
        opt 'set ['def-rtn-type | 'default-return-type]
        set def-rtn-type data-type
    ]

    rules: [
        ['lib | 'library] set file file! (lib: load/library file) ;append lib-spec compose [file: (file)]
        opt [
            ['modify-import-names | 'mod-imports] set name-mods block!
        ]
        any [set-def-rtn-type | func-decl]
    ]

    set 'make-routines func [spec [any-block!]] [
        clear name-mods
        parse spec rules
    ]

;     set 'make-library-interface func [spec] [
;         lib-spec: copy []
;         clear name-mods
;         parse spec rules
;     ]

]

    ;-- collect-based EXCERPT ----------------------------------
    ; Could also change EXTRACT to accept a block value for WIDTH
    ; (renamed to, e.g., SPEC).
    ; The dialect allows you to use commas in the block, but how they
    ; are interpreted is not how you might think. Coming after a number,
    ; they are a valid lexical form, but they denote a decimal! rather
    ; than being seen as a separator, which means you can't use them too
    ; flexibly.
    excerpt: func [
        {Returns the specified items and/or ranges from the series.}
        series  [series!]
        offsets [block!] {Offsets of the items to extract; dialected.}
        /only "return sub-block ranges as blocks"
        /local
            emit-range rules
            from* to* index*    ; parse vars
    ][
        ; always uses ONLY right now; it's a prototype.
        collect/only val [
            emit-range: func [start end] [
                start: to integer! start
                if number? end [end: to integer! end - start + 1]
                val: either end = 'end [copy at series start][
                    copy/part at series start end
                ]
            ]
            rules: [
                some [
                    opt 'from set from* number! 'to set to* number! (
                        emit-range from* to*
                    )
                  | opt 'from set from* number! 'to 'end (emit-range from* 'end)
                  | 'to set to* number! (emit-range 1 to*)
                  | set index* number!  (val: pick series index*)
                  | into rules
                ]
            ]
            parse offsets rules
        ]
    ]
    comment {
        b: [1 2 3 4 5 6 7 8 9 10 11 12 13 14]
        excerpt b [1 3 5]
        excerpt b [1 3 to 6 8]
        excerpt/only b [1, 3 to 6, 8]
        excerpt b [1 [5 to 7] 8]
        excerpt/only b [1 (from 5 to 7) 8]
        excerpt b [(to 2) [4 to 6] 8, 10, from 12 to end]
        excerpt/only b [to 2, 4 to 6, 8, 10, (12 to end)]
        ; Can't use a comma after 'end
        excerpt/only b [to 2 to 6 8 10 to end 12 to end]
        excerpt/only b [to 2, to 6, 8 [10 to end] 12 to end]
        excerpt/only trim {
            REBOL is my favorite language
        } [
            to 5, 10 to 11, 13, 14, 15, 22 to end
        ]
        excerpt/only to binary! {REBOL is my favorite language} [
            to 5, 10 to 11, 13, 14, 15, 22 to end
        ]
    }

    ; What about extending this to work on string values?
    collect: func [  ; a.k.a. gather ?
        [throw]
        {Collects block evaluations.}
        'word "Word to collect (as a set-word! in the block)"
        block [any-block!] "Block to evaluate"
        /into dest [series!] "Where to append results"
        /only "Insert series results as series"
        ;/debug
        /local code marker at-marker? marker* mark replace-marker rules
    ] [
        block: copy/deep block
        dest: any [dest make block! []]
        ; "not only" forces the result to logic!, for use with PICK.
        ; insert+tail pays off here over append.
        ;code: reduce [pick [insert insert/only] not only 'tail 'dest]
        ; FIRST BACK allows pass-thru assignment of value. Speed hit though.
        ;code: reduce ['first 'back pick [insert insert/only] not only 'tail 'dest]
        code: compose [first back (pick [insert insert/only] not only) tail dest]
        marker: to set-word! word
        at-marker?: does [mark/1 = marker]
        ; We have to use change/part since we want to replace only one
        ; item (the marker), but our code is more than one item long.
        replace-marker: does [change/part mark code 1]
        ;if debug [probe code probe marker]
        marker*: [mark: set-word! (if at-marker? [replace-marker])]
        parse block rules: [any [marker* | into rules | skip]]
        ;if debug [probe block]
        do block
        head :dest
    ]

    comment {
        ;collect/debug zz [repeat n 10 [zz: n * 100]]
        collect zz []
        collect zz [repeat i 10 [if (zz: i) >= 3 [break]]]
        collect zz [repeat i 10 [zz: i  if i >= 3 [break]]]
        collect zz [repeat i 10 [either i <= 3 [zz: i][break]]]
        dest: copy []
        collect/into zz [repeat n 10 [zz: n * 100]] dest
        collect zz [for i 1 10 2 [zz: i * 10]]
        collect zz [for x 1 10 1 [zz: x]]
        collect zz [foreach [a b] [1 2 3 4] [zz: a + b]]
        collect zz [foreach w [a b c d] [zz: w]]
        collect zz [repeat e [a b c %.txt] [zz: file? e]]
        iota: func [n [integer!]][collect zz [repeat i n [zz: i]]]
        iota 10
        collect zz [foreach x first system [zz: to-set-word x]]
        x: first system
        collect zz [forall x [zz: length? x]]
        x: first system
        collect zz [forskip x 2 [zz: length? x]]
        collect zz [forskip x 2 [zz: (length? x) / 0]]
        collect/only zz [foreach [a b] [1 2 3 4] [zz: a zz: b zz: reduce [a b a + b]]]
        collect/only zz [
            foreach [a b] [1 2 3 4] [
                zz: a zz: b zz: reduce [a b a + b]
                foreach n reduce [a b a + b] [zz: n * 10]
            ]
        ]

        dest: copy ""
        collect/into zz [repeat n 10 [zz: n * 100 zz: " "]] dest

        dest: copy []
        collect/into zz [
            foreach [num blk] [1 [a b c] 2 [d e f] 3 [g h i]] [
                zz: num
                collect/only/into yy [
                    zz: blk
                    foreach word blk [zz: yy: num  yy: word]
                    yy: blk
                ] dest
            ]
        ] dest

    }