File: dacceptor.tcl

package info (click to toggle)
tcllib 1.20%2Bdfsg-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 68,064 kB
  • sloc: tcl: 216,842; ansic: 14,250; sh: 2,846; xml: 1,766; yacc: 1,145; pascal: 881; makefile: 107; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (166 lines) | stat: -rw-r--r-- 4,606 bytes parent folder | download | duplicates (9)
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
# -*- 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