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

Parent Directory | 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