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

Contents of /cells/constructors.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19 - (show annotations)
Sun Oct 12 01:21:07 2008 UTC (5 years, 6 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.18: +29 -11 lines
Just trying to get a patch in for record-caller
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-now!
22 (export '(.cache-bound-p
23
24 ;; Cells Constructors
25 c?n
26 c?once
27 c?n-until
28 c?1
29 c_1
30 c?+n
31
32 ;; Debug Macros and Functions
33 c?dbg
34 c_?dbg
35 c-input-dbg
36
37 )))
38
39 ;___________________ constructors _______________________________
40
41 (defmacro c-lambda (&body body)
42 `(c-lambda-var (slot-c) ,@body))
43
44 (defmacro c-lambda-var ((c) &body body)
45 `(lambda (,c &aux (self (c-model ,c))
46 (.cache (c-value ,c))
47 (.cache-bound-p (cache-bound-p ,c)))
48 (declare (ignorable .cache .cache-bound-p self))
49 ,@body))
50
51 (defmacro with-c-cache ((fn) &body body)
52 (let ((new (gensym)))
53 `(or (bwhen (,new (progn ,@body))
54 (funcall ,fn ,new .cache))
55 .cache)))
56
57 ;-----------------------------------------
58
59 (defmacro c? (&body body)
60 `(make-c-dependent
61 :code #+its-alive! nil #-its-alive! ',body
62 :value-state :unevaluated
63 :rule (c-lambda ,@body)))
64
65 (defmacro c?+n (&body body)
66 `(make-c-dependent
67 :inputp t
68 :code #+its-alive! nil #-its-alive! ',body
69 :value-state :unevaluated
70 :rule (c-lambda ,@body)))
71
72 (defmacro c?n (&body body)
73 `(make-c-dependent
74 :code #+its-alive! nil #-its-alive! '(without-c-dependency ,@body)
75 :inputp t
76 :value-state :unevaluated
77 :rule (c-lambda (without-c-dependency ,@body))))
78
79 (export! c?n-dbg)
80
81 (defmacro c?n-dbg (&body body)
82 `(make-c-dependent
83 :code #+its-alive! nil #-its-alive! '(without-c-dependency ,@body)
84 :inputp t
85 :debug t
86 :value-state :unevaluated
87 :rule (c-lambda (without-c-dependency ,@body))))
88
89 (defmacro c?n-until (args &body body)
90 `(make-c-dependent
91 :optimize :when-value-t
92 :code #+its-alive! nil #-its-alive! ',body
93 :inputp t
94 :value-state :unevaluated
95 :rule (c-lambda ,@body)
96 ,@args))
97
98 (defmacro c?once (&body body)
99 `(make-c-dependent
100 :code #+its-alive! nil #-its-alive! '(without-c-dependency ,@body)
101 :inputp nil
102 :value-state :unevaluated
103 :rule (c-lambda (without-c-dependency ,@body))))
104
105 (defmacro c_1 (&body body)
106 `(make-c-dependent
107 :code #+its-alive! nil #-its-alive! '(without-c-dependency ,@body)
108 :inputp nil
109 :lazy t
110 :value-state :unevaluated
111 :rule (c-lambda (without-c-dependency ,@body))))
112
113 (defmacro c?1 (&body body)
114 `(c?once ,@body))
115
116 (defmacro c?dbg (&body body)
117 `(make-c-dependent
118 :code #+its-alive! nil #-its-alive! ',body
119 :value-state :unevaluated
120 :debug t
121 :rule (c-lambda ,@body)))
122
123 (defmacro c?_ (&body body)
124 `(make-c-dependent
125 :code #+its-alive! nil #-its-alive! ',body
126 :value-state :unevaluated
127 :lazy t
128 :rule (c-lambda ,@body)))
129
130 (defmacro c_? (&body body)
131 "Lazy until asked, then eagerly propagating"
132 `(make-c-dependent
133 :code #+its-alive! nil #-its-alive! ',body
134 :value-state :unevaluated
135 :lazy :until-asked
136 :rule (c-lambda ,@body)))
137
138 (defmacro c_?dbg (&body body)
139 "Lazy until asked, then eagerly propagating"
140 `(make-c-dependent
141 :code #+its-alive! nil #-its-alive! ',body
142 :value-state :unevaluated
143 :lazy :until-asked
144 :rule (c-lambda ,@body)
145 :debug t))
146
147 (defmacro c?? ((&key (tagp nil) (in nil) (out t))&body body)
148 (let ((result (copy-symbol 'result))
149 (thetag (gensym)))
150 `(make-c-dependent
151 :code ',body
152 :value-state :unevaluated
153 :rule (c-lambda
154 (let ((,thetag (gensym "tag"))
155 (*trcdepth* (1+ *trcdepth*))
156 )
157 (declare (ignorable self ,thetag))
158 ,(when in
159 `(trc "c??> entry" (c-slot-name c) (c-model c) (when ,tagp ,thetag)))
160 (count-it :c?? (c-slot-name c) (md-name (c-model c)))
161 (let ((,result (progn ,@body)))
162 ,(when out `(trc "c?? result:" ,result (c-slot-name c) (when ,tagp ,thetag)))
163 ,result))))))
164
165 (defmacro c-formula ((&rest keys &key lazy &allow-other-keys) &body forms)
166 (assert (member lazy '(nil t :once-asked :until-asked :always)))
167 `(make-c-dependent
168 :code #+its-alive! nil #-its-alive! ',forms
169 :value-state :unevaluated
170 :rule (c-lambda ,@forms)
171 ,@keys))
172
173 (defmacro c-input ((&rest keys) &optional (value nil valued-p))
174 `(make-cell
175 :inputp t
176 :value-state ,(if valued-p :valid :unbound)
177 :value ,value
178 ,@keys))
179
180 (defmacro c-in (value)
181 `(make-cell
182 :inputp t
183 :value-state :valid
184 :value ,value))
185
186 (export! c-in-lazy c_in)
187
188 (defmacro c-in-lazy (&body body)
189 `(c-input (:lazy :once-asked) (progn ,@body)))
190
191 (defmacro c_in (&body body)
192 `(c-input (:lazy :once-asked) (progn ,@body)))
193
194 (defmacro c-input-dbg (&optional (value nil valued-p))
195 `(make-cell
196 :inputp t
197 :debug t
198 :value-state ,(if valued-p :valid :unbound)
199 :value ,value))
200
201 (defmacro c... ((value) &body body)
202 `(make-c-drifter
203 :code ',body
204 :value-state :valid
205 :value ,value
206 :rule (c-lambda ,@body)))
207
208 (defmacro c-abs (value &body body)
209 `(make-c-drifter-absolute
210 :code ',body
211 :value-state :valid
212 :value ,value
213 :rule (c-lambda ,@body)))
214
215
216 (defmacro c-envalue (&body body)
217 `(make-c-envaluer
218 :envalue-rule (c-lambda ,@body)))
219

  ViewVC Help
Powered by ViewVC 1.1.5