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