Coverage report: /development/source/library/com/dydra/gitlab/dydra-cgi/ffi/lisp/rdfcache/prelude.lisp

Kind	Covered	All	%
expression	49	196	25.0
branch	1	6	16.7

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

(in-package :rdfcache)

2

3

(defmacro string->keyword (string)

4

`(values (intern (string-upcase ,string) "KEYWORD")))

5

6

(defmacro keyword->string (keyword)

7

"Returns the lowercase string corresponding to the given KEYWORD."

8

`(write-to-string ,keyword :case :downcase :escape nil))

9

10

(defmacro all-integers? (&body terms)

11

`(and ,@(mapcar (lambda (term) `(integerp ,term)) terms)))

12

13

(defmacro any-integers? (&body terms)

14

`(or ,@(mapcar (lambda (term) `(integerp ,term)) terms)))

15

16

(defmacro all-nulls? (&body terms)

17

`(and ,@(mapcar (lambda (term) `(null ,term)) terms)))

18

19

(defmacro any-nulls? (&body terms)

20

`(or ,@(mapcar (lambda (term) `(null ,term)) terms)))

21

22

(defmacro any-ephemerals? (&body terms)

23

`(or ,@(mapcar (lambda (term) `(< ,term -2)) terms)))

24

25

(defmacro with-checked-pointer ((ptr) &rest body)

26

(let* ((ptr-var (gensym))

27

(body (or body (list ptr-var))))

28

`(let ((,ptr-var ,ptr))

29

(declare (type foreign-pointer ,ptr-var))

30

(if (null-pointer-p ,ptr-var)

31

(cl:error "~A is a null pointer." ,ptr-var)

32

(progn ,@body)))))

33

34

(defmacro with-checked-pointers ((&rest ptrs) &rest body)

35

(let ((result `(progn ,@body)))

36

(dolist (ptr (reverse ptrs))

37

(setf result `(with-checked-pointer (,ptr) ,result)))

38

result))

39

40

(defmacro with-checked-errno-result (cfun-name &rest body)

41

(let ((errno-var (gensym)))

42

`(let ((,errno-var (abs (progn ,@body))))

43

(declare (type integer ,errno-var))

44

(if (zerop ,errno-var)

45

(values) ;; no meaningful return value

46

(foreign-function-error ,errno-var ,cfun-name)))))

47

48

