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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
# -*- tcl -*-
#
# Copyright (c) 2009-2015 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
# # ## ### ##### ######## ############# #####################
## Package description
## Implementation of the PackRat Machine (PARAM), a virtual machine on
## top of which parsers for Parsing Expression Grammars (PEGs) can be
## realized. This implementation is tied to Tcl for control flow. We
## (will) have alternate implementations written in TclOO, and critcl,
## all exporting the same API.
#
## RD stands for Recursive Descent.
## This package has a pure Tcl implementation, and a C implementation,
## choosing the latter over the former, if possible.
# @mdgen EXCLUDE: pt_rdengine_c.tcl
package require Tcl 8.5
namespace eval ::pt::rde {}
# # ## ### ##### ######## ############# #####################
## Support narrative tracing.
package require debug
debug level pt/rdengine
debug prefix pt/rdengine {}
# # ## ### ##### ######## ############# #####################
## Management of RDengine implementations.
# ::pt::rde::LoadAccelerator --
#
# Loads a named implementation, if possible.
#
# Arguments:
# key Name of the implementation to load.
#
# Results:
# A boolean flag. True if the implementation
# was successfully loaded; and False otherwise.
proc ::pt::rde::LoadAccelerator {key} {
debug.pt/rdengine {[info level 0]}
variable accel
set r 0
switch -exact -- $key {
critcl {
if {![package vsatisfies [package provide Tcl] 8.5]} {return 0}
if {[catch {package require tcllibc}]} {return 0}
set r [llength [info commands ::pt::rde_critcl]]
}
tcl {
variable selfdir
source [file join $selfdir pt_rdengine_tcl.tcl]
set r 1
}
default {
return -code error "invalid accelerator/impl. package $key:\
must be one of [join [KnownImplementations] {, }]"
}
}
set accel($key) $r
debug.pt/rdengine {[info level 0] ==> ($r)}
return $r
}
# ::pt::rde::SwitchTo --
#
# Activates a loaded named implementation.
#
# Arguments:
# key Name of the implementation to activate.
#
# Results:
# None.
proc ::pt::rde::SwitchTo {key} {
debug.pt/rdengine {[info level 0]}
variable accel
variable loaded
if {$key eq $loaded} {
# No change, nothing to do.
debug.pt/rdengine {[info level 0] == $loaded /no change}
return
} elseif {$key ne {}} {
# Validate the target implementation of the switch.
debug.pt/rdengine {[info level 0] validate}
if {![info exists accel($key)]} {
return -code error "Unable to activate unknown implementation \"$key\""
} elseif {![info exists accel($key)] || !$accel($key)} {
return -code error "Unable to activate missing implementation \"$key\""
}
}
# Deactivate the previous implementation, if there was any.
if {$loaded ne {}} {
debug.pt/rdengine {[info level 0] disable $loaded}
rename ::pt::rde ::pt::rde_$loaded
}
# Activate the new implementation, if there is any.
if {$key ne {}} {
debug.pt/rdengine {[info level 0] enable $key}
rename ::pt::rde_$key ::pt::rde
}
# Remember the active implementation, for deactivation by future
# switches.
set loaded $key
debug.pt/rdengine {[info level 0] /done}
return
}
# ::pt::rde::Implementations --
#
# Determines which implementations are
# present, i.e. loaded.
#
# Arguments:
# None.
#
# Results:
# A list of implementation keys.
proc ::pt::rde::Implementations {} {
debug.pt/rdengine {[info level 0]}
variable accel
set res {}
foreach n [array names accel] {
if {!$accel($n)} continue
lappend res $n
}
debug.pt/rdengine {[info level 0] ==> ($res)}
return $res
}
# ::pt::rde::KnownImplementations --
#
# Determines which implementations are known
# as possible implementations.
#
# Arguments:
# None.
#
# Results:
# A list of implementation keys. In the order
# of preference, most prefered first.
proc ::pt::rde::KnownImplementations {} {
debug.pt/rdengine {[info level 0]}
return {critcl tcl}
}
proc ::pt::rde::Names {} {
debug.pt/rdengine {[info level 0]}
return {
critcl {tcllibc based}
tcl {pure Tcl}
}
}
# # ## ### ##### ######## ############# #####################
## Initialization: Data structures.
namespace eval ::pt::rde {
variable selfdir [file dirname [info script]]
variable accel
array set accel {tcl 0 critcl 0}
variable loaded {}
}
# # ## ### ##### ######## ############# #####################
## Initialization: Choose an implementation, the most prefered is
## listed first. Loads only one of the possible implementations. And
## activates it.
namespace eval ::pt::rde {
variable e
foreach e [KnownImplementations] {
if {[LoadAccelerator $e]} {
SwitchTo $e
break
}
}
unset e
}
# # ## ### ##### ######## ############# #####################
## Ready
namespace eval ::pt {
# Export the constructor command.
namespace export rde
}
package provide pt::rde 1.1
|
