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/cm/depend/checksharing.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/depend/checksharing.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 370 - (view) (download)

1 : blume 303 (*
2 :     * Check for consistency of "private" and "shared" annotations.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 :     signature CHECKSHARING = sig
9 :     val check : GroupGraph.group * GeneralParams.info -> bool
10 :     end
11 :    
12 :     structure CheckSharing :> CHECKSHARING = struct
13 :    
14 :     structure DG = DependencyGraph
15 :     structure EM = GenericVC.ErrorMsg
16 :     structure PP = PrettyPrint
17 :    
18 :     val empty = StringSet.empty
19 :    
20 :     fun check (GroupGraph.GROUP { exports, ... }, gp) = let
21 :    
22 :     val ok = ref true
23 :    
24 :     fun check (NONE, _, s, _) = s
25 :     | check (SOME false, x, s, _) = StringSet.add (s, x)
26 :     | check (SOME true, x, s, err) = let
27 :     fun ppb pps = let
28 :     fun loop [] = ()
29 :     | loop (h :: t) =
30 :     (PP.add_string pps h;
31 :     PP.add_newline pps;
32 :     loop t)
33 :     in
34 :     PP.add_newline pps;
35 :     PP.add_string pps
36 :     "because of dependence on non-shareable state in:";
37 :     PP.add_newline pps;
38 :     loop (StringSet.listItems s)
39 :     end
40 :     in
41 :     if StringSet.isEmpty s then ()
42 :     else (err EM.COMPLAIN ("cannot share state of " ^ x) ppb;
43 :     ok := false);
44 : blume 320 s
45 : blume 303 end
46 :    
47 : blume 305 val smlmap = ref SmlInfoMap.empty
48 : blume 303 val stablemap = ref StableMap.empty
49 :    
50 :     fun bn (DG.PNODE _, s) = s
51 :     | bn (DG.BNODE { bininfo = i, localimports, globalimports }, s) =
52 :     case StableMap.find (!stablemap, i) of
53 :     SOME s' => StringSet.union (s, s')
54 :     | NONE => let
55 : blume 370 val gs = foldl bglobi empty globalimports
56 :     val ls = foldl bloci gs localimports
57 : blume 303 val s' = check (BinInfo.share i, BinInfo.describe i, ls,
58 : blume 306 BinInfo.error i)
59 : blume 303 in
60 :     stablemap := StableMap.insert (!stablemap, i, s');
61 :     StringSet.union (s, s')
62 :     end
63 :    
64 : blume 370 and bglobi ((n, _), s) = fbn (n, s)
65 :     and bloci ((n, _), s) = bn (n, s)
66 :    
67 : blume 303 and fbn ((_, n), s) = bn (n, s)
68 :    
69 : blume 370 fun sn (DG.SNODE n, s) = let
70 :     val { smlinfo = i, localimports, globalimports, ... } = n
71 :     in
72 : blume 305 case SmlInfoMap.find (!smlmap, i) of
73 : blume 303 SOME s' => StringSet.union (s, s')
74 :     | NONE => let
75 : blume 370 val gs = foldl globi empty globalimports
76 :     val ls = foldl loci gs localimports
77 : blume 354 val s' = check (SmlInfo.share i, SmlInfo.descr i, ls,
78 : blume 303 SmlInfo.error gp i)
79 :     in
80 : blume 305 smlmap := SmlInfoMap.insert (!smlmap, i, s');
81 : blume 303 StringSet.union (s, s')
82 :     end
83 : blume 370 end
84 : blume 303
85 : blume 370 and loci ((n, _), s) = sn (n, s)
86 :     and globi ((n, _), s) = fsbn (n, s)
87 :    
88 : blume 303 and sbn (DG.SB_BNODE n, s) = bn (n, s)
89 :     | sbn (DG.SB_SNODE n, s) = sn (n, s)
90 :    
91 :     and fsbn ((_, n), s) = sbn (n, s)
92 :    
93 :     fun impexp (n, _) = ignore (fsbn (n, StringSet.empty))
94 :     in
95 :     SymbolMap.app impexp exports;
96 :     !ok
97 :     end
98 :     end

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