Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/smlnj-lib/Reactive/OLD/react.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/Reactive/OLD/react.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7 - (view) (download)

1 : monnier 7 (* react.sml
2 :     *
3 :     * COPYRIGHT (c) 1997 AT&T Research Labs.
4 :     * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies
5 :     *
6 :     * A simple ractive engine modelled after RC and SugarCubes.
7 :     *)
8 :    
9 :     structure React :> REACT =
10 :     struct
11 :    
12 :     structure I = Instr
13 :     structure C = Config
14 :    
15 :     type instruction = I.instruction
16 :     type machine = I.machine
17 :    
18 :     datatype state = datatype I.state
19 :    
20 :     (* variables *)
21 :     exception VarConflict of string
22 :     datatype 'a var = V of {
23 :     name : string,
24 :     ts : I.instant ref,
25 :     v : 'a ref
26 :     }
27 :     fun newVar name v = V{name=name, ts=ref 0, v=ref v}
28 :     fun get (V{ts, v, ...}) m = (ts := I.now m; !v)
29 :     fun put (V{name, ts, v}, v') m = if (!ts = I.now m)
30 :     then raise VarConflict name
31 :     else (ts := I.now m; v := v')
32 :    
33 :     (* signals and configurations *)
34 :     type config = C.config
35 :     val posConfig = C.posConfig
36 :     val negConfig = C.negConfig
37 :     val orConfig = C.orConfig
38 :     val andConfig = C.andConfig
39 :    
40 :     (* standard instruction methods *)
41 :     type instr_state = {termFlg : bool ref}
42 :     fun isTermMeth (s : instr_state) () = !(#termFlg s)
43 :     fun terminateMeth (s : instr_state) () = (#termFlg s) := true
44 :     fun resetMeth (s : instr_state) () = (#termFlg s) := false
45 :     fun preemptMeth _ () = ()
46 :     fun newState () = {termFlg=ref false}
47 :     fun newInstr {reset, activation} = I.newInstruction {
48 :     isTerm = isTermMeth,
49 :     terminate = terminateMeth,
50 :     reset = reset,
51 :     preempt = preemptMeth,
52 :     activation = activation
53 :     } (newState())
54 :    
55 :     fun || (i1, i2) = let
56 :     val leftSts = ref SUSP
57 :     val rightSts = ref SUSP
58 :     fun resetMeth' s () = (resetMeth s (); I.reset i1; I.reset i2)
59 :     fun activationMeth _ m = (
60 :     if (!leftSts = SUSP) then leftSts := I.activate(i1, m) else ();
61 :     if (!rightSts = SUSP) then rightSts := I.activate(i2, m) else ();
62 :     case (!leftSts, !rightSts)
63 :     of (TERM, TERM) => TERM
64 :     | (SUSP, _) => SUSP
65 :     | (_, SUSP) => SUSP
66 :     | _ => (leftSts := SUSP; rightSts := SUSP; STOP)
67 :     (* end case *))
68 :     in
69 :     newInstr {reset = resetMeth', activation = activationMeth}
70 :     end
71 :    
72 :     fun & (i1, i2) = let
73 :     fun resetMeth' s () = (resetMeth s (); I.reset i1; I.reset i2)
74 :     fun activationMeth _ m =
75 :     if (I.isTerm i1)
76 :     then I.activate(i2, m)
77 :     else (case I.activate(i1, m)
78 :     of TERM => I.activate(i2, m)
79 :     | res => res
80 :     (* end case *))
81 :     in
82 :     newInstr {reset = resetMeth', activation = activationMeth}
83 :     end
84 :    
85 :     val nothing = I.newInstruction {
86 :     isTerm = fn _ => fn () => true,
87 :     terminate = fn _ => fn () => (),
88 :     reset = fn _ => fn () => (),
89 :     preempt = preemptMeth,
90 :     activation = fn _ => fn _ => TERM
91 :     } ()
92 :    
93 :     fun stop () = newInstr {reset = resetMeth, activation = fn _ => fn _ => STOP}
94 :    
95 :     fun suspend () = newInstr {
96 :     reset = resetMeth,
97 :     activation = fn s => fn _ => (terminateMeth s (); STOP)
98 :     }
99 :    
100 :     fun action f = newInstr {
101 :     reset = resetMeth,
102 :     activation = fn _ => fn m => (f m; TERM)
103 :     }
104 :    
105 :     fun repeat (n, i) = let
106 :     val counter = ref n
107 :     fun resetMeth' s () = (resetMeth s (); counter := n)
108 :     fun activationMeth s m =
109 :     if (!counter > 0)
110 :     then (case I.activate(i, m)
111 :     of TERM => (counter := !counter-1; I.reset i; TERM)
112 :     | res => res
113 :     (* end case *))
114 :     else TERM
115 :     in
116 :     newInstr {reset = resetMeth', activation = activationMeth}
117 :     end
118 :    
119 :     fun close i = let
120 :     fun activationMeth s m = (case I.activate(i, m)
121 :     of SUSP => activationMeth s m
122 :     | res => res
123 :     (* end case *))
124 :     in
125 :     newInstr {reset = resetMeth, activation = activationMeth}
126 :     end
127 :    
128 :     fun loop i = let
129 :     val endReached = ref false
130 :     fun resetMeth' s () = (resetMeth s (); endReached := false)
131 :     fun activationMeth s m = (case I.activate(i, m)
132 :     of TERM => if (!endReached)
133 :     then (
134 :     I.say(m, "instantaneous loop detected\n");
135 :     STOP)
136 :     else (endReached := true; I.reset i; TERM)
137 :     | STOP => (endReached := false; STOP)
138 :     | SUSP => SUSP
139 :     (* end case *))
140 :     in
141 :     newInstr {reset = resetMeth', activation = activationMeth}
142 :     end
143 :    
144 :     fun signal (name, i) = let
145 :     val name' = Atom.atom name
146 :     val state = ref 0
147 :     fun resetMeth' s () = (resetMeth s (); I.reset i; state := 0)
148 :     fun activationMeth s m = let
149 :     val save = I.getSignal(m, name')
150 :     in
151 :     I.putSignal(m, name', SOME state);
152 :     I.activate (i, m) before
153 :     I.putSignal(m, name', save)
154 :     end
155 :     in
156 :     newInstr {reset = resetMeth', activation = activationMeth}
157 :     end
158 :    
159 :     fun emit name = let
160 :     val name' = Atom.atom name
161 :     fun activationMeth s m = (
162 :     I.newMove m;
163 :     I.emit(m, name');
164 :     TERM)
165 :     in
166 :     newInstr {reset = resetMeth, activation = activationMeth}
167 :     end
168 :    
169 :     fun await c = let
170 :     fun activationMeth s m = (case C.fixedEval(m, c)
171 :     of NONE => SUSP
172 :     | (SOME true) => STOP
173 :     | (SOME false) => (
174 :     terminateMeth s ();
175 :     if (I.isEndOfInstant m) then STOP else TERM)
176 :     (* end case *))
177 :     in
178 :     newInstr {reset = resetMeth, activation = activationMeth}
179 :     end
180 :    
181 :     fun when (c, i1, i2) = let
182 :     val value = ref NONE
183 :     fun resetMeth' s m = (
184 :     resetMeth s m;
185 :     I.reset i1; I.reset i2;
186 :     value := NONE)
187 :     fun activationMeth' s m = (case !value
188 :     of NONE => (case C.fixedEval(m, c)
189 :     of NONE => SUSP
190 :     | (SOME v) => (
191 :     value := SOME v;
192 :     if (I.isEndOfInstant m)
193 :     then STOP
194 :     else if v
195 :     then I.activate(i1, m)
196 :     else I.activate(i2, m))
197 :     (* end case *))
198 :     | (SOME true) => I.activate(i1, m)
199 :     | (SOME false) => I.activate(i2, m)
200 :     (* end case *))
201 :     in
202 :     newInstr {reset = resetMeth', activation = activationMeth'}
203 :     end
204 :    
205 :     fun trapWith (c, i1, i2) = let
206 :     val activeHandle = ref false
207 :     val resumeBody = ref true
208 :     fun resetMeth' s m = (
209 :     resetMeth s m;
210 :     I.reset i1; I.reset i2;
211 :     activeHandle := false;
212 :     resumeBody := true)
213 :     fun activationMeth' s m =
214 :     if (! activeHandle)
215 :     then I.activate(i2, m)
216 :     else let
217 :     fun chkConfig () = (case C.fixedEval(m, c)
218 :     of NONE => SUSP
219 :     | (SOME true) => ( (* actual preemption *)
220 :     I.preempt i1;
221 :     activeHandle := true;
222 :     if (I.isEndOfInstant m)
223 :     then STOP
224 :     else I.activate(i2, m))
225 :     | (SOME false) => (
226 :     resumeBody := true;
227 :     STOP)
228 :     (* end case *))
229 :     in
230 :     if (! resumeBody)
231 :     then (case I.activate(i1, m)
232 :     of STOP => (resumeBody := false; chkConfig())
233 :     | res => res
234 :     (* end case *))
235 :     else chkConfig()
236 :     end
237 :     in
238 :     newInstr {reset = resetMeth', activation = activationMeth'}
239 :     end
240 :    
241 :     fun trap (c, i) = trapWith(c, i, nothing)
242 :    
243 :     end;

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0