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