1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
# -*- tcl -*-
# Grammar / Finite Automatons / Executor, DFA only
# ### ### ### ######### ######### #########
## Package description
## Instances take a DFA, keep a current state and update it in
## reaction incoming symbols. Notable events are reported via
## callback. Currently notable: Reset, reached a final state,
# reached an error.
## From the above description it should be clear that this class is
## run in a push fashion. If not the last sentence has made this
## explicit, right ? Right!
# ### ### ### ######### ######### #########
## Requisites
package require snit ; # Tcllib | OO system used
# ### ### ### ######### ######### #########
## Implementation
snit::type ::grammar::fa::dexec {
# ### ### ### ######### ######### #########
## Type API.
# ### ### ### ######### ######### #########
## Instance API.
#constructor {fa args} {}
#destructor {}
method reset {} {}
method put {sy} {}
method state {} {}
option -command {}
option -any {}
# ### ### ### ######### ######### #########
## Internal data structures.
## We take the relevant information from the FA specified during
## construction, i.e. start state, final states, and transition
## table in form for direct indexing and keep it local. No need to
## access or even the full FA. We require a deterministic one, and
## will complete it, if necessary.
variable start ; # Name of start state.
variable final ; # Array, existence = state is final.
variable trans ; # Transition array: state x symbol -> state
variable sym ; # Symbol set (as array), for checking existence.
variable cmd ; # Command to call for various events. Required.
variable any ; # Symbol to map any unknown symbol to. If not
# ; # specified (eq "") then unknown symbols will cause non-
# ; # acceptance.
variable curr ; # State the underlying DFA is currently in.
variable inerr ; # Boolean flag. Set if an error was reached.
# ### ### ### ######### ######### #########
## Instance API Implementation.
constructor {fa args} {
set any {}
set cmd {}
$self configurelist $args
if {![$fa is deterministic]} {
return -code error "Source FA is not deterministic"
}
if {($any ne "") && ![$fa symbol exists $any]} {
return -code error "Chosen any symbol \"$any\" does not exist"
}
if {![llength $cmd]} {
return -code error "Command callback missing"
}
# In contrast to the acceptor we do not complete the FA. We
# will later report BADTRANS errors instead if a non-existing
# transition is attempted. For the acceptor it made sense as
# it made the accept/!accept decision easier. However here for
# the generic execution it is unreasonable interference with
# whatever higher levels might wish to do when encountering
# this.
set start [lindex [$fa startstates] 0]
foreach s [$fa finalstates] {set final($s) .}
foreach s [set syms [$fa symbols]] {set sym($s) .}
foreach s [$fa states] {
foreach sy [$fa symbols@ $s] {
set trans($s,$sy) [lindex [$fa next $s $sy] 0]
}
}
$self reset
return
}
#destructor {}
onconfigure -command {value} {
set options(-command) $value
set cmd $value
return
}
onconfigure -any {value} {
set options(-any) $value
set any $value
return
}
# --- --- --- --------- --------- ---------
method reset {} {
set curr $start
set inerr 0
## puts -nonewline " \[$curr\]" ; flush stdout
uplevel #0 [linsert $cmd end \
reset]
return
}
method state {} {
return $curr
}
method put {sy} {
if {$inerr} return
## puts " --($sy)-->"
if {![info exists sym($sy)]} {
if {$any eq ""} {
# No any mapping of unknown symbols, report as error
## puts " BAD SYMBOL"
set inerr 1
uplevel #0 [linsert $cmd end \
error BADSYM "Bad symbol \"$sy\""]
return
} else {
# Mapping of unknown symbols to any.
set sy $any
}
}
if {[catch {
set new $trans($curr,$sy)
}]} {
## puts " NO DESTINATION"
set inerr 1
uplevel #0 [linsert $cmd end \
error BADTRANS "Bad transition (\"$curr\" \"$sy\"), no destination"]
return
}
set curr $new
uplevel #0 [linsert $cmd end \
state $curr]
## puts -nonewline " \[$curr\]" ; flush stdout
if {[info exists final($curr)]} {
## puts -nonewline " FINAL" ; flush stdout
uplevel #0 [linsert $cmd end \
final $curr]
}
return
}
# ### ### ### ######### ######### #########
## Type API implementation.
# ### ### ### ######### ######### #########
## Type Internals.
# ### ### ### ######### ######### #########
}
# ### ### ### ######### ######### #########
## Package Management
package provide grammar::fa::dexec 0.2
|
