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:
- the results may give some insight into which rules are doing all the work.
- 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
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 |
>> 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: 2x2 effect: 'ibevel] with [
data: cropbox: sliders: none
; returns unit-vector for an axis
uv?: func [w] [either w = 'x [1x0] [0x1]]
; 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: 15x15
; 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 0x0 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 0x0 cropbox: box
slider 5x1 * sldw [face/parent-face/scroll uv? face/axis value]
slider 1x5 * 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 0x0]
]
if resize [do-face self data/offset]
self
]
; Method to scroll the content with performance hinting.
scroll: function [v value] [extra] [
extra: min 0x0 (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 - 150x150
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 0x0 space 0x0 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: 3x3]]
]
; Build main layout
token-lyo: layout [
origin 0x0 space 0x0
scroll-panel to pair! reduce [sz-input/1 45] name-area
scroll-panel sz-input [
origin 0x0 space 0x0
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-contextand temp will contain:
[
phrase [
word "There were "
]
number "374 "
phrase [
word "brown foxes and "
]
hex-literal "$0001 "
phrase [
word "mottley one"
]
]
Order a professional Sparkling White Smiles Custom Teeth Whitening System online and get BIG SAVINGS!
ReplyDelete* 10 shades whiter in days!
* Professional Results Are Guaranteed.
* As good as your dentist.
* Same strength Teeth Whitening Gel as dentists use.