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/reactive.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/Reactive/reactive.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* reactive.sml
2 :     *
3 :     * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies.
4 :     *
5 :     * A simple ractive engine modelled after RC and SugarCubes.
6 :     *)
7 :    
8 :     structure Reactive : REACTIVE =
9 :     struct
10 :    
11 :     structure I = Instruction
12 :     structure M = Machine
13 :    
14 :     type machine = M.machine
15 :     type instruction = machine Instruction.instr
16 :     type signal = I.signal
17 :     type config = I.signal I.config
18 :     type in_signal = M.in_signal
19 :     type out_signal = M.out_signal
20 :    
21 :     (* used to bind internal signal names *)
22 :     structure AMap = AtomBinaryMap
23 :    
24 :     exception UnboundSignal of I.signal
25 :    
26 :     fun machine {inputs, outputs, body} = let
27 :     val nextId = ref 0
28 :     val sigList = ref []
29 :     fun newSignal s = let
30 :     val id = !nextId
31 :     val s' = M.SIG{name=s, id=id, state = ref 0}
32 :     in
33 :     nextId := id+1;
34 :     sigList := s' :: !sigList;
35 :     s'
36 :     end
37 :     fun bindSig (env, s) = (case AMap.find (env, s)
38 :     of NONE => raise UnboundSignal s
39 :     | (SOME s') => s'
40 :     (* end case *))
41 :     fun trans (instr, env) = (case instr
42 :     of I.||(i1, i2) => M.||(trans(i1, env), trans(i2, env))
43 :     | I.&(i1, i2) => M.&(trans(i1, env), trans(i2, env))
44 :     | I.nothing => M.nothing
45 :     | I.stop => M.stop()
46 :     | I.suspend => M.suspend()
47 :     | I.action act => M.action act
48 :     | I.exec{start, stop, done} =>
49 :     M.exec{start=start, stop=stop, done=done}
50 :     | I.ifThenElse(pred, i1, i2) =>
51 :     M.ifThenElse(pred, trans(i1, env), trans(i2, env))
52 :     | I.repeat(cnt, i) => M.repeat(cnt, trans(i, env))
53 :     | I.loop i => M.loop(trans(i, env))
54 :     | I.close i => M.close(trans(i, env))
55 :     | I.signal(s, i) => trans(i, AMap.insert(env, s, newSignal s))
56 :     | I.rebind(s1, s2, i) =>
57 :     trans(i, AMap.insert(env, s2, bindSig(env, s1)))
58 :     | I.emit s => M.emit(bindSig(env, s))
59 :     | I.await cfg => M.await(transConfig(cfg, env))
60 :     | I.when(cfg, i1, i2) =>
61 :     M.when(transConfig(cfg, env), trans(i1, env), trans(i2, env))
62 :     | I.trapWith(cfg, i1, i2) =>
63 :     M.trapWith(transConfig(cfg, env), trans(i1, env), trans(i2, env))
64 :     (* end case *))
65 :     and transConfig (cfg, env) = let
66 :     fun transCfg (I.posConfig s) = I.posConfig(bindSig(env, s))
67 :     | transCfg (I.negConfig s) = I.negConfig(bindSig(env, s))
68 :     | transCfg (I.orConfig(cfg1, cfg2)) =
69 :     I.orConfig(transCfg cfg1, transCfg cfg2)
70 :     | transCfg (I.andConfig(cfg1, cfg2)) =
71 :     I.andConfig(transCfg cfg1, transCfg cfg2)
72 :     in
73 :     transCfg cfg
74 :     end
75 :     val inputs' = List.map newSignal inputs
76 :     val outputs' = List.map newSignal outputs
77 :     fun ins (s as M.SIG{name, ...}, env) = AMap.insert(env, name, s)
78 :     val initialEnv =
79 :     List.foldl ins (List.foldl ins AMap.empty inputs') outputs'
80 :     val body' = trans (body, initialEnv)
81 :     in
82 :     M.M{
83 :     now = ref 0,
84 :     moveFlg = ref false,
85 :     endOfInstant = ref false,
86 :     prog = body',
87 :     signals = !sigList,
88 :     inputs = inputs',
89 :     outputs = outputs'
90 :     }
91 :     end
92 :    
93 :     val run = M.runMachine
94 :     val reset = M.resetMachine
95 :     val inputsOf = M.inputsOf
96 :     val outputsOf = M.outputsOf
97 :     val inputSignal = M.inputSignal
98 :     val outputSignal = M.outputSignal
99 :     val setInSignal = M.setInSignal
100 :     val getInSignal = M.getInSignal
101 :     val getOutSignal = M.getOutSignal
102 :    
103 :     val posConfig = I.posConfig
104 :     val negConfig = I.negConfig
105 :     val orConfig = I.orConfig
106 :     val andConfig = I.andConfig
107 :    
108 :     val || = I.||
109 :     val & = I.&
110 :     val nothing = I.nothing
111 :     val stop = I.stop
112 :     val suspend = I.suspend
113 :     val action = I.action
114 :     val exec = I.exec
115 :     val ifThenElse = I.ifThenElse
116 :     val repeat = I.repeat
117 :     val loop = I.loop
118 :     val close = I.close
119 :     val signal = I.signal
120 :     val rebind = I.rebind
121 :     val when = I.when
122 :     val trapWith = I.trapWith
123 :     fun trap (c, i) = I.trapWith(c, i, I.nothing)
124 :     val emit = I.emit
125 :     val await = I.await
126 :    
127 :     end

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