f149dc12
Andreas Rumpf
first somewhat wo...
|
1
|
|
66d70ca8
Andreas Rumpf
squeaknim doesn't...
|
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
|
import macros
# Note: Since we combine -d:useNimRtl with this module, we cannot use strutils.
# So we use our own helper procs here:
proc toUpper(c: char): char =
result = if c in {'a'..'z'}: chr(c.ord - 'a'.ord + 'A'.ord) else: c
proc capitalize(s: string): string {.noSideEffect.} =
result = toUpper(s[0]) & substr(s, 1)
proc invalidFormatString() {.noinline.} =
raise newException(ValueError, "invalid format string")
proc addf(s: var string, formatstr: string, a: varargs[string, `$`]) =
## The same as ``add(s, formatstr % a)``, but more efficient.
const PatternChars = {'a'..'z', 'A'..'Z', '0'..'9', '\128'..'\255', '_'}
var i = 0
var num = 0
while i < len(formatstr):
if formatstr[i] == '$':
case formatstr[i+1] # again we use the fact that strings
# are zero-terminated here
of '#':
if num >% a.high: invalidFormatString()
add s, a[num]
inc i, 2
inc num
of '$':
add s, '$'
inc(i, 2)
of '1'..'9', '-':
var j = 0
inc(i) # skip $
var negative = formatstr[i] == '-'
if negative: inc i
while formatstr[i] in {'0'..'9'}:
j = j * 10 + ord(formatstr[i]) - ord('0')
inc(i)
let idx = if not negative: j-1 else: a.len-j
if idx >% a.high: invalidFormatString()
add s, a[idx]
else:
invalidFormatString()
else:
add s, formatstr[i]
inc(i)
proc `%`(formatstr: string, a: openArray[string]): string =
result = newStringOfCap(formatstr.len + a.len shl 4)
addf(result, formatstr, a)
proc `%`(formatstr, a: string): string =
result = newStringOfCap(formatstr.len + a.len)
addf(result, formatstr, [a])
proc format(formatstr: string, a: varargs[string, `$`]): string =
result = newStringOfCap(formatstr.len + a.len)
addf(result, formatstr, a)
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
61
62
63
64
65
66
67
68
69
70
|
const
pragmaPos = 4
paramPos = 3
intType = when sizeof(int) == 8: "longlong" else: "long"
uintType = when sizeof(int) == 8: "ulonglong" else: "ulong"
var
dllName {.compileTime.}: string = "SqueakNimTest"
stCode {.compileTime.}: string = ""
|
032258fd
Andreas Rumpf
various improvements
|
71
|
gPrefix {.compileTime.}: string = ""
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
72
|
|
032258fd
Andreas Rumpf
various improvements
|
73
|
template setModulename*(s, prefix: string) =
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
74
|
## Sets the DLL name. This is also used to set the 'category' in the generated
|
032258fd
Andreas Rumpf
various improvements
|
75
76
|
## classes. 'prefix' is added to every generated class that wraps a Nim
## object.
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
77
78
|
static:
dllName = s
|
032258fd
Andreas Rumpf
various improvements
|
79
|
gPrefix = prefix
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
80
81
82
|
template writeExternalLibrary*() =
static:
|
53b6fbaa
Andreas Rumpf
make Smalltalk co...
|
83
84
85
86
|
addf(stCode, "ExternalLibrary subclass: #$1\C" &
"\tinstanceVariableNames: ''\C" &
"\tclassVariableNames: ''\C" &
"\tpoolDictionaries: ''\C" &
|
314717f0
Göran Krampe
Fixed proper capi...
|
87
|
"\tcategory: '$2'!\C" &
|
53b6fbaa
Andreas Rumpf
make Smalltalk co...
|
88
|
"!$1 class methodsFor: 'primitives' stamp: 'SqueakNim'!\C",
|
314717f0
Göran Krampe
Fixed proper capi...
|
89
|
gPrefix & capitalize(dllName), capitalize(dllName))
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
90
|
|
e454a5e9
Göran Krampe
SmallTalk changed...
|
91
92
|
template writeSmalltalkCode*(filename: string) =
## You need to invoke this template to write the produced Smalltalk code to
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
93
94
95
96
|
## a file.
static:
writeFile(filename, stCode)
|
0f2cdcd2
Andreas Rumpf
squeaknim can han...
|
97
98
|
proc mapTypeToC(symbolicType: NimNode; isResultType: bool): string {.compileTime.} =
if symbolicType.kind == nnkEmpty and isResultType: return "void"
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
99
100
|
let t = symbolicType.getType
if symbolicType.kind == nnkSym and t.typeKind == ntyObject:
|
032258fd
Andreas Rumpf
various improvements
|
101
|
return gPrefix & $symbolicType
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
102
|
case t.typeKind
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
103
|
of ntyPtr, ntyVar:
|
0f2cdcd2
Andreas Rumpf
squeaknim can han...
|
104
105
|
if t.typeKind == ntyVar and isResultType:
quit "cannot wrap 'var T' as a result type"
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
106
|
expectKind t, nnkBracketExpr
|
0f2cdcd2
Andreas Rumpf
squeaknim can han...
|
107
108
109
110
111
112
|
let base = t[1]
if base.getType.typeKind == ntyArray:
expectKind base, nnkBracketExpr
result = mapTypeToC(base[2], isResultType) & "*"
else:
result = mapTypeToC(base, isResultType) & "*"
|
18d805d8
Andreas Rumpf
squeaknim can dea...
|
113
|
of ntyArray:
|
0f2cdcd2
Andreas Rumpf
squeaknim can han...
|
114
115
|
if isResultType:
quit "cannot wrap array as a result type"
|
18d805d8
Andreas Rumpf
squeaknim can dea...
|
116
|
expectKind t, nnkBracketExpr
|
0f2cdcd2
Andreas Rumpf
squeaknim can han...
|
117
|
result = mapTypeToC(t[2], isResultType) & "*"
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
118
|
of ntyCString: result = "char*"
|
e95712ca
Andreas Rumpf
bugfixes and clea...
|
119
|
of ntyPointer: result = "void*"
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
of ntyInt: result = intType
of ntyInt8: result = "sbyte"
of ntyInt16: result = "short"
of ntyInt32: result = "long"
of ntyInt64: result = "longlong"
of ntyUInt: result = uintType
of ntyUInt8: result = "ubyte"
of ntyUInt16: result = "ushort"
of ntyUInt32: result = "ulong"
of ntyUInt64: result = "ulonglong"
of ntyFloat, ntyFloat64: result = "double"
of ntyFloat32: result = "float"
of ntyBool, ntyChar, ntyEnum: result = "char"
else: quit "Error: cannot wrap to Squeak " & treeRepr(t)
|
e95712ca
Andreas Rumpf
bugfixes and clea...
|
135
|
macro exportSt*(body: stmt): stmt =
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
136
137
138
139
140
141
142
143
|
# generates something like:
# system: aString
#"Some kind of comment"
#
# <apicall: long 'system' (char*) module: 'libSystem.dylib'>
# ^self externalCallFailed.
result = body
|
bde894cf
Andreas Rumpf
solve the name ma...
|
144
|
result[pragmaPos].add(ident"exportc", ident"dynlib", ident"cdecl")
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
145
146
147
148
149
150
151
152
153
154
155
156
|
let params = result[paramPos]
let procName = $result[0]
var st = procName
#echo treeRepr params
if params.len > 1:
expectKind params[1], nnkIdentDefs
let ident = $params[1][0]
if ident.len > 1:
st.add(ident.capitalize & ": " & ident)
else:
st.add(": " & ident)
# return type:
|
0f2cdcd2
Andreas Rumpf
squeaknim can han...
|
157
|
var apicall = "<cdecl: " & mapTypeToC(params[0], true) & " '" &
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
158
159
160
161
162
163
164
165
166
167
168
169
|
procName & "' ("
var counter = 0
# parameter types:
for i in 1.. <params.len:
let param = params[i]
let L = param.len
for j in 0 .. param.len-3:
let name = param[j]
let typ = param[L-2]
if counter > 0:
apicall.add(" ")
st.addf(" $1: $1", name)
|
0f2cdcd2
Andreas Rumpf
squeaknim can han...
|
170
|
apicall.add(mapTypeToC(typ, false))
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
171
|
inc counter
|
53b6fbaa
Andreas Rumpf
make Smalltalk co...
|
172
173
174
|
apicall.add(") module: '" & dllName & "'>\C" &
"\t^self externalCallFailed\C!\C\C")
stCode.add(st & "\C\t\"Generated by NimSqueak\"\C\t" & apicall)
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
175
|
|
92457a15
Andreas Rumpf
don't wrap object...
|
176
|
macro wrapObject*(typ: stmt; wrapFields=false): stmt =
|
e454a5e9
Göran Krampe
SmallTalk changed...
|
177
|
## Declares a Smalltalk wrapper class.
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
178
179
180
181
|
var t = typ.getType()
if t.typeKind == ntyTypeDesc:
expectKind t, nnkBracketExpr
t = t[1]
|
032258fd
Andreas Rumpf
various improvements
|
182
183
|
expectKind t, nnkSym
let name = gPrefix & ($t).capitalize
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
184
185
186
187
188
|
if t.kind != nnkObjectTy: t = t.getType
expectKind t, nnkObjectTy
t = t[1]
expectKind t, nnkRecList
var fields = ""
|
92457a15
Andreas Rumpf
don't wrap object...
|
189
190
191
|
if $wrapFields == "true":
for i in 0.. < t.len:
expectKind t[i], nnkSym
|
0f2cdcd2
Andreas Rumpf
squeaknim can han...
|
192
|
fields.addf "\t\t($# '$#')\C", $t[i], mapTypeToC(t[i], false)
|
53b6fbaa
Andreas Rumpf
make Smalltalk co...
|
193
194
195
196
197
198
199
200
201
202
203
204
205
|
let st = ("ExternalStructure subclass: #$1\C" &
"\tinstanceVariableNames: ''\C" &
"\tclassVariableNames: ''\C" &
"\tpoolDictionaries: 'FFIConstants'\C" &
"\tcategory: '$2'!\C\C" &
"$1 class\C" &
"\tinstanceVariableNames: ''!\C\C" &
"!$1 class methodsFor: 'field definition' stamp: 'SqueakNim'!\C" &
"\tfields\C" &
"\t^#(\C" &
"$3\C" &
"\t)! !\C" &
|
314717f0
Göran Krampe
Fixed proper capi...
|
206
|
"$1 defineFields.\C!\C\C") % [name, capitalize(dllName), fields]
|
f149dc12
Andreas Rumpf
first somewhat wo...
|
207
208
|
stCode.add(st)
result = newStmtList()
|