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 /tests/trunk/bugs/tests.obsolete/bug1315.sml
ViewVC logotype

Annotation of /tests/trunk/bugs/tests.obsolete/bug1315.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2460 - (view) (download)

1 : dbm 548 (* bug1315.sml *)
2 :    
3 :     signature ASIG =
4 :     sig
5 :     type g
6 :     type n
7 :     type 'a t
8 :     val newG: unit -> g
9 :     val newN: g -> n
10 :     val nodes: g -> n list
11 :     val empty: 'a t
12 :     val add: 'a t * n * 'a -> 'a t
13 :     val look: 'a t * n -> 'a option
14 :     val id: n -> string
15 :     end;
16 :    
17 :     structure A :> ASIG =
18 :     struct
19 :     type g = (int * int list) ref
20 :     type n = g * int
21 :     type 'a t = (n * 'a) list
22 :    
23 :     fun newG () = ref (0, [])
24 :    
25 :     fun newN (g as ref (n, l)) = let
26 :     val n' = n + 1
27 :     val l' = n' :: l
28 :     val _ = print (concat ["ID of new node is: ", Int.toString n', "\n"])
29 :     in
30 :     g := (n', l');
31 :     (g, n')
32 :     end
33 :    
34 :     fun nodes (g as ref (_, l)) = map (fn n => (g, n)) l
35 :     val empty = []
36 :    
37 :     fun add (t, n, x) = (n, x) :: t
38 :    
39 :     fun look (t, (_, ni)) = let
40 :     fun sameNode ((_, ni'), _) = ni = ni'
41 :     in
42 :     Option.map #2 (List.find sameNode t)
43 :     end
44 :    
45 :     fun id (_, ni) = Int.toString ni
46 :     end;
47 :    
48 :     signature BSIG =
49 :     sig
50 :     structure A : ASIG
51 :     datatype t = B of { g: A.g, nstring: A.n -> string }
52 :     val mk: string list -> t
53 :     end;
54 :    
55 :     structure B : BSIG =
56 :     struct
57 :     structure A = A
58 :     datatype t = B of { g: A.g, nstring: A.n -> string }
59 :    
60 :     fun mk sl = let
61 :     val g = A.newG ()
62 :     fun loop ([], t) =
63 :     let
64 :     fun nstring n =
65 :     valOf (A.look (t, n))
66 :     handle e => let
67 :     val _ = print "!!!! BOGUS exception... "
68 :     in
69 :     print (concat ["node ID is: ", A.id n, "\n"]);
70 :     raise e
71 :     end
72 :     in
73 :     B { g = g, nstring = nstring }
74 :     end
75 :     | loop (s :: ss, t) = let
76 :     val n = A.newN g
77 :     in
78 :     loop (ss, A.add (t, n, s))
79 :     end
80 :     in
81 :     loop (sl, A.empty)
82 :     end
83 :     end
84 :    
85 :     (* -------------------------------------------------- *)
86 :     (* structure C = (* scenario 1 *) *)
87 :     functor C (B: BSIG) = (* scenario 2 *)
88 :     struct
89 :     structure A = B.A
90 :    
91 :     fun show (B.B { g, nstring }) =
92 :     app (fn n => print (nstring n ^ "\n")) (A.nodes g)
93 :    
94 :     end
95 :    
96 :     structure C = C (B) (* scenario 2 *)
97 :     (* -------------------------------------------------- *)
98 :    
99 :     (* run the sucker... *)
100 :     val test = C.show (B.mk ["a", "b", "c"])

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