root/trunk/orca/tests/working/xparse.r

REBOL [
    Notes: {
        * 'throw & 'break do not work inside 'parse parens.
    }
]


;pmsg: func [msg] [print ["  PF" msg]]
pmsg: :comment

dpos: none


next-rule: func [it] [
    if it: find it '| [next it]
]


eval-pstr: func [
    ; Returns true/false if matching rule found/not found.
    it
    /local fit res it2
][
    pmsg "eval"
    while [not tail? it]
    [
        fit: first it
        switch/default fit [
            opt [
                eval-pstr second it
                it: skip it 2
            ]

            any [
                until [not eval-pstr second it]
                it: skip it 2
            ]

            some [
                either not eval-pstr second it [
                    pmsg "some fail"
                    it: next-rule it
                ][
                    pmsg "some ok"
                    until [not eval-pstr second it]
                    it: skip it 2
                ]
            ]

            break [
                return true
            ]

            | [
                pmsg "|"
                return true
            ]

            to [
                pmsg it
                res: find dpos second it
                it: either res
                [
                    pmsg "to -> TRUE"
                    dpos: res
                    skip it 2
                ][
                    pmsg "to -> false"
                    next-rule it
                ]
            ]
        ][
            switch/default type?/word fit [
                paren! [
                    pmsg "()"
                    do fit
                    it: next it
                ]
                block! [
                    pmsg "[]"
                    res: do fit
                    it: next it
                ]
                char! [
                    pmsg "char"
                    res: first dpos = fit
                    if not res [
                        it: next-rule it
                    ]
                ]
                string! [
                    ;probe dpos
                    res: find/match dpos fit
                    it: either res [
                        pmsg "string -> TRUE"
                        dpos: res
                        next it
                    ][
                        pmsg "string -> false"
                        next-rule it
                    ]
                ]
            ][
                print rejoin ["Bad value (" type? fit "): {" fit "}"]
                halt
            ]
        ]
        if not it [ return false ]
    ]
    true
]


parsef: func [
    "A function which implements 'parse"
    data  [string! block!]
    rules [block! none!]
    /all
][
    dpos: data
    if string? data
    [
        if block? rules
        [
            if eval-pstr rules [
                return tail? dpos
            ]
        ]
    ]
    false
]


data1: {
    asf lsdkjf ldkf 
    [X] asdfjk fdlk
    [ ] aslkfjaslkjf
}

test1: does [
    ; Found '_'
    ; false
    print parsex/all data1 [
        to "[ ]" (print "Found '_'")
      | to "[X]" (print "Found 'X'")
    ]
]

test2: does [
    ; Infinine loop "Found _"
    print parsex/all data1 [some[
        to "[ ]" (print "Found '_'")
      | to "[X]" (print "Found 'X'")
    ]]
]

test3: does [
    ; Found 'X'
    ; Found '_'
    ; false
    print parsex/all data1 [some[
        "[ ]" (print "Found '_'")
      | "[X]" (print "Found 'X'")
      | to "["
    ]]
]

test4: does [
    print parsex/all data1 [
        to "[!]" (print "Found '!'")
      | to "[ ]" (print "Found '_'")
    ]
]

tests: [
    test1
    ;test2
    test3
    test4
]

print "N ---------"
parsex: :parse
do tests

print "F ---------"
parsex: :parsef
do tests


comment {
Match
  string!
  char!
  'tag
  ;end
  bitset!
  datatype!  match type     (block parse only)

Forms
  |   alternate rule
  []  sub-rule
  ()  evaluate

Quantity
  none               nothing
  opt                0 or 1 times
  some               1 or more times
  any                0 or more times
  integer!           repeat
  integer! integer!  repeat
 
Skip
  skip
  to
  thru

Values
  set   set variable to next value
  copy  set variable to next match sequence

Words
  word       evaluate word
  word:      mark position
  :word      set position
  'word      match literal  (block parse only)
}