"Grow" a tree data structure using a state machine, constraining the result using a set of rules.
A "niwashi" is a state machine you can use to "grow" a tree data structure while maintaining a set of constraints. ("Niwashi" is the Japanese word for "gardener"; we want to make a "tree" "grow" in a specified, constrained way, sort of like you would do with a bonsai.)
In the simplest case, this can be used to create a tree from a simple sequence of commands; for example, while parsing something like XML: the niwashi will keep track of the state for you, so you only have to send commands much like "open tag" and "close tag".
But, a niwashi also allows you to define rules that apply while the tree is being built. This is an alternative to creating a tree, and then applying tree rewriting rules to transform it; the tree is instead transformed while it is being built. For example, this is very useful while parsing something like HTML, where the source is not necessarily properly formed, and where you want to apply some transformations to the HTML as well. This is much more efficient as it all happens in one pass.
We have a simple set of functions that can be used to build trees in the most common and simplest cases; we also have a set of additional functions that solve some rather common "not so simple" problems.
Then, we allow defining a set of rules that have to be enforced while the tree is being built. They basically allow "transforming" the tree while it is being built.
〈Overview〉 ≡
〈Macros〉
〈Basic tree building〉
〈Advanced tree building〉
〈Tree building rules〉
The basic idea of a niwashi is that of a tool to incrementally build trees. You start by creating a niwashi, which is an object that holds the state of the tree you are building:
〈Basic tree building〉 ≡
make-niwashi: func [
"Create an object used to build trees"
] [
〈Create a niwashi object〉
]
The function returns a new niwashi object. This object must be passed to all the other functions here.
At any time, you can obtain the root node of the tree you are building by accessing the root field of this object (eg. my-niwashi/root). By default, the root node will have a type of 'root and no properties.
The niwashi will keep track of a "current node". Initially, that will be the root node. You can append a new child node to the current node with append-child:
〈Basic tree building〉 +≡
append-child: func [
"Append a new child to the current node"
[catch]
niwashi [object!]
spec [block!]
] [
〈Append a new child to the current node〉
]
The spec block is something like:
append-child my-niwashi [type: 'child properties: [name: "Value"]]
When using append-child, the "current node" stays the same - you only append a new child to it. If you use enter-child instead, a new node is appended and it is made the current node:
〈Basic tree building〉 +≡
enter-child: func [
{Append a new child to the current node, and make it the current node}
[catch]
niwashi [object!]
spec [block!]
/local 〈enter-child's locals〉
] 〈Append a new child and make it the current node〉
The function is called like append-child:
enter-child my-niwashi [type: 'child properties: [name: "Value"]]
(In the above example, a new node of type 'child is appended to the current node, and the current node is changed to be this new node; so, after the call, the current node is this 'child just appended, and if you call append-child you will append a child to it.)
You can then call leave-child to "move back" the current node to what it was before calling enter-child - that is, to the current node's parent node:
〈Basic tree building〉 +≡
leave-child: func [
{Leave the current node, make its parent the new current node}
[catch]
niwashi [object!]
/local 〈leave-child's locals〉
] 〈Change the current node to the current parent node〉
If the niwashi is already at the root node, it is an error to call leave-child.
When parsing something like HTML and building a tree for it, the number one problem is that HTML is not a strict format, and allows authors to take a number of freedoms, which means that the parser needs to be smart enough to figure out what to do. If you add the fact that often the HTML you are parsing is malformed, and you have to make sense of it anyway, you'll see that the basic functions above are not enough to solve your problems.
But, do not dispair, because here we introduce the Swiss Army knife of tree building: split-branch. In short, it splits one branch of the tree into two.
〈Advanced tree building〉 ≡
split-branch: func [
{Split the current branch into two branches (new branch left detached)}
[catch]
niwashi [object!]
base [word! block!]
/knots knot-nodes [word! block!]
/prune prune-nodes [word! block!]
/local 〈split-branch's locals〉
] 〈Split the current branch〉
split-branch's behavior requires explanation, so we'll offer a number of examples. The basic idea is that of creating a new tree branch that is basically a copy of the current tree branch, up to the specified "base" node; then the base node is made the current node, while the newly created branch is left "detached" at can be attached back to the current node at any time using attach-branch:
〈Advanced tree building〉 +≡
attach-branch: func [
"Attach a previously split branch"
[catch]
niwashi [object!]
] 〈Attach the split branch to the tree〉
When the branch is attached, its "leaf" node is made the current node.
Let's make a simple example: imagine you're parsing HTML like "<p>some <b>bold<p>text". If you try that in a browser, you'll see that both "bold" and "text" are in bold, and "text" is in a new paragraph. The browser will create a tree like this:
(P
("Some ")
(B
("bold")
)
)
(P
(B
("text")
)
)
Which means that something like this happens:
You can imagine the effect of the second <p> tag as that of "splitting" the current branch (made of the P node and its child B) into two branches, the existing one (with P and B) and a new one with the same structure (a new P and a new B). This is what split-branch followed by attach-branch does.
The above can be written this way using a niwashi:
; <p>
enter-child my-niwashi [type: 'p]
; "some "
append-child my-niwashi [type: 'text properties: [value: "some "]]
; <b>
enter-child my-niwashi [type: 'b]
; "bold"
append-child my-niwashi [type: 'text properties: [value: "bold"]]
; <p>
split-branch my-niwashi 'root
attach-branch my-niwashi
Notice that the split-branch goes back to the root node, while having a new branch made of a P node containing a B node ready to be attached at any time. We immediately attach it in this case, so the above split-branch and attach-branch combination is equivalent to the following:
leave-child my-niwashi ; leave B
leave-child my-niwashi ; leave P
enter-child my-niwashi [type: 'p]
enter-child my-niwashi [type: 'b]
If no node with a type of base is found in the current branch, an error is generated. You can also pass a block of node types, and the first node up the tree that matches will be taken as the base.
Note that there can only be one "detached" branch at a time; if you don't call attach-branch, before calling split-branch again, the previous detached branch is lost.
Another interesting example is something like "<b>bold, <i>bold-italic, </b>italic", which we want to produce the following tree:
(B
("bold, ")
(I
("bold-italic, ")
)
)
(I
("italic")
)
That can be done by making close tags do a split-branch with the closing tag type as the base, followed by a leave-child, followed again by an attach-branch to "re-open" the other nodes.
; <b>
enter-child my-niwashi [type: 'b]
; "bold, "
append-child my-niwashi [type: 'text properties: [value: "bold, "]]
; <i>
enter-child my-niwashi [type: 'i]
; "bold-italic, "
append-child my-niwashi [type: 'text properties: [value: "bold-italic, "]]
; </b>
split-branch my-niwashi 'b
leave-child my-niwashi
attach-branch my-niwashi
; "italic"
append-child my-niwashi [type: 'text properties: [value: "italic"]]
split-branch also has two refinements, /knots and /prune. The latter allows removing (or, more precisely, not re-opening) nodes from the new branch that gets created. You can pass a block of node types that should not be reopened.
The /knots refinement can be used to mark certain nodes in the branch as "knots", which stop the "knife" that is splitting the branch in two. Let's use HTML again for an example.
Pretend to be parsing something as messed up as "<table><tr><td><table></td><tr><td>cell</table>". Notice that browsers produce something like:
(TABLE
(TR
(TD
(TABLE
(TR
(TD
("cell")
)
)
)
)
)
)
Take the "</td>" in that string into consideration. You may be tempted to do a split-branch ... 'td when you encounter a "</td>", like we did with "</b>" above, but in this case that would produce:
(TABLE
(TR
(TD
(TABLE)
)
(TABLE
(TR
(TD
("cell")
)
)
)
)
)
which is wrong. You don't really want to split table nodes; you can use the /knots refinement to mark 'table nodes as not splittable. Trying to split a knot causes an error (which for things like parsing HTML you just want to ignore). So, the above can be done with:
; <table>
enter-child my-niwashi [type: 'table]
; <tr>
enter-child my-niwashi [type: 'tr]
; <td>
enter-child my-niwashi [type: 'td]
; <table>
enter-child my-niwashi [type: 'table]
; </td>
attempt [
split-branch/knots my-niwashi 'td 'table
leave-child my-niwashi
attach-branch my-niwashi
]
; <tr>
enter-child my-niwashi [type: 'tr]
; <td>
enter-child my-niwashi [type: 'td]
; "cell"
append-child my-niwashi [type: 'text properties: [value: "cell"]]
You can pass a block of node types to /knots as well.
A common thing you do with trees is:
We want to join those two steps into one, "build a tree while transforming it into something else". So, here we enter the realm of black magic... no, actually, it's easier than what it may seem.
The trick is defining a set of rules that are applied while the tree is being built - basically definining constraints on the way the tree is able to grow, "forcing" it to grow in a certain way.
〈Tree building rules〉 ≡
define-rules: func [
"Define rules to apply while building the tree"
[catch]
niwashi [object!]
rules [block!]
] [
〈Define the rules to apply while building the tree〉
]
(Note that you may call define-rules many times, "adding" new rules to previously defined ones, or overriding them.)
Rules are mainly actions (eg. a function call) that are performed on specified events (for example when a node is added to the tree). Each rule has the following grammar:
"Grammar for the niwashi rules"
rule: [
['on | 'except] node-types ['force node-type | 'move 'to target-name | action]
|
['ignore | 'only] node-types
|
'move 'target target-name
|
'inside opt ['all 'but] node-types into rules
|
'after node-types into rules
|
'always into rules
]
node-type: [word!]
node-types: [node-type | into [some node-type]]
target-name: [word!]
action: [word! | block!]
rules: [some rule]
(See 〈Niwashi rules grammar〉 for more details.) node-type is the type of the node that has been added, while action can be a word referring to a function (must take one argument, the added node), or a block (will be made into a function with one argument, named node). The function is called once the node is complete, that is, all its children have been added; in other words, this happens on leave-child.
move to actions and move target are currently not implemented. (Hopefully coming soon.)
All the actions that match are called, in the order they appear in the rules. For example:
define-rules my-niwashi [
except div f1
on p f2
]
For 'p nodes, first f1 will be called (because it is not 'div), then f2 is called (because it is 'p). There are, however, some exceptions. Actions are never called for ignored nodes, no matter the order of rules. (And you cannot override an ignore rule at this point.) Also, there can only be one valid force action at a time for a specific node, a new one always overrides any existing ones; that is, in a case like:
define-rules my-niwashi [
on p force 'body
on p force 'html
]
the second rule overrides the first one.
The rules passed to define-rules apply to all the direct children of the root node, that is, all the nodes added to the root node. The inside rule can be used to specify rules for other nodes (see examples below).
Let's make some examples:
on p [probe node]
means that after leave-child is called on P, the node is probed.
on p force body
means that before entering P, a node of type 'body is created and entered; this means that when the rules applies, enter-child my-niwashi [type: 'p] becomes equivalent to enter-child my-niwashi [type: 'body] enter-child my-niwashi [type: 'p].
except [p h1] f
means that for all node except those of type 'p or 'h1, the function f is called.
ignore whitespace
means that nodes of type 'whitespace are ignored - that is, they are never added to the tree.
only col
means that only nodes of type 'col are added, any other node is ignored.
inside html [
; ...
]
means that when a node of type 'html is entered, the specified rules are applied. The new rules replace the existing ones, and are as well replaced when a new child is entered.
As we said, the rules passed to define-rules only apply while the root node is the current node. As soon as a new node is entered, they are replaced with either a set of rules defined by inside, or by an empty set. You can control which rules are applied at any time by using inside carefully.
Using inside multiple time for the same node means adding more rules to the ones that already exist for that node.
after p [
; ...
]
means that after a node of type 'p has been added to the current node, the specified additional rules apply. It's similar to inside except that the rule apply after the specified node (up to the end of the current node) instead of inside of it.
always [
; ...
]
always works like inside except that the given rules apply to the current node and to all its children; they are not replaced when a new child is entered, so basically they are always in effect until the node that added them is left.
Since actions are performed when nodes are "left", you can use this handy function when you're done building the tree to make sure you are back to the root node:
〈Tree building rules〉 +≡
leave-all: func [
"Leave all nodes, go back to the root node"
niwashi [object!]
/local 〈leave-all's locals〉
] 〈Leave all nodes and go back to the root node〉
〈Create a niwashi object〉 ≡
context [
root: current-node: make-node 'root
branch: none
stack: copy [ ]
cn-rules: make rules! [always: none]
always-rules: make rules! [ ]
]
〈Append a new child and make it the current node〉 ≡
expand-macros [
on-enter niwashi node: make-child spec
!set-node-parent-quick node niwashi/current-node
niwashi/current-node: node
]
〈enter-child's locals〉 ≡
node
〈Change the current node to the current parent node〉 ≡
expand-macros [
node: niwashi/current-node
unless parent: !get-node-parent node [
throw make error! "Already at the root node"
]
niwashi/current-node: parent
on-leave niwashi node
]
〈leave-child's locals〉 ≡
node parent
〈Append a new child to the current node〉 ≡
on-append niwashi make-child spec
〈Split the current branch〉 ≡
expand-macros [
!ensure-block base
!unless knots [knot-nodes: [ ]]
!unless prune [prune-nodes: [ ]]
!ensure-block knot-nodes
!ensure-block prune-nodes
node: niwashi/current-node
branch: copy [ ]
to-leave: clear [ ]
while [not find base type: !get-node-type node] [
if find knot-nodes type [
throw make error! join "Cannot cut through '" [type "' nodes"]
]
unless find prune-nodes type [
new-node: !make-node type (!get-node-properties node)
insert/only branch new-node
]
insert/only tail to-leave node
unless node: !get-node-parent node [
throw make error! join "No nodes of type '" [base "' found in the current branch"]
]
]
niwashi/current-node: node
foreach node to-leave [
on-leave niwashi node
]
niwashi/branch: branch
]
〈split-branch's locals〉 ≡
node branch to-leave new-node type
〈Attach the split branch to the tree〉 ≡
expand-macros [
unless niwashi/branch [
throw make error! "No branch to attach"
]
foreach node niwashi/branch [
on-enter niwashi node
!set-node-parent-quick node niwashi/current-node
niwashi/current-node: node
]
niwashi/branch: none
]
〈Define the rules to apply while building the tree〉 ≡
clear named-rules
compile-rules rules niwashi/cn-rules
if niwashi/cn-rules/always [
merge-rules niwashi/always-rules niwashi/cn-rules/always
]
〈Leave all nodes and go back to the root node〉 ≡
expand-macros [
node: niwashi/current-node
while [parent: !get-node-parent node] [
niwashi/current-node: parent
on-leave niwashi node
node: parent
]
]
〈leave-all's locals〉 ≡
node parent
〈Niwashi rules grammar〉 ≡
named-rules: [ ]
rules!: context [
debug?: no
force-node?: func [type /local result] [#[none]]
ignore: [ ] only: [ ]
ignore?: func [type] [#[false]]
make-new-rules: func [type rules always-rules] [ ]
do-actions: func [type node] [ ]
make-after-rules: func [type rules /local result] [#[none]]
]
merge-rules: func [target rules] [
target/debug?: any [target/debug? rules/debug?]
target/force-node?: func [type /local result]
head insert remove back tail second get in target 'force-node? second get in rules 'force-node?
mk-ignore target target/ignore: union target/ignore rules/ignore target/only: union target/only rules/only
target/make-new-rules: func [type rules always-rules]
head insert tail second get in target 'make-new-rules second get in rules 'make-new-rules
target/do-actions: func [type node]
head insert tail second get in target 'do-actions second get in rules 'do-actions
target/make-after-rules: func [type rules /local result]
head insert remove back tail second get in target 'make-after-rules second get in rules 'make-after-rules
]
compile-rules: func [
rules rules-object
/local pos types value force-node cmd ignore only last-force new-rules actions
last-action mk-newrules mk-afterrules last-mkr last-mkar
] [
ignore: copy rules-object/ignore
only: copy rules-object/only
force-node: copy second get in rules-object 'force-node?
remove back tail force-node
last-force: no
last-action: no
actions: copy second get in rules-object 'do-actions
mk-newrules: copy second get in rules-object 'make-new-rules
mk-afterrules: head remove back tail copy second get in rules-object 'make-after-rules
last-mkr: no
parse rules [
some [
'debug (rules-object/debug?: yes)
|
['on | 'except] node-types pos: ['move 'to word!] (
throw make error! join "MOVE TO not supported at this time: " mold/only pos
)
|
'on set types node-types 'force set value word! (
either last-force [
append last force-node compose/deep [
(types) [result: (to lit-word! value)]
]
] [
append force-node compose/deep [
switch/all type [
(types) [result: (to lit-word! value)]
]
]
last-force: yes
]
)
|
'except set types node-types 'force set value word! (
last-force: no
append force-node compose/deep [
switch/default type [
(types) [ ]
] [result: (to lit-word! value)]
]
)
|
'on set types node-types [
set value word! (value: get value)
|
set value block! (value: func [node] value)
] (
either last-action [
append last actions compose/deep [
(types) [(:value) node]
]
] [
append actions compose/deep [
switch/all type [
(types) [(:value) node]
]
]
last-action: yes
]
)
|
'except set types node-types [
set value word! (value: get value)
|
set value block! (value: func [node] value)
] (
last-action: no
append actions compose/deep [
switch/default type [
(types) [ ]
] [(:value) node]
]
)
|
set cmd ['ignore | 'only] set types node-types (
append get bind cmd 'ignore types
)
|
pos: 'move 'target word! (
throw make error! join "MOVE TARGET not supported at this time: " mold/only pos
)
|
'inside 'all 'but set types node-types set value word! (
unless new-rules: select named-rules value [
new-rules: make rules! [always: none]
repend named-rules [value new-rules]
compile-rules get value new-rules
]
append mk-newrules compose/deep [
switch/default type [
(types) [ ]
] [
(:merge-rules) rules (new-rules)
(either all [in new-rules 'always new-rules/always] [
compose [(:merge-rules) always-rules (new-rules/always)]
] [
[ ]
])
]
]
last-mkr: no
)
|
'inside 'all 'but set types node-types set value block! (
new-rules: make rules! [always: none]
compile-rules value new-rules
append mk-newrules compose/deep [
switch/default type [
(types) [ ]
] [
(:merge-rules) rules (new-rules)
(either new-rules/always [
compose [(:merge-rules) always-rules (new-rules/always)]
] [
[ ]
])
]
]
last-mkr: no
)
|
'inside set types node-types set value word! (
unless new-rules: select named-rules value [
new-rules: make rules! [always: none]
repend named-rules [value new-rules]
compile-rules get value new-rules
]
either last-mkr [
append last mk-newrules compose/deep [
(types) [
(:merge-rules) rules (new-rules)
(either all [in new-rules 'always new-rules/always] [
compose [(:merge-rules) always-rules (new-rules/always)]
] [
[ ]
])
]
]
] [
append mk-newrules compose/deep [
switch/all type [
(types) [
(:merge-rules) rules (new-rules)
(either all [in new-rules 'always new-rules/always] [
compose [(:merge-rules) always-rules (new-rules/always)]
] [
[ ]
])
]
]
]
last-mkr: yes
]
)
|
'inside set types node-types set value block! (
new-rules: make rules! [always: none]
compile-rules value new-rules
either last-mkr [
append last mk-newrules compose/deep [
(types) [
(:merge-rules) rules (new-rules)
(either new-rules/always [
compose [(:merge-rules) always-rules (new-rules/always)]
] [
[ ]
])
]
]
] [
append mk-newrules compose/deep [
switch/all type [
(types) [
(:merge-rules) rules (new-rules)
(either new-rules/always [
compose [(:merge-rules) always-rules (new-rules/always)]
] [
[ ]
])
]
]
]
last-mkr: yes
]
)
|
'after set types node-types set value word! (
unless new-rules: select named-rules value [
new-rules: make rules! [ ]
repend named-rules [value new-rules]
compile-rules get value new-rules
]
either empty? mk-afterrules [
append mk-afterrules compose/deep [
switch/all type [
(types) [merge-rules rules (new-rules) result: #[true]]
]
]
] [
append last mk-afterrules compose/deep [
(types) [merge-rules rules (new-rules) result: #[true]]
]
]
)
|
'after set types node-types set value block! (
new-rules: make rules! [ ]
compile-rules value new-rules
either empty? mk-afterrules [
append mk-afterrules compose/deep [
switch/all type [
(types) [merge-rules rules (new-rules) result: #[true]]
]
]
] [
append last mk-afterrules compose/deep [
(types) [merge-rules rules (new-rules) result: #[true]]
]
]
)
|
pos: 'always (
unless in rules-object 'always [
throw make error! join "ALWAYS inside ALWAYS or AFTER: " mold/only pos
]
) [
set value block! (
new-rules: make rules! [ ]
compile-rules value new-rules
either rules-object/always [
merge-rules rules-object/always new-rules
] [
rules-object/always: new-rules
]
)
|
set value word! (
unless new-rules: select named-rules value [
new-rules: make rules! [ ]
repend named-rules [value new-rules]
compile-rules get value new-rules
]
either rules-object/always [
merge-rules rules-object/always new-rules
] [
rules-object/always: new-rules
]
)
]
|
pos: skip (invalid-arg pos)
]
]
append force-node 'result
append mk-afterrules 'result
rules-object/force-node?: func [type /local result] force-node
mk-ignore rules-object rules-object/ignore: unique ignore rules-object/only: unique only
rules-object/make-new-rules: func [type rules always-rules] mk-newrules
rules-object/do-actions: func [type node] actions
rules-object/make-after-rules: func [type rules /local result] mk-afterrules
]
mk-ignore: func [rules-object ignore only] [
rules-object/ignore?: case [
all [empty? ignore empty? only] [
func [type] [#[false]]
]
empty? only [
func [type] compose/only [
find (ignore) type
]
]
empty? ignore [
func [type] compose/only [
not find (only) type
]
]
'else [
func [type] compose/deep/only [
any [find (ignore) type not find (only) type]
]
]
]
]
node-types: [word! | into [some word!]]
〈Overview〉 +≡
〈Niwashi rules grammar〉
invalid-arg: func [val] [throw make error! compose/only [script invalid-arg (:val)]]
make-child: func [spec /local pos word type properties value prop] expand-macros [
parse spec [
any [
pos:
set word set-word! (
unless find [type: properties:] word [invalid-arg pos]
set [value pos] do/next next pos
set bind word 'type value
) :pos
|
skip (invalid-arg pos)
]
]
unless word? :type [
throw make error! "No node type specified"
]
prop: copy [ ]
if block? :properties [
parse properties [
some [[word! | path!] skip] (append prop properties)
|
some [
pos:
set word set-word! (
set [value pos] do/next next pos
insert/only insert tail prop to word! word :value
) :pos
|
set word set-path! (
set [value pos] do/next next pos
insert/only insert tail prop to path! word :value
) :pos
]
|
pos: skip (invalid-arg pos)
]
]
!make-node-no-copy type prop
]
on-enter: func [niwashi node /local type force-node new-rules debug? new-alw] expand-macros [
type: !get-node-type node
new-rules: make rules! [always: none]
;if debug?: any [niwashi/always-rules/debug? niwashi/cn-rules/debug?] [
; print ["ENTER" type]
;]
case [
any [niwashi/always-rules/ignore? type niwashi/cn-rules/ignore? type] [
;if debug? [
; print "IGNORED"
; ask "?"
;]
!push niwashi [always-rules cn-rules]
]
force-node: any [niwashi/cn-rules/force-node? type niwashi/always-rules/force-node? type] [
;if debug? [
; print ["Forcing node:" force-node]
; ask "?"
;]
; TODO: infinite recursion protection
enter-child niwashi [type: force-node]
; enter-child changes the rules, so we need to do all the above again
on-enter niwashi node
]
'else [
;if debug? [
; print "Setting up new rules"
; ask "?"
;]
!push niwashi [always-rules cn-rules]
new-alw: make rules! [ ]
merge-rules new-alw niwashi/always-rules
niwashi/always-rules: new-alw
niwashi/always-rules/make-new-rules type new-rules niwashi/always-rules
niwashi/cn-rules/make-new-rules type new-rules niwashi/always-rules
niwashi/cn-rules: new-rules
]
]
]
on-leave: func [niwashi node /local type debug? after-rules] expand-macros [
type: !get-node-type node
!pop niwashi [always-rules cn-rules]
after-rules: make rules! [ ]
;if debug?: any [niwashi/always-rules/debug? niwashi/cn-rules/debug?] [
; print ["LEAVE" type]
;]
either any [niwashi/always-rules/ignore? type niwashi/cn-rules/ignore? type] [
;if debug? [
; print "IGNORED"
; ask "?"
;]
unwrap-node node
] [
if or~ to logic! niwashi/always-rules/make-after-rules type after-rules
to logic! niwashi/cn-rules/make-after-rules type after-rules [
;if debug? [
; print "Setting AFTER rules"
;]
niwashi/cn-rules: after-rules
]
;if debug? [
; print "Doing actions"
; ask "?"
;]
niwashi/always-rules/do-actions type node
niwashi/cn-rules/do-actions type node
]
]
on-append: func [niwashi node /local type debug? force-node after-rules] expand-macros [
type: !get-node-type node
after-rules: make rules! [ ]
;if debug?: any [niwashi/always-rules/debug? niwashi/cn-rules/debug?] [
; print ["APPEND" type]
;]
case [
any [niwashi/always-rules/ignore? type niwashi/cn-rules/ignore? type] [
;if debug? [
; print "IGNORED"
; ask "?"
;]
]
force-node: any [niwashi/cn-rules/force-node? type niwashi/always-rules/force-node? type] [
;if debug? [
; print ["Forcing node:" force-node]
; ask "?"
;]
; TODO: infinite recursion protection
enter-child niwashi [type: force-node]
; enter-child changes the rules, so we need to do all the above again
on-append niwashi node
]
'else [
!set-node-parent-quick node niwashi/current-node
if or~ to logic! niwashi/always-rules/make-after-rules type after-rules
to logic! niwashi/cn-rules/make-after-rules type after-rules [
;if debug? [
; print "Setting AFTER rules"
;]
niwashi/cn-rules: after-rules
]
;if debug? [
; print "Doing actions"
; ask "?"
;]
niwashi/always-rules/do-actions type node
niwashi/cn-rules/do-actions type node
]
]
]
〈Macros〉 ≡
!push: macro [niwashi words] [(compile-push niwashi words)]
compile-push: func [niwashi words] [
collect [
foreach word words [keep :insert]
keep :tail
keep/only make path! reduce [niwashi 'stack]
foreach word words [
keep/only make path! reduce [niwashi word]
]
]
]
!pop: macro [niwashi words] [
(:set) (:bind) words/only niwashi
(to set-word! tmp: use [tmp] ['tmp])
(:skip) (:tail) /only
(make path! reduce [niwashi 'stack])
(negate length? words)
(:clear) (tmp)
]
!unless: macro [ ] [(:unless)]
!ensure-block: macro [word] [(:unless) (:block?) word [(to set-word! word) (:reduce) [word]]]