(defmacro with-checked-ssize-result (cfun-name &rest body)

49

(let ((ssize-var (gensym))

50

(errno-var (gensym)))

51

`(let ((,ssize-var (progn ,@body)))

52

(declare (type integer ,ssize-var))

53

(if (>= ,ssize-var 0)

54

,ssize-var

55

(let ((,errno-var (abs ,ssize-var)))

56

(declare (type integer ,errno-var))

57

(foreign-function-error ,errno-var ,cfun-name))))))

58

59

(defmacro with-checked-int-result (cfun-name &rest body)

60

`(with-checked-ssize-result ,cfun-name ,@body))

61

62

(defmacro with-checked-long-result (cfun-name &rest body)

63

`(with-checked-ssize-result ,cfun-name ,@body))

64

65

(defmacro with-checked-bool-result (cfun-name &rest body)

66

`(with-checked-ssize-result ,cfun-name ,@body))

67

68

(defmacro with-checked-pointer-result (cfun-name &rest body)

69

`(progn ,@body)) ;; TODO

70

71

(defun count-wildcards (&rest term-numbers)

72

(count-if #'zerop term-numbers))

73

(in-package :rdfcache)

74

75

(defcenum (struct-type :int)

76

   (:none 0) :id :term :triple :quad :graph :index :revision :unused1 :unused2 :cursor :transaction :term-cursor)

77

78

;;; Types

79

80

(defctype size_t :uint)

81

(defctype ssize_t :int)

82

(defctype off_t :int) ; FIXME: this varies based on a number of considerations

83

(defctype wchar_t :int)

84

85

(defcvar ("errno" %errno :read-only t) :int)

86

87

(declaim (inline %%memcpy))

88

(defcfun ("memcpy" %%memcpy) :pointer (dst :pointer) (src :pointer) (len size_t))

89

90

(declaim (inline %%strerror))

91

(defcfun ("strerror" %%strerror) :pointer (errnum :int))

92

93

(defun %strerror (errnum)

94

(declare (type integer errnum))

95

(foreign-string-to-lisp (%%strerror errnum)))

96

97

;;; UUIDs

98

99

(defcstruct uuid

100

(data :uint8 :count 16))

101

102

(defcstruct uuid-string

103

(data :char :count 37))

104

105

;;; libdgrdf terms

106

107

(defcenum (term-type :int)

108

(:none 0) (:uri 1) (:node 2) (:literal 5) (:default-context 255)) ;; defined in libdgrdf

109

110

(defcstruct term

111

(type term-type)

112

(value :pointer)

113

(language :pointer)

114

(datatype :pointer))

115

116

;;; libdgrdf triples

117

118

(defcstruct triple

119

(subject :pointer)

120

(predicate :pointer)

121

(object :pointer))

122

123

;;; libdgrdf quads

124

125

(defcstruct quad

126

(subject :pointer)

127

(predicate :pointer)

128

(object :pointer)

129

(context :pointer))

130

131

;;; Cursors

132

133

(defctype term-number :int64)

134

135

(defcstruct term-numbers

136

(subject-number :int32)

137

(predicate-number :int32)

138

(object-number :int32)

139

(context-number :int32))

140

141

(defcstruct cursor

142

;; first cache line:

143

(flags :uint64)

144

(options :uint32)

145

(padding :uint32)

146

(position :uint64)

147

(count :uint64)

148

(term-numbers :pointer)

149

(segment :pointer)

150

(padding2 :uint64)

151

(padding3 :uint64)

152

;; second cache line:

153

(subject term)

154

(predicate term)

155

;; third cache line:

156

(object term)

157

(context term)

158

;; fourth cache line:

159

(quad quad))

160

161

(defcenum (term-position :int)

162

(:any -1) ;; RDF_TERM_ANY

163

(:subject 0) ;; RDF_TERM_SUBJECT

164

(:predicate 1) ;; RDF_TERM_PREDICATE

165

(:object 2) ;; RDF_TERM_OBJECT

166

(:context 3)) ;; RDF_TERM_CONTEXT

167

168

(defcenum (term-cursor-position :int)

169

(:any -1)

170

(:context 0)

171

(:subject 1)

172

(:predicate 2)

173

(:object 3))

174

175

;;; Term Cursors

176

177

(defcstruct term-cursor

178

(unused-was-flags :int)

179

(term-position term-cursor-position)

180

(term-number term-number)

181

(unused-was-term-count :uint64)

182

(opaque-ptr :pointer)

183

(padding :uint8 :count 48))

184

185

;;; Transactions

186

187

(defcenum (transaction-status :int)

188

(:uninitialized 0)

189

(:initialized 1)

190

(:begun 2)

191

(:mutated 3)

192

(:committed 4)

193

(:aborted 5))

194

195

(defcstruct transaction

196

(status transaction-status)

197

(uuid uuid)

198

(repository-name :string)

199

(parent-revision-uuid uuid)

200

(delete-count :uint32)

201

(insert-count :uint32)

202

(context-map :pointer)

203

(term-lock :pointer)

204

(term-count :uint32)

205

(term-data :pointer))

206

207

;;; Callbacks

208

209

(defcallback string-callback :boolean ((argument :string))

210

(funcall (symbol-value '*current-callback*) argument))

211

(in-package :rdfcache)

212

213

;; src/rdfcache/cursor.c

214

215

 (defcfunwi ("rdfcache_ffi_fetch_term" %%cursor-fetch-term) :int (term-number term-number) (term-pointer :pointer))

216

217

(defcfun ("spocq_thread_init" %%thread-init) :void)

218

(defcfun ("spocq_thread_exit" %%thread-exit) :void)

219

220

;; src/rdfcache/features.c

221

222

(defcfun ("spocq_feature_exists" %%has-feature) :boolean (feature-name :string))

223

(defcfun ("spocq_module_exists" %%has-module) :boolean (module-name :string))

224

225

(defcfun ("spocq_feature_enumerate" %%each-feature) :void (callback :pointer))

226

(defcfun ("spocq_module_enumerate" %%each-module) :void (callback :pointer))

227

228

;; src/rdfcache/ffi.c

229

230

(defcfun ("spocq_thread_boost" boost) :void (priority :int))

231

(defcfun ("spocq_thread_yield" yield) :void)

232

233

(defcfun ("rdfcache_ffi_lookup_term_number" %%lookup-term-number) :long (term-pointer :pointer))

234

235

 (defcfun ("rdfcache_ffi_count" %%count) :long (revision uuid) (c term-number) (s term-number) (p term-number) (o term-number))

236

 (defcfun ("rdfcache_ffi_match" %%match) :long (revision uuid) (c term-number) (s term-number) (p term-number) (o term-number) (cursor cursor))

237

 (defcfun ("rdfcache_ffi_match_with_filter" %%match-with-filter) :long (revision uuid) (c term-number) (s term-number) (p term-number) (o term-number) (min term-number) (max term-number) (cursor cursor))

238

239

 (defcfunwi ("rdfcache_ffi_intern_term" %%intern-term) :int64 (type term-type) (value :string) (language :string) (datatype :string))

240

241

(defcfunwi ("rdfcache_ffi_generate_node" generate-node) :long)

242

243

;; src/rdfcache/repository.c

244

245

 (defcfun ("spocq_repository_revision" %%repository-revision) :string (repository-name :string) (revision-designator :string) (flags :uint))

246

247

;; src/rdfcache/shard.c

248

249

(defcfun ("dydra_storage_attach" %%attach) :void)

250

(defcfun ("dydra_storage_detach" %%detach) :void)

251

252

;; src/rdfcache/sparql_query.c

253

254

(declaim (inline %%sparql-same-term))

255

 (defcfun ("spocq_sparql_same_term" %%sparql-same-term) :boolean (term1-number term-number) (term2-number term-number))

256

257

(declaim (inline %%sparql-equal))

258

(defcfun ("spocq_sparql_equal" %%sparql-equal) :int (term1-number term-number) (term2-number term-number))

259

260

(declaim (inline %%sparql-is-uri))

261

(defcfun ("spocq_sparql_is_uri" %%sparql-is-uri) :boolean (term-number term-number))

262

263

(declaim (inline %%sparql-is-blank))

264

(defcfun ("spocq_sparql_is_blank" %%sparql-is-blank) :boolean (term-number term-number))

265

266

(declaim (inline %%sparql-is-literal))

267

(defcfun ("spocq_sparql_is_literal" %%sparql-is-literal) :boolean (term-number term-number))

268

269

(declaim (inline %%sparql-is-numeric))

270

(defcfun ("spocq_sparql_is_numeric" %%sparql-is-numeric) :boolean (term-number term-number))

271

272

(declaim (inline %%sparql-strlen))

273

(defcfunwi ("spocq_sparql_strlen" %%sparql-strlen) :long (term-number term-number))

274

275

;; src/rdfcache/sparql_update.c

276

277

 (defcfun ("spocq_sparql_add" %%sparql-add) :int (transaction :pointer) (graph1-uri :string) (graph2-uri :string) (silent :boolean))

278

 (defcfun ("spocq_sparql_clear" %%sparql-clear) :int (transaction :pointer) (graph-uri :string) (silent :boolean))

279

 (defcfun ("spocq_sparql_copy" %%sparql-copy) :int (transaction :pointer) (graph1-uri :string) (graph2-uri :string) (silent :boolean))

280

 (defcfun ("spocq_sparql_create" %%sparql-create) :int (transaction :pointer) (graph-uri :string) (silent :boolean))

281

 (defcfun ("spocq_sparql_drop" %%sparql-drop) :int (transaction :pointer) (graph-uri :string) (silent :boolean))

282

 (defcfun ("spocq_sparql_load" %%sparql-load) :int (transaction :pointer) (graph-uri :string) (from-url :string) (silent :boolean))

283

 (defcfun ("spocq_sparql_move" %%sparql-move) :int (transaction :pointer) (graph1-uri :string) (graph2-uri :string) (silent :boolean))

284

285

;; src/rdfcache/term_cursor.c

286

287

(defcfun ("rdfcache_term_cursor_alloc" %%term-cursor-alloc) :pointer)

288

(defcfun ("rdfcache_term_cursor_free" %%term-cursor-free) :void (cursor-pointer :pointer))

289

 (defcfun ("rdfcache_term_cursor_init" %%term-cursor-init) :int (cursor-pointer :pointer) (flags :int) (term-position term-cursor-position))

290

(defcfun ("rdfcache_term_cursor_dispose" %%term-cursor-dispose) :int (cursor-pointer :pointer))

291

 (defcfun ("rdfcache_term_cursor_open" %%term-cursor-open) :int (cursor-pointer :pointer) (transaction-uuid-pointer uuid) (context-no term-number))

292

(defcfun ("rdfcache_term_cursor_count" %%term-cursor-count) :long (cursor-pointer :pointer))

293

(defcfun ("rdfcache_term_cursor_next" %%term-cursor-next) term-number (cursor-pointer :pointer))

294

(defcfun ("rdfcache_term_cursor_skip" %%term-cursor-skip) :long (cursor-pointer :pointer) (count :ulong))

295

(defcfun ("rdfcache_term_cursor_close" %%term-cursor-close) :int (cursor-pointer :pointer))

296

297

;; src/rdfcache/transaction.c

298

299

(defcvar ("rdfcache_transaction" *current-transaction*) :pointer)

300

301

 (defcfunwi ("rdfcache_transaction_clone" %%transaction-clone) :pointer (transaction-pointer :pointer) (uuid-pointer :pointer))

302

303

 (defcfunwi ("rdfcache_transaction_init2" %%transaction-init) :int (transaction-pointer :pointer) (uuid-pointer :pointer) (repository-name :string) (revision-id :string) (flags :uint))

304

(defcfunwi ("rdfcache_transaction_dispose" %%transaction-dispose) :int (transaction-pointer :pointer))

305

306

(defcfunwi ("rdfcache_transaction_begin" %%transaction-begin) :int (transaction-pointer :pointer))

307

(defcfunwi ("rdfcache_transaction_abort" %%transaction-abort) :int (transaction-pointer :pointer))

308

(defcfunwi ("rdfcache_transaction_commit" %%transaction-commit) :int (transaction-pointer :pointer))

309

310

 (defcfunwi ("rdfcache_transaction_insert_fast" %%transaction-insert) :int (transaction-pointer :pointer) (c term-number) (s term-number) (p term-number) (o term-number))

311

 (defcfunwi ("rdfcache_transaction_delete_fast" %%transaction-delete) :int (transaction-pointer :pointer) (c term-number) (s term-number) (p term-number) (o term-number))

312

313

 (defcfunwi ("rdfcache_transaction_fetch_term" %%transaction-fetch-term) :int (transaction-pointer :pointer) (term-number :int64) (term-pointer :pointer))

314

 (defcfunwi ("rdfcache_transaction_lookup_term" %%transaction-lookup-term) :int64 (transaction-pointer :pointer) (type term-type) (value :string) (language :string) (datatype :string))

315

 (defcfunwi ("rdfcache_transaction_intern_term" %%transaction-intern-term) :int64 (transaction-pointer :pointer) (type term-type) (value :string) (language :string) (datatype :string))

316

317

(defcfun ("rdfcache_transaction_debug" %%transaction-debug) :void (transaction-pointer :pointer))

318

319

;; src/rdfcache/uuid.c

320

321

(cffi:defcfun ("spocq_uuid_init" %%uuid-init) :int (uuid-pointer :pointer))

322

(cffi:defcfun ("spocq_uuid_is_null" %%uuid-empty) :int (uuid-pointer :pointer))

323

(cffi:defcfun ("spocq_uuid_generate" %%uuid-generate) :int (uuid-pointer :pointer))

324

 (cffi:defcfun ("spocq_uuid_serialize" %%uuid-serialize) :int (uuid-pointer :pointer) (buffer-pointer :pointer) (buffer-size size_t))

325

(cffi:defcfun ("spocq_uuid_parse" %%uuid-parse) :int (uuid-pointer :pointer) (uuid-string :string))

326

327

;; src/rdfcache/utility.c

328

329

(cffi:defcfun ("spocq_thread_time" time-in-thread) :uint64)

330

331

(defcvar ("rdfcache_default_context" %default-context-pointer :read-only t) term)

332

333

;(defcvar ("rdfcache_default_context_id" %default-context-id :read-only t) id)

334

335

;;; UUID API: Accessors

336

337

(defun uuid-to-string (uuid-pointer)

338

(declare (type foreign-pointer uuid-pointer))

339

(with-foreign-object (uuid-string '(:struct uuid-string))

340

(with-checked-ssize-result "spocq_uuid_serialize"

341

(%%uuid-serialize uuid-pointer uuid-string 37))

342

(foreign-string-to-lisp uuid-string)))

343

344

;;; UUID API: Macros

345

346

(defmacro with-uuid ((uuid-var) &body body)

347

`(with-foreign-object (,uuid-var '(:struct uuid))

348

(progn ,@body)))

349

350

;;; UUID API: Debugging

351

352

(defun print-uuid (uuid-pointer &optional (stream *standard-output*))

353

(print-unreadable-object (uuid-pointer stream :identity nil :type nil)

354

(format stream "rdfcache:uuid ~8,'0x: ~s"

355

(pointer-address uuid-pointer)

356

(uuid-to-string uuid-pointer))))

357

358

;; Repository API

359

360

(defun resolve-repository (repository-name &key revision)

361

(declare (type string repository-name)

362

(type (or string null) revision))

363

;; !! do not change this logic until and unless _all_ store installations do not require it.

364

(when (stringp revision)

365

(if (string-equal "head" revision)

366

;; head must be upcase, but for the revision id

367

(setf revision (string-upcase revision))

368

;; 2017-10-05 an uppercase string crashed the store

369

(setf revision (string-downcase revision))))

370

(%%repository-revision repository-name (or revision "") 0))

371

372

;; Triple API

373

374

(defun make-triple (subject predicate object &key id)

375

"Returns a foreign pointer to a newly-allocated triple."

376

(let ((triple (%make-triple (or subject (null-pointer))

377

(or predicate (null-pointer))

378

(or object (null-pointer)))))

379

;; TODO: set the triple identifier, if given.

380

id

381

triple))