1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
# Pragmas for MetaData Scanner.
# n/a
# CriTcl Utility Commands. Generation of functions handling conversion
# from and to a C enum. Not a full Tcl_ObjType. Based on
# Tcl_GetIndexFromObj() instead.
package provide critcl::enum 1.2.1
# # ## ### ##### ######## ############# #####################
## Requirements.
package require Tcl 8.6 9 ; # Min supported version.
package require critcl 3.1.11 ; # make, include -- dict portability
package require critcl::literals 1.1 ; # String pool for conversion to Tcl.
namespace eval ::critcl::enum {}
# # ## ### ##### ######## ############# #####################
## API: Generate the declaration and implementation files for the enum.
proc ::critcl::enum::def {name dict {use tcl}} {
# Arguments are
# - the C name of the enumeration, and
# - dict of strings to convert. Key is the symbolic C name, value
# is the string. Numeric C value is in the order of the strings in
# the dict, treating it as list for that case.
#
# dict: C symbolic name -> Tcl string (Tcl symbolic name).
if {![dict size $dict]} {
return -code error -errorcode {CRITCL ENUM DEF INVALID} \
"Expected an enum definition, got empty string"
}
set plist 0
foreach m $use {
switch $m {
tcl {}
+list { set plist 1 }
default {
return -code error -errorcode {CRITCL ENUM DEF MODE INVALID} \
"Unknown mode $m, expected one of \"+list\", or \"tcl\""
}
}
}
critcl::literals::def ${name}_pool $dict $use
# <name>_pool_names = C enum of symbolic names, and implied numeric values.
# <name>_pool.h = Header
# <name>_pool ( interp, code ) => Tcl_Obj* :: up-conversion C to Tcl.
# Exporting:
# Header <name>.h
# Function <name>_ToObj (interp, code) -> obj
# Function <name>_ToObjList (interp, count, code*) -> obj (**)
# Function <name>_GetFromObj (interp, obj, flags, &code) -> Tcl code
# Enum type <name>_names
#
# (**) Mode +list only.
dict for {sym str} $dict {
lappend table "\t\t\"$str\","
}
lappend map @NAME@ $name
lappend map @TABLE@ \n[join $table \n]
lappend map @TSIZE@ [llength $table]
lappend map @TSIZE1@ [expr {1 + [llength $table]}]
if {$plist} {
lappend map @PLIST@ \
"\n #define ${name}_ToObjList(i,c,l) (${name}_pool_list(i,c,l))"
} else {
lappend map @PLIST@ ""
}
critcl::include [critcl::make ${name}.h \n[critcl::at::here!][string map $map {
#ifndef @NAME@_HEADER
#define @NAME@_HEADER
#include <@NAME@_pool.h>
#include <tcl.h>
typedef @NAME@_pool_names @NAME@;
#define @NAME@_LAST @NAME@_pool_name_LAST
extern int
@NAME@_GetFromObj (Tcl_Interp* interp,
Tcl_Obj* obj,
int flags,
int* literal);
#define @NAME@_ToObj(i,l) (@NAME@_pool(i,l))@PLIST@
#endif
}]]
# Create second function, down-conversion Tcl to C.
critcl::ccode [critcl::at::here!][string map $map {
extern int
@NAME@_GetFromObj (Tcl_Interp* interp,
Tcl_Obj* obj,
int flags,
int* literal )
{
static const char* strings[@TSIZE1@] = {@TABLE@
NULL
};
return Tcl_GetIndexFromObj (interp, obj, strings,
"@NAME@",
flags, literal);
}
}]
# V. Define convenient argument- and result-type definitions
# wrapping the de- and encoder functions for use by cprocs.
critcl::argtype $name \n[critcl::at::here!][string map $map {
if (@NAME@_GetFromObj (interp, @@, TCL_EXACT, &@A) != TCL_OK) return TCL_ERROR;
}] int int
critcl::argtype ${name}-prefix \n[critcl::at::here!][string map $map {
if (@NAME@_GetFromObj (interp, @@, 0, &@A) != TCL_OK) return TCL_ERROR;
}] int int
# Use the underlying literal pool directly.
critcl::resulttype $name = ${name}_pool
return
}
# # ## ### ##### ######## ############# #####################
## Export API
namespace eval ::critcl::enum {
namespace export def
catch { namespace ensemble create }
}
namespace eval ::critcl {
namespace export enum
catch { namespace ensemble create }
}
# # ## ### ##### ######## ############# #####################
## Ready
return
|
