Posts Tagged ‘parse’

Parse aid

Monday, July 1st, 2013

The following script is a must have! It helps you to create parsing rules and test them. If you need to learn more about parse, testing your ideas, you have to use it! Marco Antoniazzi wrote it, congratulation Marco!

Here is the source:

REBOL [
    title: "Parse Aid"
    file: %parse-aid.r
    author: "Marco Antoniazzi"
    Copyright: "(C) 2011 Marco Antoniazzi. All Rights reserved"
    email: [luce80 AT libero DOT it]
    date: 24-09-2011
    version: 0.5.5
    Purpose: "Help make and test parse rules"
    History: [
        0.5.1 [03-09-2011 "First version"]
        0.5.2 [04-09-2011 "modified resizing"]
        0.5.3 [17-09-2011 "Added balancing, changed save format (using strings to preserve comments)"]
        0.5.4 [18-09-2011 "Modified infinite loop exit mode,fixed scrollers"]
        0.5.5 [24-09-2011 "added shift-selecting"]
    ]
    comment: "28-Aug-2011 GUI automatically generated by VID_build. Author: Marco Antoniazzi"
    license: 'BSD  
]
           
; file
    change_title: func [/modified] [
        clear find/tail main-window/text “- “
        if modified [append main-window/text “*”]
        append main-window/text to-string last split-path any [job-name %Untitled]
        main-window/changes: [text] show main-window
    ]
    open_file: func [/local file-name temp-list job] [
        until [
            file-name: request-file/title/keep/only/filter “Load a rules file” “Load” “*.r”
            if none? file-name [exit]
            exists? file-name
        ]
        job-name: file-name
        temp-list: load file-name
        if not-equal? first temp-list ‘Parse_Aid-block [exit]
        job: temp-list
        set-face check-clear-res get job/clear-res
        set-face check-spaces get job/spaces
        set-face field-main-rule job/main-rule
        set-face area-charsets job/charsets
        set-face area-rules job/rules
        set-face area-test job/test
        named: yes
        change_title
        saved?: yes
    ]
    save_file: func [/as /local file-name filt ext response job] [
        ;if empty? job [return false]
        if not named [as: true]
        if as [
            filt: “*.r”
            ext: %.r
            file-name: request-file/title/keep/only/filter “Save as Rebol file” “Save” filt
            if none? file-name [return false]
            if not-equal? suffix? file-name ext [append file-name ext]
            response: true
            if exists? file-name [response: request rejoin [{File “} last split-path file-name {” already exists, overwrite it?}]]
            if response <> true [return false]
            job-name: file-name
            named: yes
        ]
        flash/with join “Saving to: “ job-name main-window
        job: reduce [
            ‘Parse_Aid-block 1
            ‘clear-res get-face check-clear-res
            ’spaces get-face check-spaces
            ‘main-rule get-face field-main-rule
            ‘charsets get-face area-charsets
            ‘rules get-face area-rules
            ‘test get-face area-test
        ]
        save job-name job
        wait 1.3
        unview
        change_title
        saved?: yes
    ]
