Use Daves example to experiment

2 files changed, 206 insertions, 3 deletions

diff --git a/bin/pangemma b/bin/pangemma
index 399ed6f..e962ee5 100755
--- a/bin/pangemma
+++ b/bin/pangemma
@@ -8,6 +8,193 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
              (srfi srfi-9)
              (srfi srfi-9 gnu))
 
+(define-record-type <nothing>
+  (make-nothing)
+  %nothing?)
+(define (print-nothing nothing port)
+  (display "#<nothing>" port))
+(set-record-type-printer! <nothing> print-nothing)
+(define nothing (make-nothing))
+(define (nothing? x) (eq? x nothing))
+
+(define-record-type <contradiction>
+  (make-contradiction details)
+  contradiction?
+  (details contradiction-details))
+
+(define (print-contradiction contradiction port)
+  (format port "#<contradiction ~a>"
+          (contradiction-details contradiction)))
+(set-record-type-printer! <contradiction> print-contradiction)
+
+(define contradiction (make-contradiction nothing))
+
+(define-record-type <relations>
+  (%make-relations name parent children)
+  relations?
+  (name relations-name)
+  (parent relations-parent)
+  (children relations-children set-relations-children!))
+
+(define (print-relations relations port)
+  (match relations
+    (($ <relations> name parent children)
+     (format port "#<relations ~a ↑ ~a ↓ ~a>"
+             name parent children))))
+(set-record-type-printer! <relations> print-relations)
+
+(define current-parent (make-parameter #f))
+
+(define (make-relations name)
+  (%make-relations name (current-parent) '()))
+
+(define (add-child! parent child)
+  (when parent
+    (set-relations-children! parent (cons child (relations-children parent)))))
+
+(define-record-type <cell>
+  (%make-cell relations neighbors content strongest
+              equivalent? merge find-strongest handle-contradiction)
+  cell?
+  (relations cell-relations)
+  (neighbors cell-neighbors set-cell-neighbors!)
+  (content cell-content set-cell-content!)
+  (strongest cell-strongest set-cell-strongest!)
+  ;; Dispatch table:
+  (equivalent? cell-equivalent?)
+  (merge cell-merge)
+  (find-strongest cell-find-strongest)
+  (handle-contradiction cell-handle-contradiction))
+
+(define (print-cell cell port)
+  (match cell
+    (($ <cell> ($ <relations> name) _ _ strongest)
+     (display "#<cell " port)
+     (display name port)
+     (display " " port)
+     (display strongest port)
+     (display ">" port))))
+(set-record-type-printer! <cell> print-cell)
+
+(define-record-type <propagator>
+  (%make-propagator relations inputs outputs activate)
+  propagator?
+  (relations propagator-relations)
+  (inputs propagator-inputs)
+  (outputs propagator-outputs)
+  (activate propagator-activate))
+
+(define (print-propagator propagator port)
+  (match propagator
+    (($ <propagator> ($ <relations> name) inputs outputs)
+     (display "#<propagator " port)
+     (display name port)
+     (display " " port)
+     (display inputs port)
+     (display " -> " port)
+     (display outputs port)
+     (display ">" port))))
+(set-record-type-printer! <propagator> print-propagator)
+
+(define default-equivalent? equal?)
+;; But what about partial information???
+(define (default-merge old new) new)
+(define (default-find-strongest content) content)
+(define (default-handle-contradiction cell) (values))
+
+(define* (make-cell name #:key
+                    (equivalent? default-equivalent?)
+                    (merge default-merge)
+                    (find-strongest default-find-strongest)
+                    (handle-contradiction default-handle-contradiction))
+  (let ((cell (%make-cell (make-relations name) '() nothing nothing
+                          equivalent? merge find-strongest
+                          handle-contradiction)))
+    (add-child! (current-parent) cell)
+    cell))
+
+(define (cell-name cell)
+  (relations-name (cell-relations cell)))
+
+(define (add-cell-neighbor! cell neighbor)
+  (set-cell-neighbors! cell (lset-adjoin eq? (cell-neighbors cell) neighbor)))
+
+(define (add-cell-content! cell new)
+  (match cell
+    (($ <cell> _ neighbors content strongest equivalent? merge
+               find-strongest handle-contradiction)
+     (let ((content* (merge content new)))
+       (set-cell-content! cell content*)
+       (let ((strongest* (find-strongest content*)))
+         (cond
+          ;; New strongest value is equivalent to the old one.  No need
+          ;; to alert propagators.
+          ((equivalent? strongest strongest*)
+           (set-cell-strongest! cell strongest*))
+          ;; Uh oh, a contradiction!  Call handler.
+          ((contradiction? strongest*)
+           (set-cell-strongest! cell strongest*)
+           (handle-contradiction cell))
+          ;; Strongest value has changed.  Alert the propagators!
+          (else
+           (set-cell-strongest! cell strongest*)
+           (for-each alert-propagator! neighbors))))))))
+
+(define (alert-propagator! propagator)
+  (queue-task! (propagator-activate propagator)))
+
+(define (make-propagator name inputs outputs activate)
+  (let ((propagator (%make-propagator (make-relations name)
+                                      inputs outputs activate)))
+    (add-child! (current-parent) propagator)
+    (for-each (lambda (cell)
+                (add-cell-neighbor! cell propagator))
+              inputs)
+    (alert-propagator! propagator)
+    propagator))
+
+(define (unusable-value? x)
+  (or (nothing? x) (contradiction? x)))
+
+(define (primitive-propagator name f)
+  (match-lambda*
+    ((inputs ... output)
+     (define (activate)
+       (let ((args (map cell-strongest inputs)))
+         (unless (any unusable-value? args)
+           (add-cell-content! output (apply f args)))))
+     (make-propagator name inputs (list output) activate))))
+
+(define (compound-propagator name inputs outputs build)
+  (let ((built? #f))
+    (define (maybe-build)
+      (unless (or built?
+                  (and (not (null? inputs))
+                       (every unusable-value? (map cell-strongest inputs))))
+        (parameterize ((current-parent (propagator-relations propagator)))
+          (build)
+          (set! built? #t))))
+    (define propagator (make-propagator name inputs outputs maybe-build))
+    propagator))
+
+(define (constraint-propagator name cells build)
+  (compound-propagator name cells cells build))
+
+
+(define (run)
+  (begin
+    (display "START")
+    (define a (make-cell "a"))
+    (define b (make-cell "b"))
+    (define c (make-cell "c"))
+    (define d (make-cell "d"))
+    (define output (make-cell "none"))
+    (add-cell-content! a 1)
+    (define (activate) #f)
+    (define p (primitive-propagator 'test activate))
+    (display "END")
+  ))
+
 (define (main args)
   (let* [
          (option-spec '( (version (single-char #\v) (value #f))
@@ -21,8 +208,11 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
           (display "pangemma version 0.01\n")
           (exit)))
     (if help-wanted
-        (format #t "pangemma
+        (begin
+          (format #t "pangemma
 Usage: pangemma [options...] filename(s)
   -v --version       Display version
   -h --help          Display this help
-"))))
+")
+          (exit)))
+    (run)))
diff --git a/doc/code/pangemma.md b/doc/code/pangemma.md
index fe86f3f..a5e969b 100644
--- a/doc/code/pangemma.md
+++ b/doc/code/pangemma.md
@@ -90,5 +90,18 @@ Let's start with default GEMMA behaviour and create the first cells to get to ex
 
 We'll break down to inspecting cell levels after. The genofile cells contain a file name (string).
 When the file gets read we will capture the state in a file and carry the file name of the new file forward.
-In this setup cells simply represent file names (for state). This allows us to simply read and write files in the C code.
+In this setup cells simply represent file names (for state).
+This allows us to simply read and write files in the C code.
 Later, when we wire up new propagators we may carry state in memory. The whole point of using this approach is that we really don't have to care!
+
+Our first simple implementation of the cell will simply contain a string referring to a file.
+Cells can be work in progress and incrementally improved.
+
+## Create propagators
+
+A propagator contains a list of inputs and an output cell. So we wire up the graph by adding inputs to propagators.
+Every propagator has state (too). I.e. it may be idle, computing and done.
+
+## The runner
+
+The runner visits the list of propagators and checks wether the inputs are complete and whether they have changed. On change computation has to happen updating the output cell.