My goal is to iterate a list to find out what my values correspond and add the type in another list. To do this, I proceed as follows in Tcl.
proc TCL_dataType {dataList} {
set Tag {}
foreach value $dataList {
if {[string is double -strict $value]} {
lappend Tag "N"
} elseif {$value eq "null"} {
lappend Tag "_"
} else {
lappend Tag "S"
}
}
return $Tag
}
On the C side I tried to do the same thing :
int C_dataType (Tcl_Interp* interp Tcl_Obj* data) {
Tcl_Obj **dataList;
int count;
double d;
if (Tcl_ListObjGetElements(interp, data, &count, &dataList) != TCL_OK) {
return TCL_ERROR;
}
Tcl_Obj *Tag = Tcl_NewListObj (0,NULL);
Tcl_Obj* s = Tcl_NewStringObj("S", 1);
Tcl_Obj* n = Tcl_NewStringObj("N", 1);
Tcl_Obj* null = Tcl_NewStringObj("_", 1);
for (int i = 0; i < count; ++i) {
if (Tcl_GetDoubleFromObj(interp, dataList[i], &d) == TCL_OK) {
Tcl_ListObjAppendElement(interp, Tag, n);
} else if (!strcmp(Tcl_GetString(dataList[i]), "null")) {
Tcl_ListObjAppendElement(interp, Tag, null);
} else {
Tcl_ListObjAppendElement(interp, Tag, s);
}
}
Tcl_SetObjResult(interp, Tag);
return TCL_OK;
}
My approach may not be correct on the C side, but if I measure execution time, I'm 5x slower with my C code.
proc randomValues {len} {
set l {10 null foo bar}
set randomList {}
for {set i 0} {$i < $len} {incr i} {
set index [expr {int(rand() * 4)}]
lappend randomList [lindex $l $index]
}
return $randomList
}
set myRandomList [randomValues 10000]
# time measure
puts [time {C_dataType $myRandomList} 10] ; # 4921.3521 microseconds per iteration
puts [time {TCL_dataType $myRandomList} 10] ; # 986.0601 microseconds per iteration
'Tcl_GetDoubleFromObj' seems to cost me time, so I did a test by removing this C function and also 'string is double -strict xxx' from my Tcl procedure to compare the same thing, and here it's the opposite.
Maybe on the C side, I'm expected to know the types of my variables... But I don't see how I can control every Tcl objects without using this function.
Try passing NULL for interp to Tcl_GetDoubleFromObj. I suspect that the time is being spent setting up an error result which will never be used.
Also there is a risk of the Tcl_Objs in s, n and null leaking if none of those types of tags are added to the result list. Tcl_NewStringObj creates them with zero refCount, but nothing changes them after that if they never make it into the Tag list. I've made it a rule to always properly take a reference if I have a pointer to a Tcl_Obj, using a helper like:
static inline void replace_tclobj(Tcl_Obj** target, Tcl_Obj* replacement)
{
Tcl_Obj* old = *target;
*target = replacement;
if (*target) Tcl_IncrRefCount(*target);
if (old) {
Tcl_DecrRefCount(old);
old = NULL;
}
}
int C_dataType (Tcl_Interp* interp Tcl_Obj* data) {
int code = TCL_OK;
Tcl_Obj **dataList;
int count;
double d;
Tcl_Obj *Tag = NULL;
Tcl_Obj* s = NULL;
Tcl_Obj* n = NULL;
Tcl_Obj* null = NULL;
if ((code = Tcl_ListObjGetElements(interp, data, &count, &dataList)) != TCL_OK) {
goto finally;
}
replace_tclobj(&Tag, Tcl_NewListObj(count, NULL));
replace_tclobj(&s, Tcl_NewStringObj("S", 1));
replace_tclobj(&n, Tcl_NewStringObj("N", 1));
replace_tclobj(&null, Tcl_NewStringObj("_", 1));
for (int i = 0; i < count; ++i) {
if (Tcl_GetDoubleFromObj(NULL, dataList[i], &d) == TCL_OK) {
Tcl_ListObjAppendElement(interp, Tag, n);
} else if (!strcmp(Tcl_GetString(dataList[i]), "null")) {
Tcl_ListObjAppendElement(interp, Tag, null);
} else {
Tcl_ListObjAppendElement(interp, Tag, s);
}
}
Tcl_SetObjResult(interp, Tag);
finally:
replace_tclobj(&Tag, NULL);
replace_tclobj(&s, NULL);
replace_tclobj(&n, NULL);
replace_tclobj(&null, NULL);
return code;
}
I've found that this pattern has helped a lot to avoid memory leaks (particularly on error paths), and generally reduced the cognitive load around handling reference counts.
It's also possible to pass the known size of the result list to Tcl_NewListObj even if elements aren't known yet, which will allow it to allocate the correct size of storage to begin with rather than growing it incrementally (although I suspect that the difference in performance will probably not be measurable).
(later edit): Ok, so I got curious about whether it would be quicker to do this with regexps on the string reps. It definitely is for the data benchmarked in the question, but that is a bit unrealistic: all numbers will point to a single shared "10" Tcl_Obj, which will immediately convert to a double objtype (advantage for C_dataType), and is also a short string (advantage for re_dataType). So I tweaked this benchmark to generate a different random number for each N element, and covered more of the syntax space for number literals (and lengths). In doing this I noticed that the C_dataType and TCL_dataType implementations disagree on the classification of the string "NaN" - string is double -strict says yes, C_dataType's Tcl_GetDoubleFromObj says no. The new re2c-based implementation agrees with the Tcl implementation.
package require jitc
proc TCL_dataType {dataList} {
set Tag {}
foreach value $dataList {
if {[string is double -strict $value]} {
lappend Tag "N"
} elseif {$value eq "null"} {
lappend Tag "_"
} else {
lappend Tag "S"
}
}
return $Tag
}
set cdef {
options {-Wall -Werror -g}
filter {jitc::re2c -W --case-ranges --no-debug-info}
code {
#include <string.h>
enum {
L_S,
L_N,
L__,
L_size
};
static const char* static_strs[L_size] = {
"S",
"N",
"_"
};
Tcl_Obj* lit[L_size];
const Tcl_ObjType* objtype_int = NULL;
const Tcl_ObjType* objtype_double = NULL;
INIT {
for (int i=0; i<L_size; i++) replace_tclobj(&lit[i], Tcl_NewStringObj(static_strs[i], -1));
objtype_int = Tcl_GetObjType("int");
objtype_double = Tcl_GetObjType("double");
return TCL_OK;
}
RELEASE {
for (int i=0; i<L_size; i++) replace_tclobj(&lit[i], NULL);
}
OBJCMD(C_dataType)
{
int code = TCL_OK;
enum {A_cmd, A_DATA, A_objc};
CHECK_ARGS_LABEL(finally, code, "data");
Tcl_Obj **dataList;
int count;
double d;
Tcl_Obj* Tag = NULL;
TEST_OK_LABEL(finally, code, Tcl_ListObjGetElements(interp, objv[A_DATA], &count, &dataList));
replace_tclobj(&Tag, Tcl_NewListObj(count, NULL));
for (int i = 0; i < count; ++i) {
if (Tcl_GetDoubleFromObj(NULL, dataList[i], &d) == TCL_OK) {
Tcl_ListObjAppendElement(interp, Tag, lit[L_N]);
} else if (!strcmp(Tcl_GetString(dataList[i]), "null")) {
Tcl_ListObjAppendElement(interp, Tag, lit[L__]);
} else {
Tcl_ListObjAppendElement(interp, Tag, lit[L_S]);
}
}
Tcl_SetObjResult(interp, Tag);
finally:
replace_tclobj(&Tag, NULL);
return code;
}
OBJCMD(re_dataType) {
int code = TCL_OK;
Tcl_Obj* Tag = NULL;
Tcl_Obj** dataList;
int count;
enum {A_cmd, A_DATA, A_objc};
CHECK_ARGS_LABEL(finally, code, "data");
TEST_OK_LABEL(finally, code, Tcl_ListObjGetElements(interp, objv[A_DATA], &count, &dataList));
replace_tclobj(&Tag, Tcl_NewListObj(count, NULL));
for (int i=0; i<count; i++) {
/* Snoop on the objtype: if it's one of the number types we know about,
* then just add it directly */
if (
Tcl_FetchInternalRep(dataList[i], objtype_int) != NULL ||
Tcl_FetchInternalRep(dataList[i], objtype_double) != NULL
) {
Tcl_ListObjAppendElement(interp, Tag, lit[L_N]);
continue;
}
const char* YYCURSOR = Tcl_GetString(dataList[i]);
const char* YYMARKER;
/*!re2c
re2c:define:YYCTYPE = char;
re2c:yyfill:enable = 0;
end = [\x00];
null = "null";
digit = [0-9];
digit1 = [1-9];
hexdigit = [0-9A-Fa-f];
octdigit = [0-7];
bindigit = [01];
sign = [-+];
inf = 'Inf' 'inity'?;
nan = 'NaN';
hexnum = '0x' hexdigit+;
octnum = '0' 'o'? octdigit+;
binnum = '0b' bindigit+;
decnum = digit1 digit* | "0";
realnum
= digit+ ("." digit*)? ('e' sign? digit+)?
| "." digit+ ('e' sign? digit+)?;
number = sign? (decnum | hexnum | octnum | binnum | realnum | inf | nan);
number end { Tcl_ListObjAppendElement(interp, Tag, lit[L_N]); continue; }
null end { Tcl_ListObjAppendElement(interp, Tag, lit[L__]); continue; }
* { Tcl_ListObjAppendElement(interp, Tag, lit[L_S]); continue; }
*/
}
Tcl_SetObjResult(interp, Tag);
finally:
replace_tclobj(&Tag, NULL);
return code;
}
}
}
jitc::bind C_dataType $cdef C_dataType
jitc::bind re_dataType $cdef re_dataType
proc randomValues {len} {
set l {N null foo bar}
#set l {10 null foo bar}
set randomList {}
for {set i 0} {$i < $len} {incr i} {
set index [expr {int(rand() * 4)}]
set v [lindex $l $index]
if {$v eq "N"} {
# Contrive to have the value be a pure number objtype some of the time
set v [switch [expr {int(rand() * 9)}] {
0 {expr {int(rand() * 1000)}}
1 {expr {rand() * 1000.0}}
2 {format %se%s [expr {rand() * 10.0}] [expr {int(rand() * 10)}]}
3 {return -level 0 NaN}
4 {return -level 0 Inf}
5 {return -level 0 Infinity}
6 {format 0x%x [expr {int(rand() * 0x100000000)}]}
7 {format 0b%b [expr {int(rand() * 0x10000)}]}
8 {format 0%o [expr {int(rand() * 0x10000)}]}
}]
}
lappend randomList $v
}
return $randomList
}
set myRandomList [randomValues 10000]
puts "TCL_dataType: [timerate {TCL_dataType $myRandomList} 1 1]" ; # 787 µs/#
puts "re_dataType: [timerate {re_dataType $myRandomList} 1 1]" ; # 142 µs/#
puts "C_dataType: [timerate {C_dataType $myRandomList} 1 1]" ; # 186 µs/#
The re_dataType implementation is benchmarked before the C_dataType one to avoid all of the N types being converted to native numeric objtypes, which would then fail to exercise the number parsing paths of re_dataType.
The number of iterations for the benchmarks are capped at 1 to prevent subsequent iterations from unfairly benefiting from all the numbers having been converted to double objtypes.
Since this shows that it's possible to classify the elements of the list using regex faster than the reference C implementation, it might be possible to get close with a Tcl implementation like: lmap e $dataList {switch -regex $e {...}} but translating the regex from re2c syntax to what can be processed by the switch -regex cases is where it stops sounding like fun to me.