Coverage report: /home/ellis/comp/core/lib/q/dql.lisp

Kind	Covered	All	%
expression	0	177	0.0
branch	0	8	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; dql.lisp --- Deductive Query Language

2

3

;; Query Engine for Inference-based query langs.

4

5

;;; Commentary:

6

7

;; Prolog, Datalog, etc.

8

9

;; Prolog rules are created with: (*- head body body ...)

10

;; Prolog queries are posed with: (?- goal goal ...)

11

12

;;;; SQL vs Prolog

13

14

;; My current understanding is that Prolog and SQL-derived langs share much in

15

;; common. You can certainly do deductive logic in SQL and you can do

16

;; relational table-based logic in Prolog.

17

18

;; It is interesting to note that they were both discovered around the same

19

;; time in the 60s-70s, but in very different contexts. Prolog was intended

20

;; for NLP and SQL (relational-algebra/RA) was the foundation for

21

;; RDBMS. Prolog never really found the same sort of success had by SQL, but

22

;; with the AI summer in full bloom and NLP being a hot-topic, perhaps we will

23

;; see the scales shift.

24

25

;;;; Design

26

27

;; The WAM compiler is a bit too much to understand let alone implement at

28

;; this stage. The design of this package will be much simpler and optimized

29

;; for compatibility with Lisp Objects.

30

31

;; The design we're going for in this package is what I would consider the

32

;; Lisper's version of Datalog. We want to implement just enough to be useful

33

;; as a query language, and then use it to bootstrap a more elegant Prolog

34

;; compiler, likely in SYN/PROLOG.

35

36

;;;; Data Model

37

38

;; forms + specials -> logical plan -> physical plan -> engine

39

40

;;;; Compiler

41

42

;; As always our 'compiler' for this DSL will be encapsulated in a series of

43

;; macros. In this case we will be leveraging CLtL2 where possible as well as

44

;; some internal SB-C functions and structures.

45

46

;; In CLtL2 terminology, we make use of the environment with functions such as

47

;; AUGMENT-ENVIRONMENT, PARSE-MACRO, and ENCLOSE. During compilation we build

48

;; the environment and then lexically bind it during execution of queries.

49

50

;;; Clauses

51

52

;; Rules are made up of calls to predicates which are called the Rule's

53

;; Goals. Facts are clauses without a body.

54

55

;; Rules and Facts are compiled into Functors which consist of the function

56

;; name and arity.

57

58

;;;; Refs

59

60

;; https://franz.com/support/documentation/11.0/prolog.html

61

62

;; https://github.com/wmannis/cl-gambol

63

64

;; https://norvig.com/paip/README.html

65

66

;; https://en.wikipedia.org/wiki/Negation_as_failure

67

68

;; https://github.com/bobschrag/clolog/blob/main/architecture.md

69

70

;; https://www.swi-prolog.org/pldoc/man?section=predsummary

71

72

;; https://citeseerx.ist.psu.edu/document?repid=rep1&type=pdf&doi=cc7dcdf130adbd7be4d0ed5d3f4ea890e4477223

73

74

;; https://en.wikipedia.org/wiki/SLD_resolution

75

76

;;; Code:

77

(in-package :q/dql)

78

79

;;; Vars

80

81

(declaim (fixnum *lips*))

82

(defvar *lips* 0

83

"Count of logical inferences performed.")

84

85

(defvar *leash-limit* nil)

86

87

(defvar *leash-indent-wrap* 20

88

   "The output to *LEASH-OUTPUT* indents by one level for each level of a predicate, modulo this value.")

89

90

