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