[cells-cvs] CVS triple-cells

ktilton ktilton at common-lisp.net
Sat Feb 23 01:23:45 UTC 2008


Update of /project/cells/cvsroot/triple-cells
In directory clnet:/tmp/cvs-serv15444

Added Files:
	3c-integrity.lisp ag-utilities.lisp read-me.lisp 
Log Message:



--- /project/cells/cvsroot/triple-cells/3c-integrity.lisp	2008/02/23 01:23:45	NONE
+++ /project/cells/cvsroot/triple-cells/3c-integrity.lisp	2008/02/23 01:23:45	1.1
(in-package :3c)

(defmacro with-3c-integrity ((&optional opcode defer-info debug) &rest body)
  `(call-with-3c-integrity ,opcode ,defer-info (lambda (opcode defer-info)
                                                 (declare (ignorable opcode defer-info))
                                                 ,(when debug
                                                    `(trc "integrity action entry" opcode defer-info ',body))
                                                 , at body)))

(defmacro with-3cc (id &body body)
  `(with-ec-integrity (:change ,id)
     , at body))

(defun 3c-integrity-managed? ()
  (get-triple :s !ccc:integrity :p !ccc:within))

(defun (setf 3c-integrity-managed?) (on?)
  (if on?
      (if (get-triple :s !ccc:integrity :p !ccc:within)
        (break "integ already managed")
        (add-triple !ccc:integrity !ccc:within (new-blank-node)))
    (bif (tr (get-triple :s !ccc:integrity :p !ccc:within))
      (delete-triple (triple-id tr))
      (warn "integ not being managed, nothing to turn off"))))

(defun call-with-3c-integrity (opcode defer-info action)
  (if (3c-integrity-managed?)
      (if opcode
          (3c-ufb-add opcode defer-info)
          (funcall action opcode defer-info))
    (prog2
      (setf (3c-integrity-managed?) t)

        (progn ;; let (*defer-changes*)
          (when (or (null (3c-pulse))
                  (eq opcode :change))
            (3c-pulse-advance (cons opcode defer-info)))
          (prog1
              (funcall action opcode defer-info)
            (3c-finish-business)))

      (setf (3c-integrity-managed?) nil))))

(defun 3c-ufb-add (opcode defer-info)
  (add-triple opcode (mk-upi (get-internal-real-time)) defer-info))

(defun 3c-finish-business ()
  (tagbody
    tell-dependents
    (process-tell-dependents)
    (process-awaken)
    (when (get-triple :p !ccc:tell-dependents)
      (go tell-dependents))
    
;;;    ;--- process client queue ------------------------------
;;;    ;
;;;    handle-clients
;;;    (bwhen (clientq (ufb-queue :client))
;;;      (if *client-queue-handler*
;;;          (funcall *client-queue-handler* clientq) ;; might be empty/not exist, so handlers must check
;;;        (just-do-it clientq))
;;;      (when (fifo-peek (ufb-queue :client))
;;;        #+shhh (ukt::fifo-browse (ufb-queue :client) (lambda (entry)
;;;                                                       (trc "surprise client" entry)))
;;;        (go handle-clients)))
    (process-reset-ephemerals)

;;;    (bwhen (task-info (fifo-pop (ufb-queue :change)))
;;;      (trc nil "!!! finbiz --- CHANGE ---- (first of)" (fifo-length (ufb-queue :change)))
;;;      (destructuring-bind (defer-info . task-fn) task-info
;;;        (trc nil  "finbiz: deferred state change" defer-info)
;;;        (data-pulse-next (list :finbiz defer-info))
;;;        (funcall task-fn :change defer-info)
;;;        (go tell-dependents)))
    ))

(defun process-tell-dependents ()
  (index-new-triples)
  (loop while (loop with any 
                  for cell in (prog1
                                  (mapcar 'object (get-triples-list :s !ccc:ufb-tell-dependents))
                                (delete-triples :s !ccc:ufb-tell-dependents))
                  do (loop for user in (get-triples-list :p !ccc:uses :o cell)
                         do (trc nil "propagating !!!!!!!!!!!!" cell :to (cell-predicate (subject user)))
                           (setf any t)
                           (3c-ensure-current (subject user)))
                  finally (return any))))

(defun process-awaken ()
  (index-new-triples)
  (loop for cell in (prog1
                        (mapcar 'object (get-triples-list :s !ccc:awaken-ruled-cell))
                      (delete-triples :s !ccc:awaken-ruled-cell))
      do (3c-awaken-ruled-cell cell))
  (loop for o in (prog1
                     (mapcar 'object (get-triples-list :s !ccc:observe))
                   (delete-triples :s !ccc:observe))
      do (if (3c-cell? o)
             (cell-observe-change o (cell-model o) (cell-predicate o) (3c-cell-value o) nil nil)
           (let ((tr (get-triple-by-id (upi->value o)))) ;; must be a mod-pred-triple constant
             (trc "obsing k" tr (predicate tr))
             (cell-observe-change nil (subject tr) (predicate tr) (upi->value (object tr)) nil nil)))))

(defun process-reset-ephemerals ()
  (let ((q !ccc:ufb-reset-ephemerals))
    (index-new-triples)
    (loop for cell in (prog1
                          (mapcar 'object (get-triples-list :s q))
                        (delete-triples :s q))
        for p = (cell-predicate cell)
        do ;(trc "resetting ephemeral" p)
          (delete-triples :s cell :p !ccc:value)
          (delete-triples :s (cell-model cell) :p p))))--- /project/cells/cvsroot/triple-cells/ag-utilities.lisp	2008/02/23 01:23:45	NONE
+++ /project/cells/cvsroot/triple-cells/ag-utilities.lisp	2008/02/23 01:23:45	1.1
;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-
;;;
;;;
;;; Copyright (c) 2008 by Kenneth William Tilton.
;;;


(in-package :3c)

;; --- ag utils -----------------------

#+test
(progn
  (make-tutorial-store)
  (let ((s (mk-upi "a"))
        (p (new-blank-node)))
    (loop repeat 10
          do (add-triple s (mk-upi (random 10)) p))
    (index-new-triples)
    (loop for tr in (get-triples-list :s s)
        do (print (upi->value (predicate tr))))))

(defun triple-value (tr)
  (when tr
    (upi->value (object tr))))

(defun get-sp (s p)
  #+allegrocl (get-triple :s s :p p)
  #-allegrocl (car (get-triples-list :s s :p p)))

(defun get-spo (s p o)
  #+allegrocl (get-triple :s s :p p :o o)
  #-allegrocl (car (get-triples-list :s s :p p :o o)))

(defun get-sp-value (s p)
  (triple-value (get-sp s p)))

(defun mk-upi (v)
  (typecase v
    (string (literal v))
    (symbol (mk-upi (symbol-name v)))
    (integer (value->upi v :long))
    (future-part v)
    (otherwise (if (upip v) v
                 (break "not upi-able ~a ~a" (type-of v) v)))))


(defun ensure-triple (s p o)
  (unless (get-spo s p o)
    (add-triple s p o)))

--- /project/cells/cvsroot/triple-cells/read-me.lisp	2008/02/23 01:23:45	NONE
+++ /project/cells/cvsroot/triple-cells/read-me.lisp	2008/02/23 01:23:45	1.1
#|

               Triple-Cells: (+ RDF Cells)
               ---------------------------

Prerequisites
-------------
Cells: http://common-lisp.net/project/cells/

  Lotsa broken links. Use c-l.net repsoitories access to get to CVS:

    http://common-lisp.net/cgi-bin/viewcvs.cgi/?root=cells


RDF: http://www.w3.org/RDF/

  That is the RDF standard. Many implementations available, even from Oracle. Redland is an open one.

Redland: http://librdf.org/

  C, open, lotsa bindings to other languages, Lisp bindings and port of triple-cells 
  left as an exercise. I use AllegroCL/Allegrograph.

Free trial AG: http://www.franz.com/downloads/clp/agle_survey

  It is not clear whether you first need to download/install the free express edition
  of AllegroCL or whether this download does it all.

Download of Triple-Cells itself
-------------------------------
  Start here: http://common-lisp.net/cgi-bin/viewcvs.cgi/?root=cells

  Then you need both Cells and triple-cells. Getting Cells just requires the contained
  utils-kt, but my favorite debug stuff is Cells-aware so resides there. Gotta refactor someday.

  hello-world.lisp includes a function 3c-test. Once that or 3c-test-build has been run, more fun
  is 3c-test-reopen, which shows the AG database has all the information needed to "run" a 
  database, assuming triple-cells is loaded.

|#



More information about the Cells-cvs mailing list