(defvar *leash-output* (make-synonym-stream '*trace-output*))

91

92

;; from GAMBOL

93

(defvar *interactive* t

94

"non-nil iff interacting with user")

95

(defvar *auto-backtrack* nil

96

"return all solutions if non-nil")

97

(defvar *last-continuation* nil

98

"saved state of the system")

99

(defvar *trail* nil

100

"the trail, for backtracking")

101

(defvar *goal-env* nil

102

"env for goals")

103

(defvar *rule-env* nil

104

"env for rules")

105

(defvar *global-envs* nil

106

"top-level environments")

107

(defvar *global-vars* nil

108

"top-level variable names")

109

110

(defvar *functors* (make-hash-table)

111

"hash table for DQL functors. Keys are the functor name and values are either a

112

single function (indicating a '&rest' lambda-list with arity *) or a vector of

113

functions with length equal to the functor with the highest arity.")

114

115

(defvar *rules* (make-hash-table)

116

"hash table for rules. Keys are the HEAD and values are the body.")

117

(defvar *facts* nil

118

"Facts are unconditional truths. They are expressed simply as rules with no

119

variables in the head and no clauses in the body. During reading of a DQL

120

form, if we find any facts we evaluate them and store them here.")

121

122

;;; Utils

123

(defconstant +impossible+ :never "make impossible look nice")

124

(defconstant +solved+ :ok "make solved look nice")

125

(defconstant +dql-vars-property+ :dql-vars)

126

(defconstant +dql-funs-property+ :dql-funs)

127

128

(defconstant +dql-variable-prefix+ #\?)

129

130

(defun dql-variable-p (sym)

131

"Valid DQL variables are symbols which start with the character #\? as in '?FOO

132

and '?BAR."

133

(and (symbolp sym)

134

(eql (char (symbol-name sym) 0) +dql-variable-prefix+)))

135

136

(deftype dql-variable () '(satisfies dql-variable-p))

137

138

(defun dql-anonymous-p (sym)

139

"Return T if SYM is a DQL anonymous variable represented by the value of +?+."

140

(eq sym (symbolicate +dql-variable-prefix+)))

141

142

(deftype dql-anonymous () '(satisfies dql-anonymous-p))

143

144

(defgeneric proof-tree (self))

145

146

(defgeneric print-proof-tree (self &optional stream))

147

148

;; functors

149

(defun match-dql-variable (a b)

150

(and (eq +dql-vars-property+ (car b))

151

(find a (cadr b))))

152

153

(defun match-dql-function (a b)

154

(and (eq +dql-funs-property+ (car b))

155

(find a (cadr b))))

156

157

(defun register-dql-variable (name env)

158

(push name (cdr (assoc +dql-vars-property+ (lexenv-user-data env)))))

159

160

(defun register-dql-rule (name env &optional arity)

161

(push name (cdr (assoc +dql-funs-property+ (lexenv-user-data env))))

162

(setf (gethash name *functors*)

163

(or (when arity (make-array arity :element-type 'function)) (function name))))

164

165

(defun register-dql-functor (name fname arity)

166

(let ((val (gethash name *functors*)))

167

(etypecase val

168

(function (simple-dql-error "Unable to overwrite a vararg functor: ~A" name))

169

(vector (setf (aref val arity) fname)))))

170

171

(defun dvboundp! (var &optional env)

172

"Check if VAR is bound as a DQL-VARIABLE in the given environment."

173

(lexenv-find var :user-data :lexenv env :test 'match-dql-variable))

174

175

(defun dfboundp! (fun &optional env)

176

"Check if FUN is bound as a DQL-FUNCTOR in the given environment."

177

(lexenv-find fun :user-data :lexenv env :test 'match-dql-function))

178

179

;; (defmacro dquoty (form &environment env)

180

;; "Like QUOTY but builds DQL functors instead of functions from unknown lists."

181

;; )

182

183

(defun term-to-head (term)

184

(etypecase term

185

(atom (values (symbolicate term '/*) nil))

186

(cons (values (symbolicate (car term) '/ (length #1=(cdr term))) #1#))))

187

188

(defmacro generate-rule (head &body clauses &environment env)

189

"Generate a rule with a set of clauses which may or may not eventually return T."

190

(multiple-value-bind (fname args) (term-to-head head)

191

`(prog1 (defun ,fname ,args ,@clauses)

192

(register-dql-rule ,head ,env)

193

(register-dql-functor ,head ,fname ,(length args)))))

194

195

(defmacro generate-fact (head)

196

"Generate a fact which is like a rule but contains no substantial body (always returns T)."

197

(multiple-value-bind (fname args) (term-to-head head)

198

`(prog1 (defun ,fname ,args t)

199

(register-dql-functor ,head ,fname ,(length args)))))

200

201

(defmacro generate-variable (term val &environment env)

202

"Bind the symbol TERM to VAL in the specified ENV."

203

`(register-dql-variable ,term ,val ,env))

204

205

(defun dql-functor-p (sym)

206

"Check if SYM looks like a DQL functor. It shoulb be suffixed by a #\/

207

followed by either '* for vararg functors or an integer indicating the arity

208

of the predicate. On success returns the arity or T for varargs."

209

(when-let ((arity (cdr (ssplit #\/ (symbol-name sym)))))

210

(setf (the simple-string arity) (car arity))

211

(or (and

212

(digit-char-p (char arity 0))

213

(parse-integer arity))

214

(char= (char arity 0) #\*))))

215

216

;;; Conditions

217

(define-condition dql-condition () ())

218

(define-condition dql-error (dql-condition error) ())

219

220

(deferror simple-dql-error (dql-error simple-error) () (:auto t))

221

222

(define-condition invalid-dql-anonymous (dql-error) ())

223

224

(define-condition invalid-dql-variable (dql-error) ())

225

226

;;; Predicates

227

;; (defmacro define-dql-predicate ())

228

;; ports: call, exit, redo, and fail

229

230

;;; Query Protocol

231

;; variables are basically just fields?

232

(defclass dql-env (simple-schema)

233

((env :initarg :env :accessor env))

234

(:default-initargs

235

:env (make-null-lexenv)

236

:name (symbol-name (gensym "dql-env"))))

237

238

(defmacro new-dql-env (&body fields &environment env)

239

`(progn

240

(appendf (lexenv-user-data ,env) '((#.+dql-vars-property+) (#.+dql-funs-property+)))

241

(make-instance 'dql-env :fields (make-fields ,@fields) :env ,env)))

242

243

(defclass dql-logical-plan (logical-query-plan) ())

244

(defclass dql-physical-plan (physical-query-plan) ())

245

(defclass dql-planner (query-plan) ())

246

247

(defclass dql-expr (query-expr unary-expression)

248

((name :initarg :name :type string :accessor name)))

249

250

(defclass dql-rule-expr (dql-expr) ())

251

(defclass dql-fact-expr (dql-expr literal-expression) ())

252

253

(defclass dql-rule (physical-expression)

254

())

255

(defclass dql-fact (physical-expression) ())

256

257

(defmethod evaluate ((self dql-rule) (input record-batch)))

258

(defmethod evaluate ((self dql-fact) (input record-batch)))

259

260

(defmethod make-physical-expression ((expr dql-expr) (input dql-logical-plan)))

261

262

(defmethod make-physical-plan ((plan dql-logical-plan)))

263

264

(defclass unify (dql-logical-plan) ())

265

(defclass solve (dql-logical-plan) ())

266

267

(defclass unify-exec (dql-physical-plan) ())

268

(defclass solve-exec (dql-physical-plan) ())

269

270

;; cut

271

;; ref: https://en.wikipedia.org/wiki/Cut_(logic_programming)

272

(defconstant +!+ #\!)

273

(defun ! () )

274

(define-symbol-macro ! (!))

275

276

;; equality

277

278

;; db manipulation

279

280

;; assert, retract, asserta, and assertz

281

282

;;; Resolution

283

284

;; herbrand universe | ground-terms + pred(P) -> herbrand base | map(true) -> herbrand interpretation

285

286

;;;; Unification

287

;;(defun unify (goal))

288

289

;; optimistic vs pessimistic when presented with infinite recursion

290

291

;;; Query

292

(defclass dql-query (query) ())

293

294

(defclass dql-data-source (data-source) ()

295

(:documentation "Data source which can be used with DQL expressions."))

296

297

;;; Parser

298

;; (defclass dql-parser (query-parser) ())

299

300

;;; Lisp Interface

301

;; (defmacro *- (head &body body))

302

;; bindings?

303

;; (defmacro <- (head &body body))

304

;; (defmacro <-- (head &body body))

305

306

(defmacro ?- (&body goals)

307

"Enter the interactive DQL execution context, attempting to solve for

308

GOALS."

309

`(let ((*interactive* t)

310

(*auto-backtrack* nil))

311

(dql-solve ,goals)))

312

313

;; (defmacro leash (&body (functor arity))

314

;; "Prolog equivalent of CL:TRACE."

315

;; (print functor) (print arity))

316

317

;; (defmacro unleash (&body (functor arity))

318

;; "Prolog equivalent of CL:UNTRACE."

319

;; (print functor) (print arity))

320

321

;; (defun compile-dql-symbols (&rest functors))