/[cells]/triple-cells/hello-world.lisp
ViewVC logotype

Contents of /triple-cells/hello-world.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations)
Thu May 22 13:23:11 2008 UTC (5 years, 10 months ago) by fgoenninger
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +1 -2 lines
Changed: Creating a triple store does not accept :if-does-not-exist
any more (AllegroGraph Version 3).
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-
2 ;;;
3 ;;;
4 ;;; Copyright (c) 2008 by Kenneth William Tilton.
5 ;;;
6
7
8 (in-package :3c)
9
10 #+test
11 (3c-test-reopen)
12
13 #+test
14 (3c-test-build)
15
16 (defun 3c-test ()
17 (3c-test-build)
18 (3c-test-reopen)
19 )
20
21 (defun 3c-test-build ()
22 (test-prep "3c")
23 ;
24 ; initialize new DB altogether
25 ;
26 (create-triple-store "hello-world"
27 :if-exists :supersede
28 :directory (project-path))
29 (register-namespace "hw" "helloworld#" :errorp nil)
30 (register-namespace "ccc" "triplecells#" :errorp nil)
31 ;
32 ; initialize new DB session
33 ;
34 (3c-init)
35
36 (let ((*synchronize-automatically* t))
37 (enable-print-decoded t)
38
39 (make-observer !hw:echo-happen (trc "happen:" new-value))
40 (make-observer !hw:location (trc "We are now" new-value ))
41 (make-observer !hw:obs-response (trc "Speak:" new-value ))
42
43 (with-3c-integrity (:change) ;; change advances pulse
44 (let ((dell (3c-make !hw:computer :id "dell"))
45 (happen !hw:happen)
46 (location !hw:location)
47 (response !hw:response))
48 (declare (ignorable response location))
49 (assert dell)
50
51 (stmt-new dell happen
52 (3c-in nil :ephemeral t
53 :observer !hw:echo-happen
54 :test 'equal))
55
56
57 (stmt-new dell location
58 (3c? (let ((h (3c (3c-find-id "dell") !hw:happen)))
59 ;(trc "rule sees happen" h)
60 (cond
61 ((string-equal h "arrive") "home")
62 ((string-equal h "leave") "away")
63 (cache? cache)
64 (t "away")))
65 :observer !hw:location
66 :test 'equal))
67 ;;#+step2
68 (progn
69
70 (stmt-new dell response
71 (3c? (let* ((dell (3c-find-id "dell"))
72 (h (3c dell !hw:happen))
73 (loc (3c dell !hw:location)))
74 ;(trc "response rule sees happen" h :loc loc)
75 (cond
76 ((string-equal h "knock-knock")
77 (cond
78 ((string-equal loc "home") "who's there?")
79 (t "silence")))
80 ((string-equal h "arrive")
81 (cond
82 ((string-equal loc "home") "honey, i am home!")))
83 ((string-equal h "leave")
84 (cond
85 ((string-equal loc "away") "bye-bye!")))
86 (t cache)))
87 :observer !hw:obs-response
88 :ephemeral t
89 :test 'equal)))))))
90
91
92 (defun 3c-test-reopen ()
93 (close-triple-store)
94 (open-triple-store "hello-world"
95 :directory (project-path))
96 (when (3c-integrity-managed?) (break "1"))
97 (time
98 (let ((dell (3c-find-id "dell"))
99 (happen !hw:happen)
100 (location !hw:location)
101 (response !hw:response))
102
103 (trc "---------------- start-------------------------- " (3c dell happen)(3c dell location)(3c dell response))
104 (when (3c-integrity-managed?) (break "2"))
105 (setf (3c dell happen) "knock-knock")
106 (loop repeat 2 do
107 (setf (3c dell happen) "knock-knock"))
108 (setf (3c dell happen) "arrive")
109
110 (setf (3c dell happen) "knock-knock")
111 (setf (3c dell happen) "leave")
112 )))
113

  ViewVC Help
Powered by ViewVC 1.1.5