You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
177 lines
3.8 KiB
177 lines
3.8 KiB
# graph.tcl -- |
|
# |
|
# Implementation of a graph data structure for Tcl. |
|
# |
|
# Copyright (c) 2000-2005,2019 by Andreas Kupries |
|
# |
|
# See the file "license.terms" for information on usage and redistribution |
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|
|
|
# @mdgen EXCLUDE: graph_c.tcl |
|
|
|
package require Tcl 8.5 9 |
|
|
|
namespace eval ::struct::graph {} |
|
|
|
# ### ### ### ######### ######### ######### |
|
## Management of graph implementations. |
|
|
|
# ::struct::graph::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 ::struct::graph::LoadAccelerator {key} { |
|
variable accel |
|
set r 0 |
|
switch -exact -- $key { |
|
critcl { |
|
# Critcl implementation of graph requires Tcl 8.4. |
|
if {[catch {package require tcllibc}]} {return 0} |
|
set r [llength [info commands ::struct::graph_critcl]] |
|
} |
|
tcl { |
|
variable selfdir |
|
source [file join $selfdir graph_tcl.tcl] |
|
set r 1 |
|
} |
|
default { |
|
return -code error "invalid accelerator/impl. package $key:\ |
|
must be one of [join [KnownImplementations] {, }]" |
|
} |
|
} |
|
set accel($key) $r |
|
return $r |
|
} |
|
|
|
# ::struct::graph::SwitchTo -- |
|
# |
|
# Activates a loaded named implementation. |
|
# |
|
# Arguments: |
|
# key Name of the implementation to activate. |
|
# |
|
# Results: |
|
# None. |
|
|
|
proc ::struct::graph::SwitchTo {key} { |
|
variable accel |
|
variable loaded |
|
|
|
if {[string equal $key $loaded]} { |
|
# No change, nothing to do. |
|
return |
|
} elseif {![string equal $key ""]} { |
|
# Validate the target implementation of the switch. |
|
|
|
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 {![string equal $loaded ""]} { |
|
rename ::struct::graph ::struct::graph_$loaded |
|
} |
|
|
|
# Activate the new implementation, if there is any. |
|
|
|
if {![string equal $key ""]} { |
|
rename ::struct::graph_$key ::struct::graph |
|
} |
|
|
|
# Remember the active implementation, for deactivation by future |
|
# switches. |
|
|
|
set loaded $key |
|
return |
|
} |
|
|
|
# ::struct::graph::Implementations -- |
|
# |
|
# Determines which implementations are |
|
# present, i.e. loaded. |
|
# |
|
# Arguments: |
|
# None. |
|
# |
|
# Results: |
|
# A list of implementation keys. |
|
|
|
proc ::struct::graph::Implementations {} { |
|
variable accel |
|
set res {} |
|
foreach n [array names accel] { |
|
if {!$accel($n)} continue |
|
lappend res $n |
|
} |
|
return $res |
|
} |
|
|
|
# ::struct::graph::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 ::struct::graph::KnownImplementations {} { |
|
return {critcl tcl} |
|
} |
|
|
|
proc ::struct::graph::Names {} { |
|
return { |
|
critcl {tcllibc based} |
|
tcl {pure Tcl} |
|
} |
|
} |
|
|
|
# ### ### ### ######### ######### ######### |
|
## Initialization: Data structures. |
|
|
|
namespace eval ::struct::graph { |
|
variable selfdir [file dirname [info script]] |
|
variable accel |
|
array set accel {tcl 0 critcl 0} |
|
variable loaded {} |
|
} |
|
|
|
# ### ### ### ######### ######### ######### |
|
## Initialization: Choose an implementation, |
|
## most prefered first. Loads only one of the |
|
## possible implementations. And activates it. |
|
|
|
namespace eval ::struct::graph { |
|
variable e |
|
foreach e [KnownImplementations] { |
|
if {[LoadAccelerator $e]} { |
|
SwitchTo $e |
|
break |
|
} |
|
} |
|
unset e |
|
} |
|
|
|
# ### ### ### ######### ######### ######### |
|
## Ready |
|
|
|
namespace eval ::struct { |
|
# Export the constructor command. |
|
namespace export graph |
|
} |
|
|
|
package provide struct::graph 2.4.4
|
|
|