/[cells]/cells/synapse.lisp
ViewVC logotype

Contents of /cells/synapse.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.16 - (show annotations)
Sat Mar 15 15:18:34 2008 UTC (6 years, 1 month ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.15: +4 -5 lines
Mostly differentiating new *depender* from CAR of *call-stack* so we can clear former to get without-c-dependency behavior without clearing *call-stack*, in turn to detect cyclic calculation even if doing a without-c-dependency.
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*-
2 #|
3
4 Cells -- Automatic Dataflow Managememnt
5
6 Copyright (C) 1995, 2006 by Kenneth Tilton
7
8 This library is free software; you can redistribute it and/or
9 modify it under the terms of the Lisp Lesser GNU Public License
10 (http://opensource.franz.com/preamble.html), known as the LLGPL.
11
12 This library is distributed WITHOUT ANY WARRANTY; without even
13 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
15 See the Lisp Lesser GNU Public License for more details.
16
17 |#
18
19 (in-package :cells)
20
21 (eval-when (:compile-toplevel :load-toplevel :execute)
22 (export '(mk-synapse f-delta f-sensitivity f-plusp f-zerop fdifferent with-synapse)))
23
24 (defmacro with-synapse (synapse-id (&rest closure-vars) &body body)
25 (let ((syn-id (gensym)))
26 `(let* ((,syn-id ,synapse-id)
27 (synapse (or (find ,syn-id (cd-useds *depender*) :key 'c-slot-name)
28 (let ((new-syn
29 (let (,@closure-vars)
30 (make-c-dependent
31 :model (c-model *depender*)
32 :slot-name ,syn-id
33 :code ',body
34 :synaptic t
35 :rule (c-lambda ,@body)))))
36 (record-caller new-syn)
37 new-syn))))
38 (prog1
39 (multiple-value-bind (v p)
40 (with-integrity ()
41 (ensure-value-is-current synapse :synapse *depender*))
42 (values v p))
43 (record-caller synapse)))))
44
45
46 ;__________________________________________________________________________________
47 ;
48
49 (defmethod delta-exceeds (bool-delta sensitivity (subtypename (eql 'boolean)))
50 (unless (eql bool-delta :unchanged)
51 (or (eq sensitivity t)
52 (eq sensitivity bool-delta))))
53
54 (defmethod delta-diff ((new number) (old number) subtypename)
55 (declare (ignore subtypename))
56 (- new old))
57
58 (defmethod delta-identity ((dispatcher number) subtypename)
59 (declare (ignore subtypename))
60 0)
61
62 (defmethod delta-abs ((n number) subtypename)
63 (declare (ignore subtypename))
64 (abs n))
65
66 (defmethod delta-exceeds ((d1 number) (d2 number) subtypename)
67 (declare (ignore subtypename))
68 (> d1 d2))
69
70 (defmethod delta-greater-or-equal ((d1 number) (d2 number) subtypename)
71 (declare (ignore subtypename))
72 (>= d1 d2))
73
74 ;_________________________________________________________________________________
75 ;
76 (defmethod delta-diff (new old (subtypename (eql 'boolean)))
77 (if new
78 (if old
79 :unchanged
80 :on)
81 (if old
82 :off
83 :unchanged)))
84
85
86 (defmethod delta-identity (dispatcher (subtypename (eql 'boolean)))
87 (declare (ignore dispatcher))
88 :unchanged)
89

  ViewVC Help
Powered by ViewVC 1.1.5