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