Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/encoding/cascalog.lisp
| Kind | Covered | All | % |
| expression | 0 | 271 | 0.0 |
| branch | 0 | 18 | 0.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; -*-
(in-package :org.datagraph.spocq.implementation)
;;; a trivial cascalog implementation
;;;
;;; (load "/home/asdf/cascalog.lisp")
(defpackage :org.datagraph.cascalog
(:use )
(:nicknames :cascalog)
(:export "<-" "?-" "?<-" "??-" "??<-"
:*repository-id*
:bgp
:select
:sparql
:|stdout|
)
)
(unless (find-symbol "APPLICATION/SPARQL-QUERY+CASCALOG" :mime)
(def-mime-type ("APPLICATION" "SPARQL-QUERY+CASCALOG") (mime::sse mime:application/sparql-query)
((de.setf.utility.implementation::file-type
:initform "clog"))
(:documentation "SPARQL encoded as a CASCALOG form")))
(defparameter cascalog::*package* (find-package :org.datagraph.cascalog))
(defparameter cascalog::*readtable* (copy-readtable nil))
(defparameter cascalog::*repository-id* nil)
(defmethod operation-read-only-p ((symbol (eql 'ORG.DATAGRAPH.CASCALOG:<-)))
t)
(flet ((cascalog::read-character (stream char)
(declare (ignore char))
(read-char stream))
(cascalog::read-vector (stream char)
(declare (ignore char))
(let ((content (read-delimited-list #\] stream t)))
(make-array (length content) :initial-contents content)))
(cascalog::read-map (stream char)
(declare (ignore char))
(let ((content (read-delimited-list #\} stream t))
(map (make-hash-table :test #'equalp)))
(loop for (key value) on content by #'cddr
do (setf (gethash key map) value))
map))
(cascalog::read-set (stream disp sub)
(declare (ignore disp sub))
(read-delimited-list #\) stream t))
(cascalog::read-variable (stream char)
(declare (ignore char))
(let* ((symbol (read stream))
(name (symbol-name symbol)))
(if (alpha-char-p (char name 0))
(intern name (find-package :?))
(intern (concatenate 'string "?" name) *package*)))))
(set-macro-character #\\ #'cascalog::read-character nil cascalog::*readtable*)
(set-macro-character #\[ #'cascalog::read-vector nil cascalog::*readtable*)
(set-syntax-from-char #\] #\) cascalog::*readtable*)
(set-macro-character #\{ #'cascalog::read-map nil cascalog::*readtable*)
(set-syntax-from-char #\} #\) cascalog::*readtable*)
(set-dispatch-macro-character #\# #\{ #'cascalog::read-set cascalog::*readtable*)
(set-macro-character #\? #'cascalog::read-variable nil cascalog::*readtable*)
(set-syntax-from-char #\, #\space cascalog::*readtable*)
(setf (readtable-case cascalog::*readtable*) :preserve))
(defun cascalog:|stdout| (&key (stream *standard-output*))
"Return a continuation which consumes the result field, externalizes it and
emits it to the given output stream.
STREAM : stream : (default *standard-output*"
(flet ((stdout-continuation (element)
(when element
(loop for solution in (term-value-field element)
for count from 0
do (format stream "~%~s" solution)
finally (return count)))))
#'stdout-continuation))
(defmacro cascalog:select (projection field)
`(spocq.a:|select| ,field ,(coerce projection 'list)))
(defmacro cascalog:<- (projection &body patterns)
`(cascalog:select ,projection (cascalog:bgp ,@patterns)))
(defmacro cascalog:?- (&rest sinks-and-queries)
(when (stringp (first sinks-and-queries))
(pop sinks-and-queries))
`(progn ,@(loop for (sink query) on sinks-and-queries by #'cddr
collect `(cascalog:sparql ,query ,sink))))
(defmacro cascalog:?<- (destination projection &body patterns)
(when (stringp projection)
(setf projection (pop patterns)))
`(cascalog:sparql '(cascalog:select ,projection (cascalog:bgp ,@patterns))
,destination))
(defmacro cascalog:??- (&rest queries)
(declare (ignore queries))
;; there is no operator which can accept a sequence of fields
(error "not supported : ??-"))
(defmacro cascalog:??<- (&rest queries)
(when (stringp (first queries))
(pop queries))
(if queries
(reduce #'(lambda (left &optional right)
(if right
`(spocq.a:|union| ,left ,right)
right))
queries
:from-end t)
'(spocq.a:|table| spocq.a:|unit|)))
(defmacro cascalog:bgp (&rest patterns)
`(spocq.a:|bgp| ,@(loop for (predicate subject object) in patterns
collect `(spocq.a:|triple| ,subject
,predicate
,object))))
(defun cascalog:sparql (query continuation)
(run-sparql query
:repository-id cascalog:*repository-id*
:continuation continuation
:agent (system-agent)))
;;; input
(defgeneric construct-cascalog-iri (term &optional separator)
(:method ((term symbol) &optional (separator #\/))
(construct-cascalog-iri (symbol-name term) separator))
(:method ((name string) &optional (separator #\/))
(let* ((separator-position (position separator name))
(pn_prefix (if separator-position (subseq name 0 separator-position) ""))
(pn_local (if separator-position (subseq name (1+ separator-position)) name))
(namespace-uri (prefix-namespace pn_prefix))
;; need to cache these
(namespace-namestring (term-lexical-form namespace-uri)))
(if (member namespace-namestring *iri-package-names* :test #'string-equal)
(or (find-symbol pn_local namespace-namestring)
(when (and (boundp '*strict-vocabulary-terms*)
(symbol-value '*strict-vocabulary-terms*))
(error "Invalid vocabulary resource: ~s." name))
(merge-and-intern-iri (concatenate 'string namespace-namestring pn_local)))
(merge-and-intern-iri (concatenate 'string namespace-namestring pn_local))))))
(defmethod receive-message ((stream stream) (content-type mime:application/sparql-query+cascalog) &key)
"Given a STREAM with application/sparql-query+cascalog CONTENT-TYPE, decode a query expression
with the CASCALOG as the default package and walk the subsequent expression to constrain the
operators."
(log-debug "receive-message : (~s ~s)" stream content-type)
(parse-cascalog stream))
(defun parse-cascalog (stream)
(let* ((*package* cascalog::*package*)
(*readtable* cascalog::*readtable*))
(flet ((guarded-op (function)
(handler-case (funcall function)
(error (condition)
(log-error "invalid sparql message body: ~a" condition)
(spocq.e::message-syntax-error :expression nil
:condition condition)))))
(let ((cascalog-expression
(guarded-op #'(lambda ()
(labels ((intern-term (term)
(typecase term
(null term)
(symbol
(let ((name (symbol-name term)))
(cond ((or (eq (nth-value 1 (find-symbol name cascalog::*package*)) :external)
(eq (nth-value 1 (find-symbol name *algebra-package*)) :external))
term)
((eq (symbol-package term) *variable-package*)
term)
(t
(construct-cascalog-iri name)))))
(t
term))))
(map-tree #'intern-term
(read stream)))))))
(values 'spocq.a:|select|
(list :query-expression nil
:sse-expression cascalog-expression))))))
#|
(loop for symbol being each external-symbol in *algebra-package*
when (macro-function symbol)
collect (cons symbol (documentation symbol 'function)))
(with-input-from-string (stream "(?<- (stdout) [?person ?age] (foaf/age ?person ?age))")
(receive-message stream mime:application/sparql-query+cascalog))
(setf (gethash 'cascalog::age cascalog::*environment*) |http://xmlns.com/foaf/0.1/|:|age|)
(setf (gethash 'cascalog::name cascalog::*environment*) |http://xmlns.com/foaf/0.1/|:|name|)
(let* ((*readtable* cascalog::*readtable*)
(*package* (find-package :org.datagraph.cascalog))
(cascalog:*repository-id* "jhacker/tbl"))
(read-from-string "(|?<-| (stdout) [?person ?name] (name ?person ?name))"))
(let* ((*readtable* cascalog::*readtable*)
(*package* (find-package :org.datagraph.cascalog))
(cascalog:*repository-id* "jhacker/tbl"))
(eval (read-from-string "(|?<-| (stdout) [?person ?name] (name ?person ?name))")))
(let* ((*readtable* cascalog::*readtable*)
(*package* (find-package :org.datagraph.cascalog)))
(loop for form = (read)
until (null form)
do (format *standard-output* "~%~:w~%" form)
(finish-output *standard-output*)))
(LET
# (MANY-FOLLOWS
(<- #(?::PERSON) (FOLLOWS ?::PERSON _) (C/COUNT ?::C) (> ?::C 2))
ACTIVE-FOLLOWS
(<- #(?::P1 ?::P2) (MANY-FOLLOWS ?::P1) (MANY-FOLLOWS ?::P2)
(FOLLOWS ?::P1 ?::P2)))
|#