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

Annotation of /sml/trunk/src/smlnj-lib/Controls/controls.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1193 - (view) (download)

1 : blume 1145 (* controls.sml
2 :     *
3 : jhr 1193 * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 : blume 1145 *)
5 :    
6 : jhr 1193 structure Controls : CONTROLS =
7 :     struct
8 : blume 1145
9 : jhr 1193 open ControlReps
10 : blume 1145
11 : jhr 1193 fun control {name, pri, obscurity, help, ctl} = Ctl{
12 :     name = Atom.atom name,
13 :     get = fn () => !ctl,
14 :     set = fn v => ctl := v,
15 :     priority = pri,
16 :     obscurity = obscurity,
17 :     help = help
18 :     }
19 : blume 1145
20 : jhr 1193 fun genControl {name, pri, obscurity, help, default} = control {
21 :     name = name, pri = pri, obscurity = obscurity, help = help,
22 :     ctl = ref default
23 :     }
24 : blume 1145
25 : jhr 1193 (* this exception is raised to communicate that there is a syntax error
26 :     * in a string representation of a control value.
27 :     *)
28 :     exception ValueSyntax of {ctlName : string, value : string}
29 : blume 1145
30 : jhr 1193 fun stringControl {tyName, fromString, toString} = let
31 :     fun mk (Ctl{name, get, set, priority, obscurity, help}) = Ctl{
32 :     name = name,
33 :     get = fn () => toString(get()),
34 :     set = fn sval => (case fromString sval
35 :     of NONE => raise ValueSyntax{
36 :     ctlName = Atom.toString name,
37 :     value = sval
38 :     }
39 :     | SOME v => set v
40 :     (* end case *)),
41 :     priority = priority,
42 :     obscurity = obscurity,
43 :     help = help
44 :     }
45 :     in
46 :     mk
47 :     end
48 : blume 1145
49 : jhr 1193 fun name (Ctl{name, ...}) = Atom.toString name
50 :     fun get (Ctl{get, ...}) = get()
51 :     fun set (Ctl{set, ...}, v) = set v
52 :     fun info (Ctl{priority, obscurity, help, ...}) = {
53 :     priority = priority, obscurity = obscurity, help = help
54 :     }
55 : blume 1145
56 : jhr 1193 fun compare (Ctl{priority=p1, ...}, Ctl{priority=p2, ...}) = let
57 :     fun collate ([], []) = EQUAL
58 :     | collate ([], _) = LESS
59 :     | collate (_, []) = GREATER
60 :     | collate (x::xs, y::ys) =
61 :     if (x = y) then collate(xs, ys)
62 :     else if (x < y) then LESS
63 :     else GREATER
64 :     in
65 :     collate (p1, p2)
66 :     end
67 : blume 1145
68 : jhr 1193 end

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