diff options
Diffstat (limited to 'tcllib/modules/grammar_fa/dacceptor.tcl')
| -rw-r--r-- | tcllib/modules/grammar_fa/dacceptor.tcl | 166 |
1 files changed, 166 insertions, 0 deletions
diff --git a/tcllib/modules/grammar_fa/dacceptor.tcl b/tcllib/modules/grammar_fa/dacceptor.tcl new file mode 100644 index 0000000..479db0c --- /dev/null +++ b/tcllib/modules/grammar_fa/dacceptor.tcl @@ -0,0 +1,166 @@ +# -*- tcl -*- +# Grammar / Finite Automatons / Acceptance checker, DFA only + +# ### ### ### ######### ######### ######### +## Package description + +## A class whose instances take a FA and are able to check strings of +## symbols for acceptance. This class is restricted to deterministic +## FAs. The FA can be either a reference to some external FA container +## object, or a copy of such. The latter makes the acceptor impervious +## to changes in the original definition. + +# ### ### ### ######### ######### ######### +## Requisites + +package require snit ; # Tcllib | OO system used +package require struct::set ; # Tcllib | Extended set operations. + +# ### ### ### ######### ######### ######### +## Implementation + +snit::type ::grammar::fa::dacceptor { + # ### ### ### ######### ######### ######### + ## Type API. + + # ### ### ### ######### ######### ######### + ## Instance API. + + #constructor {fa args} {} + #destructor {} + + method accept? {symbolstring} {} + + 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 any ; # Symbol to map any unknown symbol to. If not + # ; # specified (eq "") then unknown symbols will cause non- + # ; # acceptance. + variable stop ; # Stop state, causing immediate non-acceptance when entered. + + # ### ### ### ######### ######### ######### + ## Instance API Implementation. + + constructor {fa args} { + set any {} + $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 {![$fa is complete]} { + set istmp 1 + set tmp [grammar::fa ${selfns}::fa = $fa] + set before [$tmp states] + $tmp complete + # Our sink is a stop state. + set stop [struct::set difference [$tmp states] $before] + } else { + set istmp 0 + set tmp $fa + # We don't know if there is a sink, so no quickstop. + set stop {} + } + + set start [lindex [$tmp startstates] 0] + foreach s [$tmp finalstates] {set final($s) .} + foreach s [set syms [$tmp symbols]] {set sym($s) .} + + foreach s [$tmp states] { + foreach sy $syms { + set trans($s,$sy) [lindex [$tmp next $s $sy] 0] + } + } + + if {$istmp} {$tmp destroy} + return + } + + #destructor {} + + onconfigure -any {value} { + set options(-any) $value + set any $value + return + } + + # --- --- --- --------- --------- --------- + + method accept? {symbolstring} { + set state $start + + ## puts "\n====================== ($symbolstring)" + + if {$any eq ""} { + # No any mapping of unknown symbols. + + foreach sy $symbolstring { + if {![info exists sym($sy)]} { + # Bad symbol in input. String is not accepted, + # abort immediately. + ## puts " \[$state\] -- Unknown symbol ($sy)" + return 0 + } + + ## puts " \[$state\] --($sy)--> " + + set state $trans($state,$sy) + # state == "" cannot happen, as our FA is complete. + if {$state eq $stop} { + # This is a known sink, we can stop processing input now. + ## puts " \[$state\] FULL STOP" + return 0 + } + } + + } else { + # Mapping of unknown symbols to any. + + foreach sy $symbolstring { + if {![info exists sym($sy)]} {set sy $any} + ## puts " \[$state\] --($sy)--> " + set state $trans($state,$sy) + # state == "" cannot happen, as our FA is complete. + if {$state eq $stop} { + # This is a known sink, we can stop processing input now. + ## puts " \[$state\] FULL STOP" + return 0 + } + } + } + + ## puts " \[$state\][expr {[info exists final($state)] ? " ACCEPT" : ""}]" + + return [info exists final($state)] + } + + # ### ### ### ######### ######### ######### + ## Type API implementation. + + # ### ### ### ######### ######### ######### + ## Type Internals. + + # ### ### ### ######### ######### ######### +} + +# ### ### ### ######### ######### ######### +## Package Management + +package provide grammar::fa::dacceptor 0.1.1 |