; rules
    charsets-block: copy [
        digit: charset [#”0″ - #”9″]
        upper: charset [#”A” - #”Z”]
        lower: charset [#”a” - #”z”]
        alpha: union upper lower
        alpha_: union alpha charset “_”
        alpha_digit: union alpha_ digit
        hexdigit: union digit charset “abcdefABCDEF”
        bindigit: charset “01″
        space: charset ” ^-^/”
    ]
    rules-block: copy [
        digits: [some digit]
        sp*: [any space]
        sp+: [some space]
       
        area-code: [“(” 3 digit “)”]
        local-code: [3 digit “-” 4 digit]
        phone-num: [opt area-code copy var local-code (print [“number:” var])]
    ]
    err?: func [blk /local arg1 arg2 arg3 message err][;11-Feb-2007 Guest2
        if not error? err: try blk [return :err]
        err: disarm err
        set [arg1 arg2 arg3] reduce [err/arg1 err/arg2 err/arg3]
        message: get err/id
        if block? message [bind message ‘arg1]
        print [“**ERROR: “ form reduce message]
    ]
    prin: func [value] [
        either 100000 > length? get-face area-results [ ; avoid fill mem
            set-face area-results append get-face area-results form reduce value
        ][
            alert “ERROR. Probable infinite loop.”
            reset-face area-results
            throw
        ]
    ]
    print: func [value] [prin append form reduce value #”^/”]
    parse_test: func [/local result] [
        if get-face check-clear-res [reset-face area-results]
        result: err? [
            do get-face area-charsets
            do get-face area-rules
            do pick [parse/all parse] get-face check-spaces copy get-face area-test get load get-face field-main-rule
        ]
        text-parsed/color: white
        show text-parsed
        wait .1 ; to see the activity
        either logic? result [
            text-parsed/color: 80 + either result [green] [red]
            text-parsed/text: uppercase form result
        ] [text-parsed/text: “ERROR” ]
        show text-parsed
    ]
; gui
    do decompress ; %area-scroll-style.r Copyright: {GNU Less General Public License (LGPL) - Copyright (C) Didier Cadieu 2004}
        64#{
        eJztWW2P28YR/uz9FQMVhe8Olni6uGmii3NI3cIpYKdBkQQFCB2wRy7FtSlS5a5O
        Ugz3t/eZ2eWL5PNLi/Rb4Zcjl7PzvjPP7P39L3/620tKVWErs6Df69boqcvapqqm
        zh8qM2uVt56/Tb7DN9pZX1IgMK0joZkovfVl04Lmzza3pqXnGj+2dKYrqx1h0Tw/
        nyiz1rZaUNqa142tKZ3k+JBNyDfTrNQtffmUJt66DLsm9LvJbEKTop0slyrXHgpc
        fT19va0O06vLy6fqHtJtUy9oPrucXarNtt00DkRv1U+ldYS/mmqzIzYoaBlUB5Wz
        d3gDA28hinSdJ01L0N/+2tQeK715M/VXT7qqmh05U5nMQyI1BXmz99RsvYP+5Esw
        s2anmauIA0cq9T3eCK/5tKmrA62b3MzUO/W82Rxauyo9dH3xw8/00jhHL0xtWkj+
        cXtX2Yxe2szUztDZyxc/vjynKfWb6Oz5OR07md3xTsFo37QHeFeJR9hbl38UX9Hb
        wrYOW6FMdU6bIKOFQdqZ2Tuhn9P8D9PLr0E/nzP9nlwF41rK7b1lR9PdgS6hSbXN
        zFeXYdMVXT0dNuk8Nzm50hZ+Gr1Vr0Y7lvijQn5xOBYSFfurgcajrFsEF0qsUqWu
        6eLigiSkxbYOAcAz+zxrtrU37Ua3nmMSkxavGsm8nwb95X0he8Hu7bqRqETbdJY1
        bc5aSkALa6o88sEiPOMLehs+6cy8Uw6vYWvSpUj8krQmb/UKTqhcQ/GFlTwhB2XV
        cNL59Yb18GzMNelnem/dE7w8szUygRz88gSfn/FDl3FqCRNsQXVTmxvyRcK2UWr2
        1i+VdQteEvopmXxlpvzMdArCFrTGiZvv5yxw2m1O1rpdYX1YwCEICw75yQymYj+Y
        XNP3psUhguPLBkdNzGO1Z0hEpIehHHpxmmTNGrzYrUH7ljY2eyNujlsIIjqXqGvE
        xyDcbHYwINnTt/3zgdL5Mr1aKpBhjbcjEAlKAhbWeo+sFNN6EwLjZKEp6fjCAfz+
        zbcgTsPLElzZmTFWKVjGx8DNusCBJczhDd6iXMmVoAiJvKD7LmXL7sFVxULio2I6
        7mzuSxSpLx89enRNuSn0tvK97SSfuyz/AeVqh4REejfkNiazxYF2GkmeDyXpyclm
        KTZcZYirzEwJAxyizcbgg67hvsAzQwmhdMk5FPWmFAUy6Y3w7Zbr18otVTkmKB8g
        6HQI9lEKR1rouTLtjVAkV2HvsRfClyXqMlIqMBrqY1pUejXl4yR1e/gQCFFtIY7z
        +pRy9CWQIjrX7M/vsgy1tWmd6NbyhgXh8FXhZG7vhAUnLfuQa95wYpWWzZxhbwyF
        F3jOGS+CL7qSIizudbU1S/RQkcD/J7pV4afsTPp9NGwIBIUxVaLz11vnY8lyQgMr
        Vg8JW6aRf8IHc6kyVPH2IbKPaDPaE2R9SpPWPGj4R4WM9ny2EK43IynBu7waJUlF
        CHVJhcd+FSXr7IouQsZzjIOfJC36J6Fc0uX+cnnOh18+9KdBjV+TpihgQLIP4oaf
        EBSEjlJbLXtu5TG38pjbIXLpf36AWxfjkb3vqXukbXAe+IUfD+hzpE4k30ebBoEf
        ig9HNzTwUFhsbT2fB653aPaF2uiaT1coMorFSzHetXpzQ2lfQ7g2LrkU1k1AXLOh
        nmEPlyriPWRqxlOojL60WMuaCn2kwL9jRMWCJNp36KtvbgKdoyt6RpWpV77sllD3
        ouqRZP4VUE/4t4QY0ZwLi1Rffd/YHKK1p18A7dDaCPZWgKFI8r76sOFhT6w4z6Gc
        N115CUQMZzqvsZOIOwdXlWkIPOp8SODHAnxSnAOWk/fOlM7BHQH4LvLu4bccnYiR
        uFDB56YOp06+eae4TEhjkoKhQt/kV35SADpmWlkXSfpXFXATrwmi4tPTt+neAzdM
        MC7AqcQ35W38jrwCog5s+EkF34eF8AztRxBdVzt9wFRhvJT2EI8zZzprzp8wAAHQ
        eOylM0qIjnNS9kSRsr2zYSEZuey67asm5/4qwjnr2cUMD5MxeutbbWlqgCrLkHYW
        GXzHUA+gd0CM/WiwKzFN0QCCAVRtdTQwsNiZYrmxxWR+L1ArYSl0Z2FPCkF31rMz
        wHhbyyACLPDGHKIEIJXTAaN/n2KiQ1wW2MigWZKpFwIWboqxy2LKAHzm6YvFTG6/
        v53e/uv21e0/bn+5/WkS0/qVrvUqzjbhIA7IuWiyLY+BnPcdFBkdT3Hm7qhb6szz
        FLZM+7MLM+TL43g041mW89GfXjW89omoQ6Ed0lHYDCp8Qd8MdWDETpA0g9LxoqBU
        gE36Yhn4AC66g/NmnfB4hwQGdpiGZvXQ9k/tCfUTymg+SicOMfc4txSHA6QhQwSW
        4jAIZaWQpCpvdpiaVTS+bvzU/HOrq2g2C7wYSWTPSHB6leNGkZXIoNYNFD7uLjFj
        VjxnYkbjuSp9cHkRqTNkBCDIKQ3O4oJCw+McE6qgYpAcPolGfUJu67A3zDmqYyp7
        P4eZBKKVa4IAvxmpR7/jULe9oZ3LRvw/zZ7+d376De3EiITqSSnaRYmjWJnjyhTm
        6pPKxP6ejbk+Vci+MC0eeUAmrf3l8eJ0wF8KCXsMx+T5eMoclvo58z8EbQOHDlGw
        pqwYKwgdeHTtx9a+D463gAIm/rfRyJq6QJM89sN7pr5n6OCnIWIPw+DtRiKIbr8Z
        xY+zz5jc5D2w43BFfw35QD13Tgdv10aYtWYDYPIZjUoWpVtVdLf1Pty2xKuifCZw
        7MT28F17e2+4he7QuaBCyXcFZ+MP4j14gk9jIokqbM5Dvj2UViMw06V/n5tcIruU
        5Of/Z+InXPeb5igjEEYnAWIwIHEkVwAPoHMumsGhH2zTDD9uoh3MurBjIBGBzPBd
        WhlQ0sizoX2uOB07LKHlsvADBsRmfN1fLuIv3wwAXRVts0YIkQebiofbQMRMAlA7
        AeANg7LubgvRQXhOZB5NzKGRjAFOhPvSrWEzmj3fDR5/OrnP7CCqGArqaA/b3jVU
        eixTGRa7UxLPAnJooy2PUflWMEIEBf1YOZ5Elylmo0hQfpAAjgwwP4KzDuRLg4oZ
        MB4ZzMnMEGYLmRyU2jqsyHjUg2/0UoFCMrj0JwoDacDhP6NaWX8Y7odRbLIwiPVx
        Ukccu4iAGdl8Twl7nAGpO5rMeDTm8Qy+7FXBjtGEpvmeyMuvId6/DhpdSB+HsyvP
        46HQdW+YwTs6p1yfpHGy7H9p0d+ewr/DBUZ/l3fsQO1CzMeRo3i7kBzoClLGQjCX
        n/wihKUMFxvlx6V0jPfH8uYqXAuY9cYfbsZ2psNzlwbDHVJ/JRTyRspTd37/DVw/
        MtO8GgAA
        }

    rezize-faces: func [siz [pair!] /move] [
        area-charsets/ar/line-list: none ; to reactivate auto-wrapping
        resize-face/no-show area-charsets area-charsets/size + (siz * 1×0)
        area-rules/ar/line-list: none ; to reactivate auto-wrapping
        resize-face/no-show area-rules area-rules/size + (siz * 1×2)
        text-test/offset/x: text-test/offset/x + siz/x
        area-test/offset/x: area-test/offset/x + siz/x
        text-results/offset: text-results/offset + siz
        area-results/offset: area-results/offset + siz
        if move [siz: - siz]
        resize-face/no-show area-test area-test/size + siz
        resize-face/no-show area-results area-results/size + siz
    ]
    feel-move: [
        engage-super: :engage
        engage: func [face action event /local prev-offset] [
            engage-super face action event
            if (action = ‘down) [
                face/user-data: event/offset
            ]
            if find [over away] action [
                prev-offset: face/offset
                face/offset/x: face/offset/x + event/offset/x - face/user-data/x
                face/offset/x: first confine face/offset face/size area-charsets/offset + 100×0 area-test/offset + area-test/size - 100×0
                if prev-offset <> face/offset [
                    rezize-faces/move (face/offset - prev-offset * 1×0)
                    show main-window
                ]
            ]
            ;show face
        ]
    ]
    ;append system/view/VID/vid-styles area-style ; add to master style-sheet
    main-window: center-face layout [
        styles area-style
        do [sp: 4×4] origin sp space sp
        Across
        btn “(O)pen…” #”^O” [open_file]
        btn “(S)ave” #”^S” [save_file]
        pad (sp * -1×0)
        btn “as…” [save_file/as]
        ;check-line “save also test” on
        pad 350
        btn “Clear (T)est” #”^T” [reset-face area-test]
        btn “Clear (R)esults” #”^R” [reset-face area-results]
        check-clear-res: check-line “before every parse”
        return
        btn “(P)arse” #”^P” yellow [parse_test]
        check-spaces: check-line “also spaces” on
        ;check-line “on rules update” on
        text “with this rule:” bold
        field-main-rule: field “phone-num” 300×22
        text bold “Result:”
        text-parsed: text bold as-is ”   NONE   “ black white center
        return
        Below
        guide
        style area-scroll area-scroll 400×200 hscroll vscroll font-name font-fixed para [origin: 2×0 Tabs: 10]
        text bold “Charsets”
        area-charsets: area-scroll wrap
        text-rules: text bold “Rules”
        area-rules: area-scroll wrap
        return
        button-balance: button “|” 6×450 gray feel feel-move edge [size: 1×1]
        return
        text-test: text bold “Test”
        area-test: area-scroll “(707)467-8000″
        text-results: text bold “Results”
        area-results: area-scroll silver read-only
        key (escape) (sp * 0x-1) [ask_close]
    ]
    main-window/user-data: reduce [’size main-window/size]
    insert-event-func func [face event /local siz] [
        switch event/type [
            close [
                ask_close
                return none
            ]
            resize [
                face: main-window
                siz: face/size - face/user-data/size / 2     ; compute size difference / 2
                face/user-data/size: face/size           ; store new size

                rezize-faces siz
                button-balance/offset: button-balance/offset + (siz * 1×0)
                button-balance/size: button-balance/size + (siz * 0×2)
                show main-window
            ]
        ]
        event
    ]
    ask_close: does [
        either not saved? [
            switch request [“Exit without saving?” “Yes” “Save” “No”] reduce [
                yes [quit]
                no [if save_file [quit]]
            ]
        ][
            if confirm “Exit now?” [quit]
            ;quit
        ]
    ]
; main
   
    set-face area-charsets trim mold/only charsets-block
    set-face area-rules trim mold/only rules-block
    job-name: none
    named: no
    saved?: yes
    main-title: join copy System/script/header/title ” - Untitled”
    view/title/options main-window main-title reduce [‘resize ‘min-size main-window/size + system/view/title-size + 8×10 + system/view/resize-border]

Ordinal Number Translator

Tuesday, June 18th, 2013

The following script translate a string, like “nine hundred and nineteenth”, in its number equivalent.

Here is the source:

REBOL [
Title: "Ordinal Number Translator"
Date: 18-Jun-1999
File: %ordnum.r
Author: "Scrip Rebo"
Purpose: "Translates ordinals (e.g. twenty) to numbers (20)"
]
ord-to-num: func [number [string!] /local m t n] [
m: t: n: 0
parse number [some [
"hundred" (n: n * 100) |
"thousand" (t: n * 1000 n: 0) |
"million" (m: n * 1000000 n: 0) |
"eleven" (n: n + 11) |
"twelve" (n: n + 12) |
"thirteen" (n: n + 13) |
"fourteen" (n: n + 14) |
"fifteen" (n: n + 15) |
"sixteen" (n: n + 16) |
"seventeen" (n: n + 17) |
"eighteen" (n: n + 18) |
"nineteen" (n: n + 19) |
["twenty" | "twentieth"] (n: n + 20) |
["thirty" | "thirtieth"] (n: n + 30) |
["forty" | "fortieth"] (n: n + 40) |
["fifty" | "fiftieth"] (n: n + 50) |
["sixty" | "sixtieth"] (n: n + 60) |
["seventy" | "seventieth"] (n: n + 70) |
["eighty" | "eightieth"] (n: n + 80) |
["ninety" | "ninetieth"] (n: n + 90) |
["one" | "first"] (n: n + 1) |
["two" | "second"] (n: n + 2) |
["three" | "third"] (n: n + 3) |
"four" (n: n + 4) |
["five" | "fifth"] (n: n + 5) |
"six" (n: n + 6) |
"seven" (n: n + 7) |
["eight" | "eighth"] (n: n + 8 ) |
["nine" | "ninth"] (n: n + 9) |
"ten" (n: n + 10) |
"and" | "-" | "," | "th"
]]
m + t + n
]

Examples:

>> ord-to-num "sixth"
== 6
>> ord-to-num "eleventh"
== 11
>> ord-to-num "thirtieth"
== 30
>> ord-to-num "sixty-first"
= 61
>> ord-to-num "nine hundred and nineteenth"
== 919
>> ord-to-num "five hundred and fifteen thousand fifty-eighth"
== 515058

Satellite image viewer

Thursday, May 9th, 2013

Today I’ll show you a post about a satellite viewer, how it works:

  • it reads a page
  • it extract satellite image url using parse
  • it load also the vertical gradient bar
  • it display a layout that update image every 30 minutes

and all in just 16 lines of code!

Here is the source:

REBOL [
    Title: "Gradient Colorize Examples"  
    Author:   ["Tesserator" "Massimiliano Vessi"]
    Purpose: {Trying to Auto DL weather maps on 30min. intervals from: http://wwwghcc.msfc.nasa.gov/ }
    Email: jimbo@sc.starcat.ne.jp  
]    
nasa_url:   http://wwwghcc.msfc.nasa.gov
update_img: does [
    flash “Fetching image…”
    img: read   http://weather.msfc.nasa.gov/GOES/goeseastfullir.html
    parse img [thru {TYPE=”image” src=”}   copy img   to {”}   to end ]
    img: load (join   nasa_url img)
    ; this way img2 is loaded just one time
    if not value? ‘img2   [img2: load http://weather.msfc.nasa.gov/GOES/colorbarvert.gif ]
    unview
    ]
update_img
view layout [
    h1   “GOES East Interactive Infrared Weather Satellite Image Viewer”
    text “Image automatically updated every 30 minutes”
    across
    image img rate 00:30 feel [ engage: func [face action event] [
        update_img
        face/image: img
        show face
        ] ]
    image img2  
    ]

Brett Handley

Monday, March 11th, 2013

Today I write about Mr. Brett Handley, another great rebol activist.
Do you remember this post (http://rebol.informe.com/blog/2013/01/28/seeing-parse-in-action/)?
Mr. Brett Handley updated his scripts about parse analysis , read here:
http://www.rebol.org/cpt-list-scripts.r?user-name=brett

He said me:
There have been many changes. Simplification, speed up, reduced memory usage, bug fixes. A much more interactive display and a simple way to call it (visualise-parse). The other big change is that the new display now supports parsing in block mode (not just text).

Try his scripts downloading them from http://www.rebol.org/cpt-list-scripts.r?user-name=brett or visit his site: http://www.codeconscious.com/

Seeing PARSE in action

Monday, January 28th, 2013

Mr. Brett Handley has a great site about Rebol: http://www.codeconscious.com
and he made a lot of useful scripts. Today we will discover three of them about PARSE. I contacted him and he was so kind to answer to my email and writing the following examples and concepts.
If this post seems too complicated, jump to the examples and all will become clear (otherwise post your questions on the comments :-) )
First of all let’s see the scripts:

PARSE-ANALYSIS.R

Brett says about this script: “My first insight was to realize a script I could track parse rules by modifying them to call tracking code. In this way I could have some functions help me debug complex parse rules.
I used the concept of hooking into existing parse rules. This allows tracing of parse rules that you may have downloaded or even the parse rules used by REBOL’s mezzanine functions (e.g REBOL’s parse-xml function).”

Here is the script:

REBOL [
Title: "Parse Analysis Toolset"
Date: 17-Dec-2004
File: %parse-analysis.r
Purpose: "Some tools to help learn/analyze parse rules."
Version: 1.1.0
Author: "Brett Handley"
Web: http://www.codeconscious.com
license:   {
Copyright (C) 2004 Brett Handley All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
May not be executed within web CGI or other server processes.
Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.   Redistributions
in binary form must reproduce the above copyright notice, this list of
conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.   Neither the name of
the author nor the names of its contributors may be used to
endorse or promote products derived from this software without specific
prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}
]
hook-parse: func [
“Hook parse rules for events: test a rule (Test), rule succeeds (Pass), rule fails (Fail). Returns hook context.”
rules [block!] “Block of words. Each word must identify a Parse rule to be hooked.”
/local hook-context spec
] [
; Check the input

if not parse rules [some any-word!] [make error! “Expecting a block of words.”]
; Create the hook context.

hook-context: context [
step: level: status: current: ; State tracking variables.
        rule-words: ; The original rules (maintaining their bindings).
        rule-def: ; The original rule values.
        last-begin: ; A variable to track the input position when the rule starts.
        last-end: ; A variable to track the input position when the rule ends.
        pass: fail: test: ; Functions called when the corresponding parse event occurs.
        none
reset: does [step: level: 0 last-begin: last-end: current: none]
]
hook-context/rule-words: rules
; Create a context to store the original rule definitions.

spec: make block! multiply 2 length? rules
repeat rule rules [insert tail spec to set-word! rule]
hook-context/rule-def: context append spec [none]
; Modify the given rules to point to the
    ; hook-context’s tracking rules and save
    ; the original rules.

repeat rule rules [
set in hook-context/rule-def rule reduce [get rule]
set rule bind reduce [
; Rule invocation

to set-word! ‘last-begin
to paren! compose [
step: step + 1 level: level + 1
current: (to lit-word! rule) status: ‘test
test
]
; Call the original rule.

in hook-context/rule-def rule
; Rule Success

to set-word! ‘last-end
to paren! compose [
step: step + 1 level: level - 1
current: (to lit-word! rule) status: ‘pass
pass
]
‘|
; Rule failure

to set-word! ‘last-end
to paren! compose [
step: step + 1 level: level - 1
current: (to lit-word! rule) status: ‘fail
fail
]
‘end ’skip ; Ensure the failure result is maintained.

] in hook-context ’self
]
; Return the hook-context.
    hook-context
]
unhook-parse: func [
“Unhooks parse rules hooked by the Hook-Parse function.”
hook-context [object!] “Hook context returned by the Hook-Parse function.”
] [
repeat rule hook-context/rule-words [set rule first get in hook-context/rule-def rule]
hook-context/rule-def: none ; Clear references to original rules.
    hook-context/reset
return ; return unset
]
count-parse: func [
“Returns counts of calls, successes, fails of Parse rules.”
body [block!] “Expression to invoke Parse on your input.”
hook-context [object!] “Hook context returned by the Hook-Parse function.”
/local ctr-t ctr-p ctr-f increment
] [
; Initialise counters
    foreach w [ctr-t ctr-p ctr-f] [set w array/initial length? hook-context/rule-words 0]
; Helper function
    increment: func [ctr /local idx] [
idx: index? find hook-context/rule-words hook-context/current
poke ctr idx add 1 pick ctr idx
]
; Bind to the hook-context. Note that the event functions *must* be bound to the same context.
    do bind [
test: does [increment ctr-t]
pass: does [increment ctr-p]
fail: does [increment ctr-f]
] in hook-context ’self
; Invoke the parse as specified by user.
    hook-context/reset
do body
; Return result
    reduce [copy hook-context/rule-words ctr-t ctr-p ctr-f]
]
explain-parse: func [
“Emits numbered parse steps.”
body [block!] “Invoke Parse on your input.”
hook-context [object!] “Hook context returned by the Hook-Parse function.”
/begin begin-fn [any-function!] “Function called when rule begins. Spec: [context-stack [block!] begin-context-clone [object!]]”
/end end-fn [any-function!] “Function called when rule ends.   Spec: [context-stack [block!] begin-context-clone [object!] end-context-clone [object!]].”
] [
; Initialise

if not begin [
begin-fn: func [context-stack begin-context] [
print rejoin bind/copy [
head insert/dup copy “” ”   “ subtract level 1
step ” begin ‘” current ” at “ index? last-begin
] in begin-context ’self
]
]
if not end [
end-fn: func [context-stack begin-context end-context] [
print rejoin bind/copy [
head insert/dup copy “” ”   “ (subtract begin-context/level 1)
step ” end ‘” current ” at “ index? last-end
” started-on “ begin-context/step ” “ end-context/status “ed”
] in end-context ’self
]
]
use [stack] [
stack: make block! 20
; Make the hook-context. Note that the event functions *must* be
        ; bound to the same context.
        do bind [
test: has [] [
begin-fn stack hook-context
insert tail stack make hook-context []
]
pass: has [ctx] [
ctx: last stack
remove back tail stack
end-fn stack ctx hook-context
]
fail: has [ctx] compose [
ctx: last stack
remove back tail stack
end-fn stack ctx hook-context
]
] in hook-context ’self
; Invoke the hook-context
        hook-context/reset
do body
]
; Return unset
    return
]
tokenise-parse: func [
“Tokenises the input using the rule names.”
body [block!] “Invoke Parse on your input. The block must return True in order to return the result.”
hook-context [object!] “Hook context returned by the Hook-Parse function.”
] [
use [stack result fn-b fn-e] [
stack: make block! 20
result: make block! 10000
fn-b: does [insert/only tail stack tail result]
fn-e: func [context-stack begin-context end-context /local bookmark] [
bookmark: last stack
remove back tail stack
either ‘pass = end-context/status [
insert tail result reduce [
end-context/current
subtract index? end-context/last-end index? begin-context/last-begin ; Length
                    index? begin-context/last-begin ; Input position
                ]
] [clear bookmark]
]
explain-parse/begin/end body hook-context :fn-b :fn-e
result
]
]

The functions contained in the script are:

Hook-Parse
Enables you to trace the execution of parse rules. It replaces rules with modified rules that track the parse state. Returns an object that represents the parse state and stores the original parse definitions. It is important to note that any rules you do not hook are not tracked and do not appear in the outputs. This is useful when you want to filter out terms that are not important to your application. On the other hand you do not want to filter out terms that are necessary to get a complete picture of the parsing. For example: If your data is described by [a b c] and you filter out b - you will miss important information. But if your data is descibed by [a b] where b: [x y z] and you filter out b OR you filter out x, y and z then there is no problem because your input is completely specified by the rules.
Unhook-Parse
Removes the calls to tracing code, to return the parse rules back to their original definitions.
Count-Parse
Counts each time rule is tested, passed or failed. The result is in the form: [rules test-counts pass-counts fail-counts] Two benefits of this function:

  1. the results may give some insight into which rules are doing all the work.
  2. the code shows how you can set the event functions in the hook context.
Explain-Parse
Interprets events as the parse rules are executing - useful for debugging rules. By default displays the events as they occur which can help with debugging complex parse rules. There are begin events and end events and each is numbered sequentially as they occur. Each shows the input index position after the word AT. The end event shows the number of the begin event it is paired with after the word STARTED-ON. explain-parse is used by tokenise-parse and load-parse-tree.
Tokenise-Parse
Returns a sequence of tokens where each token is a triple of the form:
rule-name length-of-input-matched input-index-position
This output form allows the result to be reversed and sorted by index positions if desired. The output from Tokenise-parse is used by make-token-highlighter of parse-analysis-view.r script.

Examples

Let’s do the script and start a rule example:

DO %parse-analysis.r
digit: charset {0123456789}
hex-digit: charset {0123456789ABCDEF}
letter: charset [#"a" - #"z" #"A" - #"Z"]
word: [some letter]
phrase: [some [word | { } ]]
number: [some digit]
hex-literal: [#"$" some hex-digit]
item: [phrase | hex-literal | number | { } ]
data: {There were 374 brown foxes and $0001 mottley one.}

then we create a function that launch our parse command:
parse-the-example: does [ parse/all data [any item]]

then we must create the hook object:
example-hook-context: hook-parse [phrase word hex-literal number]

a hook object is made this way:

>> ? example-hook-context
EXAMPLE-HOOK-CONTEXT is an object of value:
step             none!     none
level           none!     none
status           none!     none
current         none!     none
rule-words       block!     length: 4
rule-def         object!   [phrase word hex-literal number]
last-begin       none!     none
last-end         none!     none
pass             none!     none
fail             none!     none
test             none!     none
reset           function! []

now we are read to launch script functions like explain-parse:


>> explain-parse [parse-the-example] example-hook-context
1 begin 'phrase at 1
2 begin 'word at 1
3 end 'word at 6 started-on 2 passed
4 begin 'word at 6
5 end 'word at 6 started-on 4 failed
6 begin 'word at 7
7 end 'word at 11 started-on 6 passed
8 begin 'word at 11
9 end 'word at 11 started-on 8 failed
10 begin 'word at 12
11 end 'word at 12 started-on 10 failed
12 end 'phrase at 12 started-on 1 passed
13 begin 'phrase at 12
14 begin 'word at 12
15 end 'word at 12 started-on 14 failed
16 end 'phrase at 12 started-on 13 failed
17 begin 'hex-literal at 12
18 end 'hex-literal at 12 started-on 17 failed
19 begin 'number at 12
20 end 'number at 15 started-on 19 passed
21 begin 'phrase at 15
22 begin 'word at 15
23 end 'word at 15 started-on 22 failed
24 begin 'word at 16
25 end 'word at 21 started-on 24 passed
26 begin 'word at 21
27 end 'word at 21 started-on 26 failed
28 begin 'word at 22
29 end 'word at 27 started-on 28 passed
30 begin 'word at 27
31 end 'word at 27 started-on 30 failed
32 begin 'word at 28
33 end 'word at 31 started-on 32 passed
34 begin 'word at 31
35 end 'word at 31 started-on 34 failed
36 begin 'word at 32
37 end 'word at 32 started-on 36 failed
38 end 'phrase at 32 started-on 21 passed
39 begin 'phrase at 32
40 begin 'word at 32
41 end 'word at 32 started-on 40 failed
42 end 'phrase at 32 started-on 39 failed
43 begin 'hex-literal at 32
44 end 'hex-literal at 37 started-on 43 passed
45 begin 'phrase at 37
46 begin 'word at 37
47 end 'word at 37 started-on 46 failed
48 begin 'word at 38
49 end 'word at 45 started-on 48 passed
50 begin 'word at 45
51 end 'word at 45 started-on 50 failed
52 begin 'word at 46
53 end 'word at 49 started-on 52 passed
54 begin 'word at 49
55 end 'word at 49 started-on 54 failed
56 end 'phrase at 49 started-on 45 passed
57 begin 'phrase at 49
58 begin 'word at 49
59 end 'word at 49 started-on 58 failed
60 end 'phrase at 49 started-on 57 failed
61 begin 'hex-literal at 49
62 end 'hex-literal at 49 started-on 61 failed
63 begin 'number at 49
64 end 'number at 49 started-on 63 failed

Did you notice it? Parse is explained line by line: what it found and if test is passed or not.
Now let’s see count-parse:

>> print mold new-line/all (count-parse [parse-the-example] example-hook-context) true
== [
[phrase word hex-literal number]
[6 21 3 2]
[3 7 1 1]
[3 14 2 1]
]

Remember that output is put this way: [rules test-counts pass-counts fail-counts].
So you can read it:

rules test-counts pass-counts fail-counts
phrase 6 3 3
word 21 7 14
hex-literal 3 1 2
number 2 1 1

Now let’s see tokenise-parse:

>> print mold tokens: new-line/all/skip (tokenise-parse [parse-the-example] example-hook-con
text) true 3
== [
word 5 1
word 4 7
phrase 11 1
number 3 12
word 5 16
word 5 22
word 3 28
phrase 17 15
hex-literal 5 32
word 7 38
word 3 46
phrase 12 37
]

Even in this case you must remember that output is in the form:
rule-name length-of-input-matched input-index-position
so a word i length 5 chars and start at position 1; a number start at position 12 and it’s 3 chars length.

PARSE-ANALYSIS-VIEW.R

Brett says about this script: “My second insight was to realize I could visualize how the rules break up text by displaying the textual input in a window and overlaying it with boxes and colors that represent the rules.”

REBOL [
Title: "Parse Analysis Toolset /View"
Date: 19-Dec-2004
File: %parse-analysis-view.r
Purpose: "Some REBOL/View tools to help learn/analyse parse rules."
Version: 1.1.0
Author: "Brett Handley"
Web: http://www.codeconscious.com
Comment: "Companion script to parse-analysis.r"
license: {
Copyright (C) 2004 Brett Handley All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.   Redistributions
in binary form must reproduce the above copyright notice, this list of
conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.   Neither the name of
the author nor the names of its contributors may be used to
endorse or promote products derived from this software without specific
prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}
]
stylize/master [
HIGHLIGHTED-TEXT: text with [
highlights: sizing-face: none
highlight: has [
offset highlight-tail part-tail line-tail
drw-blk highlight-size tmp
] [
append clear drw-blk: effect/draw [pen yellow]
if any [not highlights empty? highlights] [return]
foreach [caret length colour] head reverse copy highlights [
caret: at text caret
highlight-tail: skip caret length
copy/part caret highlight-tail
while [lesser? index? caret index? highlight-tail] [
offset: caret-to-offset self caret
line-tail: next offset-to-caret self to pair! reduce [first size second offset]
part-tail: either lesser? index? line-tail index? highlight-tail [line-tail] [highlight-tail]
if lesser-or-equal? index? part-tail index? caret [break]
if newline = last tmp: copy/part caret part-tail [remove back tail tmp]
if not empty? tmp [
if edge [offset: offset - edge/size]
sizing-face/text: tmp
highlight-size: size-text sizing-face
insert tail drw-blk reduce [‘fill-pen colour ‘box offset offset + highlight-size]
]
caret: part-tail
]
]
]
words: [highlights [new/highlights: second args next args]]
append init [
effect: append/only copy [draw] make block! multiply 5 divide length? any [highlights []] 3
sizing-face: make-face/styles/spec ‘text copy self/styles compose [size: (size)]
highlight
]
]
SCROLL-PANEL: FACE edge [size: 2×2 effect: ‘ibevel] with [
data: cropbox: sliders: none
; returns unit-vector for an axis
        uv?: func [w] [either w = ‘x [1×0] [0×1]]
; calculates canvas size
        sz?: func [f] [either f/edge [f/size - (2 * f/edge/size)] [f/size]]
; slider widths for both directions as a pair
        sldw: 15×15
; Manages the pane.
        layout-pane: function [/resize child-face] [sz dsz v v1 v2 lyo] [
if none? data [data: copy []]
; Convert VID to a face.
            if block? data [data: layout/offset/styles data 0×0 copy self/styles]
; On initial layout create the crop-box and sliders.
            if not resize [
if not size [size: data/size if edge [size: 2 * edge/size + size]]
lyo: layout compose/deep [origin 0×0 cropbox: box
slider 5×1 * sldw [face/parent-face/scroll uv? face/axis value]
slider 1×5 * sldw [face/parent-face/scroll uv? face/axis value]]
sliders: copy/part next lyo/pane 2
pane: lyo/pane
]
cropbox/pane: data
sz: sz? self
cropbox/size: sz dsz: data/size
; Determine the size of the content plus any required sliders.
            repeat i 2 [
repeat v [x y] [
if dsz/:v > sz/:v [dsz: sldw * (reverse uv? v) + dsz]
]
]
dsz: min dsz sldw + data/size
; Size the cropbox to accomodate sliders.
            repeat v [x y] [
if (dsz/:v > sz/:v) [
cropbox/size: cropbox/size - (sldw * (reverse uv? v))
]
]
; Size and position the sliders - non-required slider(s) is/are off stage.
            repeat sl sliders [
v2: reverse v1: uv? v: sl/axis
sl/offset: cropbox/size * v2
sl/size: add 2 * sl/edge/size + cropbox/size * v1 sldw * v2
sl/redrag min 1.0 divide cropbox/size/:v data/size/:v
if resize [svvf/drag-off sl sl/pane/1 0×0]
]
if resize [do-face self data/offset]
self
]
; Method to scroll the content with performance hinting.
        scroll: function [v value] [extra] [
extra: min 0×0 (sz? cropbox) - data/size
data/offset: add extra * v * value data/offset * reverse v
cropbox/changes: ‘offset
show cropbox
do-face self data/offset
self
]
; Method to change the content
        modify: func [spec] [data: spec layout-pane/resize self]
resize: func [new /x /y] [
either any [x y] [
if x [size/x: new]
if y [size/y: new]
] [size: any [new size]]
layout-pane/resize self
]
init: [feel: none layout-pane]
words: [data [new/data: second args next args]
action [new/action: func [face value] second args next args]]
multi: make multi [
image: file: text: none
block: func [face blk] [if blk/1 [face/data: blk/1]]
]
]
]
make-token-highlighter: func [
{Returns a face which highlights tokens.}
input “The input the tokens are based on.”
tokens [block!] “Block of tokens as returned from the tokenise-parse function.”
/local highlighter-face sz-main sz-input names name-area
] [
sz-main: system/view/screen-face/size - 150×150
sz-input: sz-main
ctx-text/unlight-text
use [token-lyo colours set-highlight rule? trace-term btns] [
; Build colours and bind token words to them.
        use [name-count set-highlight] [
name-count: length? names: unique extract tokens 3
colours: make block! 1 + name-count
foreach name names [insert tail colours reduce [to set-word! name silver]]
colours: context colours
tokens: bind/copy tokens in colours ’self
]
; Helper functions
        rule?: func [
“Returns the rules that are satisfied at the given input position.”
tokens “As returned from tokenise-parse.”
position [integer!] “The index position to check.”
/local result
] [
if empty? tokens [return copy []]
result: make block! 100
forskip tokens 3 [
if all [
get in colours tokens/1 ; Make sure only highlighted terms are selected
                    position >= tokens/3 tokens/3 + tokens/2 > position] [insert tail result copy/part tokens 3 ]
]
result
]
all-highlights: has [btn] [
repeat word next first colours [
set in colours word sky
btn: get in btns word
btn/edge/color: sky
]
]
clear-highlights: has [btn] [
repeat word next first colours [
set in colours word none
btn: get in btns word
btn/edge/color: silver
]
]
set-highlight: func [name /local clr btn] [
clr: 110.110.110 + random 120.120.120
set in colours name clr ; Set the highlighted token.
            btn: get in btns name
btn/edge/color: clr
]
; Build name area
        btns: make colours []
name-area: append make block! 2 * length? names [
origin 0×0 space 0×0 across
btn “[Clear]” [
ctx-text/unlight-text clear trace-term/text
clear-highlights show token-lyo
]
btn “[All]” [
ctx-text/unlight-text clear trace-term/text
all-highlights show token-lyo
]
]
foreach name names [
insert tail name-area append reduce [
(first bind reduce [to set-word! name] in btns ’self) ‘btn
form name get in colours name
compose [set-highlight (to lit-word! name) show token-lyo]
] [edge [size: 3×3]]
]
; Build main layout
        token-lyo: layout [
origin 0×0 space 0×0
scroll-panel to pair! reduce [sz-input/1 45] name-area
scroll-panel sz-input [
origin 0×0 space 0×0
highlighter-face: highlighted-text black input as-is highlights tokens feel [
engage: func [face act event /local rules pos] [
switch act [
down [
either not-equal? face system/view/focal-face [
focus face
system/view/caret: offset-to-caret face event/offset
] [
system/view/highlight-start:
system/view/highlight-end: none
system/view/caret: offset-to-caret face event/offset
]
pos: index? system/view/caret
rules: rule? tokens pos
if not empty? rules [
system/view/highlight-start: at face/text rules/3
system/view/highlight-end: skip system/view/highlight-start rules/2
]
insert clear trace-term/text form head reverse extract rules 3
show face show trace-term
]
]
]
]
]
trace-term: area wrap to pair! reduce [sz-main/1 40]
]
token-lyo/text: “Token Highlighter”
all-highlights
token-lyo
]
]

Example

DO %parse-analysis.r
DO %parse-analysis-view.r
digit: charset {0123456789}
hex-digit: charset {0123456789ABCDEF}
letter: charset [#”a” - #”z” #”A” - #”Z”]
word: [some letter]
phrase: [some [word | { }   ]]
number: [some digit]
hex-literal: [#”$” some hex-digit]
item: [phrase | hex-literal | number | { } ]
data: {There were 374 brown foxes and $0001 mottley one.}
parse-the-example: does [parse/all data [any item] ]
example-hook-context: hook-parse [phrase word hex-literal number]
tokens: new-line/all/skip (tokenise-parse [parse-the-example] example-hook-context) true 3

and the new function make-token-highlighter
view make-token-highlighter data tokens
and this will be the result:

You can play with buttons to see the different matches.

LOAD-PARSE-TREE.R

Brett says about this script: “My third insight was to realise that parse rules describe the structure of a format implicitly and that each parse rule name (a word) represents a term in the structure.
The normal way to build output with parse rules is to add actions (parens) to the rules that build up the output structure. In my mind this is a duplication, because the parse rules describe the structure, and now we build it again with output actions.
So instead of those actions and their redundancy I decided to write a function that automatically creates an output structure just by tracking which parse rules were successful as they are executed. This allows an abstract syntax tree of the input to be built automatically.”

Here is the script:

REBOL [
Title: "Load-Parse-Tree (Parse-Analysis)"
Date: 17-June-2006
File: %load-parse-tree.r
Purpose: "Load a block structure representing your input as matched by Parse."
Version: 1.0.0
Author: "Brett Handley"
Web: http://www.codeconscious.com
Comment: "Requires parse-analysis.r (see rebol.org)"
license: {
Copyright (c) 2006, Brett Handley
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
* This program must not be used to run websever CGI or other server processes.
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* The name of Brett Handley may not be used to endorse or
promote products derived from this software without specific
prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
}
]
load-parse-tree: func [
“Tokenises the input using the rule names.”
body [block!] “Invoke Parse on your input. The block must return True in order to return the result.”
hook-context [object!] “Hook context returned by the Hook-Parse function.”
/block input [any-block!] “For block input, supply the input block here so it can be indexed.”
] [
use [stack result fn-b fn-e block-list index-fn] [
index-fn: :index?
stack: make block! 20
result: copy []
fn-b: does [
insert/only tail stack result
result: copy []
]
fn-e: func [context-stack begin-context end-context /local content tk-len tk-ref] [
; Restore state to parent of just completed term.
        content: result
result: last stack
remove back tail stack
; Term has just completed - insert it into the result or discard it.
            if ‘pass = end-context/status [
either 1 + begin-context/step = end-context/step [
tk-len: subtract index? end-context/last-end index? begin-context/last-begin ; Length
            tk-ref: begin-context/last-begin ; Input position
            content: copy/part tk-ref tk-len
][new-line/all/skip content 1 2]
insert tail result reduce [end-context/current content]
]
]
explain-parse/begin/end body hook-context :fn-b :fn-e
new-line/all/skip result true 2
]
]

Example

As usual let’s to all from the beginning:

DO %parse-analysis.r
DO %parse-analysis-view.r
digit: charset {0123456789}
hex-digit: charset {0123456789ABCDEF}
letter: charset [#”a” - #”z” #”A” - #”Z”]
word: [some letter]
phrase: [some [word | { }   ]]
number: [some digit]
hex-literal: [#”$” some hex-digit]
item: [phrase | hex-literal | number | { } ]
data: {There were 374 brown foxes and $0001 mottley one.}
parse-the-example: does [parse/all data [any item] ]
example-hook-context: hook-parse [phrase word hex-literal number]

Then we launch load-parse-tree
temp: load-parse-tree [ parse data [any item] ] example-hook-context
and temp will contain:

[
phrase [
word "There were "
]
number "374 "
phrase [
word "brown foxes and "
]
hex-literal "$0001 "
phrase [
word "mottley one"
]
]