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/eXene/examples/calc/acc.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/examples/calc/acc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* acc.sml
2 :     *
3 :     * COPYRIGHT (c) 1991 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * The accumulator of the calculator.
6 :     *)
7 :    
8 :     signature ACC =
9 :     sig
10 :    
11 :     datatype op_t = Plus | Minus | Divide | Times
12 :     datatype acc_msg = Op of op_t | Clear | Equal | Val of int
13 :     datatype out_val = OVal of int | OInfinity | OOverflow
14 :    
15 :     type acc
16 :    
17 :     val mkAcc : unit -> acc
18 :     val sendAcc : acc -> acc_msg -> unit
19 :     val evtOf : acc -> out_val CML.event
20 :    
21 :     end (* ACC *)
22 :    
23 :     structure Acc : ACC =
24 :     struct
25 :    
26 :     datatype op_t = Plus | Minus | Divide | Times
27 :     datatype acc_msg = Op of op_t | Clear | Equal | Val of int
28 :     datatype out_val = OVal of int | OInfinity | OOverflow
29 :    
30 :     datatype acc = Acc of (acc_msg CML.chan * out_val CML.chan)
31 :    
32 :     fun ratorOf Plus = Int.+
33 :     | ratorOf Minus = Int.-
34 :     | ratorOf Times = Int.*
35 :     | ratorOf Divide = Int.div
36 :    
37 :     fun mkAcc () = let
38 :     val msg_chan = CML.channel()
39 :     val val_chan = CML.channel()
40 :     fun get_msg () = CML.recv msg_chan
41 :     fun put_val v = CML.send(val_chan,OVal v)
42 :     fun put_inf () = CML.send(val_chan, OInfinity)
43 :     fun put_ovfl () = CML.send(val_chan, OOverflow)
44 :    
45 :     fun update (v,v') = let
46 :     val newval = 10*v + v'
47 :     in
48 :     put_val newval;
49 :     newval
50 :     end
51 :     handle Overflow => v
52 :     fun doErr Div = put_inf ()
53 :     | doErr Overflow = put_ovfl ()
54 :     | doErr a = raise a
55 :     fun initState () = (case (get_msg ())
56 :     of Op _ => initState ()
57 :     | Clear => doClear ()
58 :     | Equal => initState ()
59 :     | Val v => (put_val v; readNum (SOME v, NONE))
60 :     (* end case *))
61 :     and readNum arg = (case (get_msg ())
62 :     of (Op rator') => (case arg
63 :     of (NONE,NONE) => initState () (* impossible *)
64 :     | (NONE,SOME (st, rator)) => readNum (NONE, SOME (st, rator'))
65 :     | (SOME v, NONE) => readNum (NONE, SOME (v, rator'))
66 :     | (SOME v, SOME (st, rator)) => let
67 :     val newval = (ratorOf rator) (st, v)
68 :     in
69 :     put_val newval;
70 :     readNum(NONE, SOME (newval, rator'))
71 :     end
72 :     handle err => (doErr err; initState ())
73 :     (* end case *))
74 :     | Clear => doClear ()
75 :     | Equal => doEqual arg
76 :     | Val v' => (case arg
77 :     of (NONE, st) => (put_val v'; readNum (SOME v', st))
78 :     | (SOME v, st) => readNum (SOME(update (v,v')), st)
79 :     (* end case *))
80 :     (* end case *))
81 :     and doClear () = (put_val 0;initState())
82 :     and doEqual (SOME v, SOME (st, rator)) = (
83 :     (put_val ((ratorOf rator) (st, v))) handle err => doErr err;
84 :     initState())
85 :     | doEqual _ = initState()
86 :    
87 :     in
88 :     CML.spawn initState;
89 :     Acc(msg_chan, val_chan)
90 :     end (* mkAcc *)
91 :    
92 :     fun sendAcc (Acc(msg_chan, _)) msg = CML.send (msg_chan, msg)
93 :    
94 :     fun evtOf (Acc(_, val_chan)) = CML.recvEvt val_chan
95 :    
96 :     end (* Acc *)
97 :    

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