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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by ktilton, Sun Dec 23 10:04:56 2007 UTC revision 1.4 by ktilton, Sat Feb 23 01:22:11 2008 UTC
# Line 1  Line 1 
1  ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-  ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-
2  ;;;  ;;;
3  ;;;  ;;;
4  ;;; Copyright (c) 1995,2003 by Kenneth William Tilton.  ;;; Copyright (c) 2008 by Kenneth William Tilton.
5  ;;;  ;;;
 ;;; Permission is hereby granted, free of charge, to any person obtaining a copy  
 ;;; of this software and associated documentation files (the "Software"), to deal  
 ;;; in the Software without restriction, including without limitation the rights  
 ;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell  
 ;;; copies of the Software, and to permit persons to whom the Software is furnished  
 ;;; to do so, subject to the following conditions:  
 ;;;  
 ;;; The above copyright notice and this permission notice shall be included in  
 ;;; all copies or substantial portions of the Software.  
 ;;;  
 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR  
 ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  
 ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE  
 ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER  
 ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING  
 ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS  
 ;;; IN THE SOFTWARE.  
6    
7    
8  (in-package :3c)  (in-package :3c)
9    
10    #+test
11  (defun 3c-test-reopen ()  (3c-test-reopen)
   (close-triple-store)  
   (open-triple-store "hello-world"  
     :directory (project-path)  
     :if-does-not-exist :error)  
   (let ((dell (3c-find-id "dell"))  
         (happen !hw:happen)  
         (location !hw:location)  
         (response !hw:response))  
   
     (trc "start" (3c dell happen)(3c dell location)(3c dell response))  
     (setf (3c dell happen) "knock-knock")  
     (setf (3c dell happen) "arrive")  
     (setf (3c dell happen) "knock-knock")  
     ))  
12    
13  #+test  #+test
14  (3c-test)  (3c-test-build)
15    
16  (defun 3c-test ()  (defun 3c-test ()
17      (3c-test-build)
18      (3c-test-reopen)
19      )
20    
21    (defun 3c-test-build ()
22    (test-prep "3c")    (test-prep "3c")
23    (unwind-protect    ;
24        (progn    ; initialize new DB altogether
25          (3c-init)    ;
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))    (let ((*synchronize-automatically* t))
37      (enable-print-decoded t)      (enable-print-decoded t)
     (create-triple-store "hello-world"  
       :if-exists :supersede  
       :directory (project-path))  
     (register-namespace "hw" "helloworld#" :errorp nil)  
     (register-namespace "ccc" "triplecells#" :errorp nil)  
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      (let ((dell (3c-make !hw:computer  :id "dell"))      (with-3c-integrity (:change) ;; change advances pulse
44            (happen !hw:happen)        (let ((dell (3c-make !hw:computer  :id "dell"))
45            (location !hw:location)              (happen !hw:happen)
46            (response !hw:response))              (location !hw:location)
47        (assert dell)              (response !hw:response))
48            (declare (ignorable response location))
49        (make-observer !hw:echo-happen (trc "happen:" new-value))          (assert dell)
50        (make-observer !hw:obs-location (trc "We are now" new-value ))  
51        (make-observer !hw:obs-response (trc "Speak:" new-value ))          (stmt-new dell happen
52              (3c-in  nil :ephemeral t
53        (stmt-new dell happen  #+const  "test"              :observer !hw:echo-happen
54          (3c-in  nil :ephemeral t              :test 'equal))
55            :observer !hw:echo-happen  
56            :test 'equal))  
57            (stmt-new dell location
58        (stmt-new dell location            (3c? (let ((h (3c (3c-find-id "dell") !hw:happen)))
59          (3c? ;(trc "RULE-ENTRY>" *3c-pulse*)                   ;(trc "rule sees happen" h)
           (let ((h (3c (3c-find-id "dell") !hw:happen)))  
             ;(trc "rule sees happen" h)  
             (cond  
              ((string-equal h "arrive") "home")  
              ((string-equal h "leave") "away")  
              (cache? cache)  
              (t "away")))  
          :observer !hw:obs-location  
          :test 'equal))  
   
       (stmt-new dell response  
         (3c? (let* ((dell (3c-find-id "dell"))  
                     (h (3c dell !hw:happen))  
                     (loc (3c dell !hw:location)))  
                ;(trc "response rule sees happen" h :loc loc)  
                (cond  
                 ((string-equal h "knock-knock")  
                  (cond  
                   ((string-equal loc "home") "who's there?")  
                   (t "silence")))  
                 ((string-equal h "arrive")  
                  (cond  
                   ((string-equal loc "home") "honey, i am home!")))  
                 ((string-equal h "leave")  
60                   (cond                   (cond
61                    ((string-equal loc "away") "bye-bye!")))                    ((string-equal h "arrive") "home")
62                  (t cache)))                    ((string-equal h "leave") "away")
63            :observer !hw:obs-response                    (cache? cache)
64            :test 'equal))                    (t "away")))
65                :observer !hw:location
66        (time              :test 'equal))
67         (progn          ;;#+step2
68           (setf (3c dell happen) "knock-knock")          (progn
          (loop repeat 2 do  
                (setf (3c dell happen) "knock-knock"))  
          (setf (3c dell happen) "arrive")  
69    
70           (setf (3c dell happen) "knock-knock")            (stmt-new dell response
71           (setf (3c dell happen) "leave")))              (3c? (let* ((dell (3c-find-id "dell"))
72                            (h (3c dell !hw:happen))
73        )))                          (loc (3c dell !hw:location)))
74      (dribble)))                     ;(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        :if-does-not-exist :error)
97      (when (3c-integrity-managed?) (break "1"))
98      (time
99       (let ((dell (3c-find-id "dell"))
100             (happen !hw:happen)
101             (location !hw:location)
102             (response !hw:response))
103    
104         (trc "---------------- start-------------------------- " (3c dell happen)(3c dell location)(3c dell response))
105         (when (3c-integrity-managed?) (break "2"))
106         (setf (3c dell happen) "knock-knock")
107         (loop repeat 2 do
108               (setf (3c dell happen) "knock-knock"))
109         (setf (3c dell happen) "arrive")
110    
111         (setf (3c dell happen) "knock-knock")
112         (setf (3c dell happen) "leave")
113         )))
114    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5