Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
70 lines (66 sloc) 2.6 KB
(in-package #:vivace-graph-v2)
(defmacro deftemplate (name &rest slots)
"Define a template:
(deftemplate person
(slot has-name)
(slot has-age)
(slot has-eye-color)
(slot has-hair-color))
A function is added to the template table of *store* with name NAME. This
function will be used to create groups of triples conforming to this template.
See FACT and DEFFACTS."
(let ((node (gensym)))
`(progn
(unless (triple-store? *store*)
(error "deftemplate ~A: *store* is not bound to a triple store!"
',name))
(setf (gethash ',name (templates *store*))
#'(lambda (&key ,@(mapcar #'second slots))
(with-graph-transaction (*store*)
(let ((,node (make-anonymous-node)))
(add-triple ,node "is-a"
,(string-downcase (symbol-name name)))
,@(mapcar
#'(lambda (slot)
`(add-triple
,node
,(string-downcase (symbol-name (second slot)))
,(second slot)))
slots)
,node)))))))
(defmacro fact (template)
"Create a group of triples using the named template as defined in
DEFTEMPLATE:
(fact (person (has-name \"John Q. Public\")
(has-age 23)
(has-eye-color blue)
(has-hair-color black)))"
(let ((tmpl-name (gensym)))
`(let ((,tmpl-name ',(first template)))
(funcall
(gethash ,tmpl-name (templates *store*))
,@(mapcan #'(lambda (slot)
`(,(intern (symbol-name (first slot)) 'keyword)
,(second slot)))
(rest template))))))
(defmacro deffacts (&rest templates)
"Create a set of triple groups conforming to the named template as defined
by DEFTEMPLATE:
(deffacts
(person (has-name \"John Q. Public\") (has-age 23)
(has-eye-color blue) (has-hair-color black))
(person (has-name \"Jane S. Public\") (has-age 24)
(has-eye-color blue) (has-hair-color blond)))"
(let ((template (gensym)))
`(mapcar
#'(lambda (,template)
(let ((tmpl-name (first ,template)))
(format t "tmpl-name is ~A~%" tmpl-name)
(apply (gethash tmpl-name (templates *store*))
(flatten
(mapcar
#'(lambda (slot)
(list (intern (symbol-name (first slot)) 'keyword)
(second slot)))
(rest ,template))))))
',templates)))