1# -*- tcl -*-
2#
3# Copyright (c) 2009 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
4
5# # ## ### ##### ######## ############# #####################
6## Package description
7
8## Implementation of the PackRat Machine (PARAM), a virtual machine on
9## top of which parsers for Parsing Expression Grammars (PEGs) can be
10## realized. This implementation is tied to Tcl for control flow. We
11## (will) have alternate implementations written in TclOO, and critcl,
12## all exporting the same API.
13#
14## RD stands for Recursive Descent.
15
16## This package has a pure Tcl implementation, and a C implementation,
17## choosing the latter over the former, if possible.
18
19# @mdgen EXCLUDE: pt_rdengine_c.tcl
20
21package require Tcl 8.5
22
23namespace eval ::pt::rde {}
24
25# # ## ### ##### ######## ############# #####################
26## Management of stack implementations.
27
28# ::pt::rde::LoadAccelerator --
29#
30#	Loads a named implementation, if possible.
31#
32# Arguments:
33#	key	Name of the implementation to load.
34#
35# Results:
36#	A boolean flag. True if the implementation
37#	was successfully loaded; and False otherwise.
38
39proc ::pt::rde::LoadAccelerator {key} {
40    variable accel
41    set r 0
42    switch -exact -- $key {
43	critcl {
44	    if {![package vsatisfies [package provide Tcl] 8.5]} {return 0}
45	    if {[catch {package require tcllibc}]} {return 0}
46	    set r [llength [info commands ::pt::rde_critcl]]
47	}
48	tcl {
49	    variable selfdir
50	    source [file join $selfdir pt_rdengine_tcl.tcl]
51	    set r 1
52	}
53        default {
54            return -code error "invalid accelerator/impl. package $key:\
55                must be one of [join [KnownImplementations] {, }]"
56        }
57    }
58    set accel($key) $r
59    return $r
60}
61
62# ::pt::rde::SwitchTo --
63#
64#	Activates a loaded named implementation.
65#
66# Arguments:
67#	key	Name of the implementation to activate.
68#
69# Results:
70#	None.
71
72proc ::pt::rde::SwitchTo {key} {
73    variable accel
74    variable loaded
75
76    if {$key eq $loaded} {
77	# No change, nothing to do.
78	return
79    } elseif {$key ne {}} {
80	# Validate the target implementation of the switch.
81
82	if {![info exists accel($key)]} {
83	    return -code error "Unable to activate unknown implementation \"$key\""
84	} elseif {![info exists accel($key)] || !$accel($key)} {
85	    return -code error "Unable to activate missing implementation \"$key\""
86	}
87    }
88
89    # Deactivate the previous implementation, if there was any.
90
91    if {$loaded ne {}} {
92	rename ::pt::rde ::pt::rde_$loaded
93    }
94
95    # Activate the new implementation, if there is any.
96
97    if {$key ne {}} {
98	rename ::pt::rde_$key ::pt::rde
99    }
100
101    # Remember the active implementation, for deactivation by future
102    # switches.
103
104    set loaded $key
105    return
106}
107
108# ::pt::rde::Implementations --
109#
110#	Determines which implementations are
111#	present, i.e. loaded.
112#
113# Arguments:
114#	None.
115#
116# Results:
117#	A list of implementation keys.
118
119proc ::pt::rde::Implementations {} {
120    variable accel
121    set res {}
122    foreach n [array names accel] {
123	if {!$accel($n)} continue
124	lappend res $n
125    }
126    return $res
127}
128
129# ::pt::rde::KnownImplementations --
130#
131#	Determines which implementations are known
132#	as possible implementations.
133#
134# Arguments:
135#	None.
136#
137# Results:
138#	A list of implementation keys. In the order
139#	of preference, most prefered first.
140
141proc ::pt::rde::KnownImplementations {} {
142    return {critcl tcl}
143}
144
145proc ::pt::rde::Names {} {
146    return {
147	critcl {tcllibc based}
148	tcl    {pure Tcl}
149    }
150}
151
152# # ## ### ##### ######## ############# #####################
153## Initialization: Data structures.
154
155namespace eval ::pt::rde {
156    variable  selfdir [file dirname [info script]]
157    variable  accel
158    array set accel   {tcl 0 critcl 0}
159    variable  loaded  {}
160}
161
162# # ## ### ##### ######## ############# #####################
163
164## Initialization: Choose an implementation, the most prefered is
165## listed first. Loads only one of the possible implementations. And
166## activates it.
167
168namespace eval ::pt::rde {
169    variable e
170    foreach e [KnownImplementations] {
171	if {[LoadAccelerator $e]} {
172	    SwitchTo $e
173	    break
174	}
175    }
176    unset e
177}
178
179# # ## ### ##### ######## ############# #####################
180## Ready
181
182namespace eval ::pt {
183    # Export the constructor command.
184    namespace export rde
185}
186
187package provide pt::rde 1.0.1
188