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