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 879 - (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 : blume 387 local
9 : blume 303 structure DG = DependencyGraph
10 : blume 879 structure EM = ErrorMsg
11 : blume 303 structure PP = PrettyPrint
12 : blume 387 in
13 :     signature CHECKSHARING = sig
14 :     val check : DG.impexp SymbolMap.map * GeneralParams.info -> unit
15 :     end
16 : blume 303
17 : blume 387 structure CheckSharing :> CHECKSHARING = struct
18 : blume 303
19 : blume 387 fun check (exports, gp) = let
20 : blume 303
21 : blume 387 fun check (Sharing.DONTCARE, _, s, _) =
22 :     (s, if StringSet.isEmpty s then Sharing.SHARE false
23 :     else Sharing.DONTSHARE)
24 :     | check (Sharing.PRIVATE, x, _, _) =
25 :     (StringSet.singleton x, Sharing.DONTSHARE)
26 :     | check (Sharing.SHARED, x, s, err) = let
27 : blume 303 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 : blume 387 if StringSet.isEmpty s then (s, Sharing.SHARE true)
42 : blume 303 else (err EM.COMPLAIN ("cannot share state of " ^ x) ppb;
43 : blume 387 (s, Sharing.DONTSHARE))
44 : blume 303 end
45 :    
46 : blume 305 val smlmap = ref SmlInfoMap.empty
47 : blume 303
48 : blume 537 fun bn (DG.BNODE { bininfo = i, ... }) =
49 : blume 387 case BinInfo.sh_mode i of
50 :     Sharing.DONTSHARE => StringSet.singleton (BinInfo.describe i)
51 :     | _ => StringSet.empty
52 : blume 303
53 : blume 387 fun sn (DG.SNODE n) = let
54 :     val { smlinfo = i, localimports = li, globalimports = gi, ... } = n
55 :     fun acc f (arg, s) = StringSet.union (f arg, s)
56 : blume 370 in
57 : blume 305 case SmlInfoMap.find (!smlmap, i) of
58 : blume 387 SOME s => s
59 : blume 303 | NONE => let
60 : blume 387 val gs = foldl (acc fsbn) StringSet.empty gi
61 :     val ls = foldl (acc sn) gs li
62 :     val (s, m) = check (SmlInfo.sh_spec i, SmlInfo.descr i, ls,
63 :     SmlInfo.error gp i)
64 : blume 303 in
65 : blume 387 smlmap := SmlInfoMap.insert (!smlmap, i, s);
66 :     SmlInfo.set_sh_mode (i, m);
67 :     s
68 : blume 303 end
69 : blume 370 end
70 : blume 303
71 : blume 737 and sbn (DG.SB_BNODE (n, _, _)) = bn n
72 : blume 387 | sbn (DG.SB_SNODE n) = sn n
73 : blume 303
74 : blume 387 and fsbn (_, n) = sbn n
75 : blume 303
76 : blume 652 fun impexp (nth, _, _) = ignore (fsbn (nth ()))
77 : blume 303 in
78 : blume 387 SymbolMap.app impexp exports
79 : blume 303 end
80 : blume 387 end
81 : blume 303 end

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