/[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 - (hide 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 ktilton 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-
2     ;;;
3     ;;;
4 ktilton 1.4 ;;; Copyright (c) 2008 by Kenneth William Tilton.
5 ktilton 1.1 ;;;
6    
7    
8     (in-package :3c)
9    
10 ktilton 1.4 #+test
11     (3c-test-reopen)
12 ktilton 1.1
13 ktilton 1.3 #+test
14 ktilton 1.4 (3c-test-build)
15 ktilton 1.1
16     (defun 3c-test ()
17 ktilton 1.4 (3c-test-build)
18     (3c-test-reopen)
19     )
20    
21     (defun 3c-test-build ()
22 ktilton 1.3 (test-prep "3c")
23 ktilton 1.4 ;
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 ktilton 1.1 (let ((*synchronize-automatically* t))
37     (enable-print-decoded t)
38 ktilton 1.2
39 ktilton 1.4 (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 ktilton 1.3
43 ktilton 1.4 (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 ktilton 1.3 (cond
61 ktilton 1.4 ((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 ktilton 1.3
70 ktilton 1.4 (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 ktilton 1.1
91    
92 ktilton 1.4 (defun 3c-test-reopen ()
93     (close-triple-store)
94     (open-triple-store "hello-world"
95 fgoenninger 1.5 :directory (project-path))
96 ktilton 1.4 (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 ktilton 1.1

  ViewVC Help
Powered by ViewVC 1.1.5