summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorOmar Rizwan <omar@omar.website>2023-02-04 16:13:01 +0000
committerOmar Rizwan <omar@omar.website>2023-02-04 16:13:01 +0000
commitf015aeaf24f0e0f5bc7a8bd1aac3dcbf987a50c8 (patch)
tree0656ac147a7fbef132ae0257ee850e2159218f18 /lib
parentstatement add compiles -- now to expose it and test it from Tcl (diff)
downloadfolk-f015aeaf24f0e0f5bc7a8bd1aac3dcbf987a50c8.tar.gz
folk-f015aeaf24f0e0f5bc7a8bd1aac3dcbf987a50c8.zip
Fix addWithVar export, add ${} syntax in csubst
Make add a c proc -- it compiles -- add [] array support so it works
Diffstat (limited to 'lib')
-rw-r--r--lib/c.tcl43
-rw-r--r--lib/trie.tcl2
2 files changed, 21 insertions, 24 deletions
diff --git a/lib/c.tcl b/lib/c.tcl
index 0936f59f..fcdc65f0 100644
--- a/lib/c.tcl
+++ b/lib/c.tcl
@@ -8,9 +8,11 @@ proc csubst {s} {
"\\" {incr i; lappend result [string index $s $i]}
{$} {
set tail [string range $s $i+1 end]
- if {[regexp {^(?:[A-Za-z0-9_]|::)+} $tail varname]} {
+ if {[regexp {^((?:[A-Za-z0-9_]|::)+)} $tail match-> varname] ||
+ [regexp {^\{([^\}]*)\}} $tail match-> varname]} {
+
lappend result [uplevel [list set $varname]]
- incr i [string length $varname]
+ incr i [string length ${match->}]
} elseif {[string index $tail 0] eq "\["} {
set bracketcount 0
for {set j 0} {$j < [string length $tail]} {incr j} {
@@ -61,16 +63,17 @@ namespace eval c {
}
variable argtypes {
- int { expr {{ Tcl_GetIntFromObj(interp, $obj, &$argname); }}}
- size_t { expr {{ Tcl_GetIntFromObj(interp, $obj, &$argname); }}}
- uint16_t { expr {{ Tcl_GetIntFromObj(interp, $obj, &$argname); }}}
- uint32_t { expr {{ sscanf(Tcl_GetString($obj), "%"PRIu32, &$argname); }}}
- uint64_t { expr {{ sscanf(Tcl_GetString($obj), "%"PRIu64, &$argname); }}}
- char* { expr {{ $argname = Tcl_GetString($obj); }} }
- Tcl_Obj* { expr {{ $argname = $obj; }}}
+ int { expr {{ int $argname; Tcl_GetIntFromObj(interp, $obj, &$argname); }}}
+ size_t { expr {{ size_t $argname; Tcl_GetIntFromObj(interp, $obj, (int *)&$argname); }}}
+ uint16_t { expr {{ uint16_t $argname; Tcl_GetIntFromObj(interp, $obj, &$argname); }}}
+ uint32_t { expr {{ uint32_t $argname; sscanf(Tcl_GetString($obj), "%"PRIu32, &$argname); }}}
+ uint64_t { expr {{ uint64_t $argname; sscanf(Tcl_GetString($obj), "%"PRIu64, &$argname); }}}
+ char* { expr {{ char* $argname = Tcl_GetString($obj); }} }
+ Tcl_Obj* { expr {{ Tcl_Obj* $argname = $obj; }}}
default {
if {[string index $argtype end] == "*"} {
expr {{
+ $argtype $argname;
if (sscanf(Tcl_GetString($obj), "($argtype) 0x%p", &$argname) != 1) {
return TCL_ERROR;
}
@@ -78,11 +81,12 @@ namespace eval c {
} elseif {[regexp {([^\[]+)\[(\d*)\]$} $argtype -> basetype arraylen]} {
# note: arraylen can be ""
expr {{
+ int ${argname}_objc; Tcl_Obj** ${argname}_objv;
+ Tcl_ListObjGetElements(interp, $obj, &${argname}_objc, &${argname}_objv);
+ $basetype $argname\[${argname}_objc\];
{
- int objc; Tcl_Obj** objv;
- Tcl_ListObjGetElements(interp, $obj, &objc, &objv);
- for (int i = 0; i < $arraylen; i++) {
- $[arg $basetype $argname\[i\] objv\[i\]]
+ for (int i = 0; i < ${argname}_objc; i++) {
+ $[arg $basetype $argname\[i\] ${argname}_objv\[i\]]
}
}
}}
@@ -260,25 +264,18 @@ namespace eval c {
set cname [string map {":" "_"} $name]
# puts "$name $args $rtype $body"
- variable argtypes
- variable rtypes
-
set arglist [list]
set argnames [list]
set loadargs [list]
- for {set i 0} {$i < [llength $args]} {incr i 2} {
- set argtype [lindex $args $i]
- set argname [lindex $args [expr {$i+1}]]
+ foreach {argtype argname} $args {
+ lassign [typestyle $argtype $argname] argtype argname
lappend arglist [join [cstyle $argtype $argname] " "]
lappend argnames $argname
if {$argtype == "Tcl_Interp*" && $argname == "interp"} { continue }
set obj [subst {objv\[1 + [llength $loadargs]\]}]
- lappend loadargs [subst {
- [join [cstyle $argtype $argname] " "];
- [arg $argtype $argname $obj]
- }]
+ lappend loadargs [arg {*}[typestyle $argtype $argname] $obj]
}
if {$rtype == "void"} {
set saverv [subst {
diff --git a/lib/trie.tcl b/lib/trie.tcl
index 8a7a5d44..bdc52c76 100644
--- a/lib/trie.tcl
+++ b/lib/trie.tcl
@@ -210,6 +210,6 @@ namespace eval ctrie {
$cc compile
rename remove_ remove
- namespace export create add remove lookup tclify dot
+ namespace export create add addWithVar remove lookup tclify dot
namespace ensemble create
}