Coverage report: /development/source/library/org/datagraph/spocq-shard/src/algebra/operators/construct.lisp

Kind	Covered	All	%
expression	187	226	82.7
branch	7	14	50.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-

2

3

(in-package :org.datagraph.spocq.implementation)

4

5

 (:documentation "This file defines the construct query form operator for the 'org.datagraph.spocq' RDF engine."

6

7

(copyright

8

9

10

(:long-description

11

   "The construct query form uses the result of the base query to generates a statement graph (an s-p-o field)

12

for each solution set.

13

nb. the solution modifiers must be handled outside as a slice on the argument solution field.

14

15

See core;processing.lisp.

16

"))

17

18

19

(defmacro spocq.a:|construct| (solution-field graph-pattern)

20

"( ( solutionField pattern ) RDFSolutionField )

21

A CONSTRUCT form applies the given graph-pattern template to each solution of the

22

given solution-field to produce a field which denotes the projected RDF graph."

23

24

(macroexpand-construct solution-field graph-pattern))

25

26

27

(defun macroexpand-construct (solution-field graph-pattern)

28

(let ((variables (expression-variables graph-pattern))

29

(blank-nodes (expression-blank-nodes graph-pattern)))

30

;;;? could check that all variables in the pattern are present in the solution field

31

(setf variables (set-difference variables blank-nodes))

32

(setf (variable-opacity variables) :transparent)

33

`(spocq.e:construct (spocq.e::with-join-scope ,(gensym "construct-")

34

(spocq.e::with-reference-dimensions ,variables ,solution-field))

35

',graph-pattern)))

36

 ;;; (macroexpand '(spocq.a:|construct| (spocq.a:|bgp| (spocq.a:|triple| ?::s ?::p ?::ox)) ((spocq.a:|triple| ?::s ?::p ?::o))))

37

38

(defgeneric spocq.e:construct (solution-field pattern)

39

(:documentation "Transform each solution into a sequence of triples according to the

40

given contructor. If a continuation is provided, pass each triple sequence to it in turn.

41

Otherwise return a list of sequences.

42

43

The cnstrict itself includes no modfiies as they must have been pushed down into the form for

44

the constituent field.")

45

46

(:method :before ((base-source t) pattern)

47

(incf-stat *algebra-operations*)

48

(trace-algebra spocq.e:project base-source pattern))

49

50

(:method ((solution-field solution-generator) pattern)

51

(spocq.e:stream-construct solution-field pattern)))

52

53

54

(defun spocq.e:stream-construct (field-generator pattern)

55

(let ((result-channel (make-channel :name (cons 'spocq.a:|construct| (task-id *query*))

56

                                       ;; need to examine the pattern to see if graphs are present

57

                                       ;; if so, use quad rather than triple dimensions

58

;; :dimensions *construct-dimensions*

59

                                       :dimensions (if (find 'spocq.a:|quad| pattern :key #'first)

60

                                                     (append *construct-dimensions* '(?::|g|))

61

                                                     *construct-dimensions*))))

62

(make-construct-generator :expression (list #'run-construct-thread result-channel field-generator

63

pattern)

64

:channel result-channel

65

:constituents (list field-generator))))

66

67

(defun run-construct-thread (result-channel field-generator pattern)

68

(let* ((base-dimensions (solution-generator-dimensions field-generator))

69

(base-channel (solution-generator-channel field-generator))

70

(base-expression (solution-generator-expression field-generator))

71

(*thread-operations* (cons (list 'spocq.a:|construct| base-dimensions)

72

*thread-operations*)))

73

(push 'spocq.a:|construct| (channel-name base-channel))

74

(query-run-in-thread *query* base-expression)

75

(setf (channel-size result-channel) (channel-size base-channel)

76

(channel-page-length result-channel) (channel-page-length base-channel))

77

(process-construct result-channel base-channel

78

base-dimensions

79

pattern)

80

'spocq.a:|construct|))

81

82

(defun funcall-constructor (constructor collector base-page base-index)

83

(funcall constructor collector base-page base-index))

84

85

(defmethod process-construct ((destination array-page-channel)

86

(base-source array-page-channel)

87

base-dimensions graph-pattern)

88

(declare (type list base-dimensions graph-pattern))

89

(assert-argument-types process-construct

90

(base-dimensions list)

91

(graph-pattern list))

92

(multiple-value-bind (constructor pattern-length pattern-width)

93

(compute-construct-pattern-constructor base-dimensions graph-pattern)

94

(declare (ignore pattern-length))

95

(let* ((result-page-width (channel-page-width destination))

96

(result-page-length (channel-page-length destination))

97

(result-page nil)

98

(result-index result-page-length)

99

(result-cache (make-hash-table :test 'equal))

100

(result-count 0)

101

(solution-count 0)

102

(quad-result-p (= pattern-width 4)))

103

(declare (type (function (function array fixnum) t) constructor)

104

(type fixnum result-index))

105

(assert (= pattern-width result-page-width) ()

106

               "Channel and operation dimensions do not match: ~a: ~a." destination pattern-width)

107

(labels ((base-processor (base-page)

108

(dotimes (base-index (array-dimension base-page 0))

109

;; collection process must contigently specify collector based on

110

;; whetehr to expect the context

111

(funcall-constructor constructor

112

                                       (if quad-result-p #'collect-quad #'collect-triple)

113

base-page base-index)))

114

(collect-triple (s p o)

115

;; suppress statements with unbound terms

116

(unless (or (= s +null-term-id+)

117

(= p +null-term-id+)

118

(= o +null-term-id+))

119

(let ((key (list s p o)))

120

(declare (dynamic-extent key))

121

;; suppress duplicates

122

(unless (gethash key result-cache)

123

(setf (gethash (copy-list key) result-cache) t)

124

(next-solution-location)

125

(locally

126

(declare (type (simple-array fixnum (* 3)) result-page))

127

(setf (aref result-page result-index 0) s

128

(aref result-page result-index 1) p

129

(aref result-page result-index 2) o))))))

130

(collect-quad (s p o g)

131

;; suppress statements with unbound terms

132

(unless (or (= s +null-term-id+)

133

(= p +null-term-id+)

134

(= o +null-term-id+))

135

(let ((key (list s p o g)))

136

(declare (dynamic-extent key))

137

;; suppress duplicates

138

(unless (gethash key result-cache)

139

(setf (gethash (copy-list key) result-cache) t)

140

(next-solution-location)

141

(locally

142

(declare (type (simple-array fixnum (* 4)) result-page))

143

(setf (aref result-page result-index 0) s

144

(aref result-page result-index 1) p

145

(aref result-page result-index 2) o

146

(aref result-page result-index 3) g))))))

147

(next-solution-location ()

148

(incf result-count)

149

                ;; return a page (possible newly created) and the next free location in that page

150

(when (>= (incf result-index) result-page-length)

151

(when result-page (put-page result-page))

152

                  (setf result-page (new-field-page destination result-page-length result-page-width)

153

result-index 0)))

154

(complete-solutions ()

155

(when result-page

156

(let ((page-result-count (1+ result-index)))

157

(when (< page-result-count result-page-length)

158

(setf result-page

159

                            (adjust-page result-page (list page-result-count result-page-width)))))

160

(put-page result-page))

161

(incf-stat *solutions-processed* solution-count)

162

(incf-stat *solutions-constructed* result-count)

163

(put-page nil)

164

(return-from process-construct))

165

(put-page (page)

166

(trace-data process-construct destination (term-value-field page))

167

(if page

168

(put-field-page destination page)

169

(complete-field destination))))

170

(do-pages (solution-page base-source)

171

(check-query-status *query*)

172

(incf solution-count (array-dimension solution-page 0))

173

(base-processor solution-page))

174

(complete-solutions)))))