Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/depend/checksharing.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 303, Sun May 30 10:23:20 1999 UTC revision 651, Thu Jun 1 18:34:03 2000 UTC
# Line 5  Line 5 
5   *   *
6   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7   *)   *)
8  signature CHECKSHARING = sig  local
     val check : GroupGraph.group * GeneralParams.info -> bool  
 end  
   
 structure CheckSharing :> CHECKSHARING = struct  
   
9      structure DG = DependencyGraph      structure DG = DependencyGraph
10      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
11      structure PP = PrettyPrint      structure PP = PrettyPrint
12    in
13      signature CHECKSHARING = sig
14        val check : DG.impexp SymbolMap.map * GeneralParams.info -> unit
15      end
16    
17      val empty = StringSet.empty    structure CheckSharing :> CHECKSHARING = struct
   
     fun check (GroupGraph.GROUP { exports, ... }, gp) = let  
18    
19          val ok = ref true      fun check (exports, gp) = let
20    
21          fun check (NONE, _, s, _) = s          fun check (Sharing.DONTCARE, _, s, _) =
22            | check (SOME false, x, s, _) = StringSet.add (s, x)              (s, if StringSet.isEmpty s then Sharing.SHARE false
23            | check (SOME true, x, s, err) = let                  else Sharing.DONTSHARE)
24              | check (Sharing.PRIVATE, x, _, _) =
25                (StringSet.singleton x, Sharing.DONTSHARE)
26              | check (Sharing.SHARED, x, s, err) = let
27                  fun ppb pps = let                  fun ppb pps = let
28                      fun loop [] = ()                      fun loop [] = ()
29                        | loop (h :: t) =                        | loop (h :: t) =
# Line 38  Line 38 
38                      loop (StringSet.listItems s)                      loop (StringSet.listItems s)
39                  end                  end
40              in              in
41                  if StringSet.isEmpty s then ()                  if StringSet.isEmpty s then (s, Sharing.SHARE true)
42                  else (err EM.COMPLAIN ("cannot share state of " ^ x) ppb;                  else (err EM.COMPLAIN ("cannot share state of " ^ x) ppb;
43                        ok := false);                        (s, Sharing.DONTSHARE))
                 StringSet.add (s, x)  
44              end              end
45    
46          val smlmap = ref AbsPathMap.empty          val smlmap = ref SmlInfoMap.empty
         val stablemap = ref StableMap.empty  
47    
48          fun bn (DG.PNODE _, s) = s          fun bn (DG.BNODE { bininfo = i, ... }) =
49            | bn (DG.BNODE { bininfo = i, localimports, globalimports }, s) =              case BinInfo.sh_mode i of
50              case StableMap.find (!stablemap, i) of                  Sharing.DONTSHARE => StringSet.singleton (BinInfo.describe i)
51                  SOME s' => StringSet.union (s, s')                | _ => StringSet.empty
               | NONE => let  
                     val gs = foldl fbn empty globalimports  
                     val ls = foldl bn gs localimports  
                     val s' = check (BinInfo.share i, BinInfo.describe i, ls,  
                                     BinInfo.error gp i)  
                 in  
                     stablemap := StableMap.insert (!stablemap, i, s');  
                     StringSet.union (s, s')  
                 end  
   
         and fbn ((_, n), s) = bn (n, s)  
52    
53          fun sn (DG.SNODE { smlinfo = i, localimports, globalimports }, s) = let          fun sn (DG.SNODE n) = let
54              val p = SmlInfo.sourcepath i              val { smlinfo = i, localimports = li, globalimports = gi, ... } = n
55                fun acc f (arg, s) = StringSet.union (f arg, s)
56          in          in
57              case AbsPathMap.find (!smlmap, p) of              case SmlInfoMap.find (!smlmap, i) of
58                  SOME s' => StringSet.union (s, s')                  SOME s => s
59                | NONE => let                | NONE => let
60                      val gs = foldl fsbn empty globalimports                      val gs = foldl (acc fsbn) StringSet.empty gi
61                      val ls = foldl sn gs localimports                      val ls = foldl (acc sn) gs li
62                      val s' = check (SmlInfo.share i, SmlInfo.name i, ls,                      val (s, m) = check (SmlInfo.sh_spec i, SmlInfo.descr i, ls,
63                                      SmlInfo.error gp i)                                      SmlInfo.error gp i)
64                  in                  in
65                      smlmap := AbsPathMap.insert (!smlmap, p, s');                      smlmap := SmlInfoMap.insert (!smlmap, i, s);
66                      StringSet.union (s, s')                      SmlInfo.set_sh_mode (i, m);
67                        s
68                  end                  end
69          end          end
70    
71          and sbn (DG.SB_BNODE n, s) = bn (n, s)          and sbn (DG.SB_BNODE (n, _)) = bn n
72            | sbn (DG.SB_SNODE n, s) = sn (n, s)            | sbn (DG.SB_SNODE n) = sn n
73    
74          and fsbn ((_, n), s) = sbn (n, s)          and fsbn (_, n) = sbn n
75    
76          fun impexp (n, _) = ignore (fsbn (n, StringSet.empty))          fun impexp (n, _) = ignore (fsbn n)
77      in      in
78          SymbolMap.app impexp exports;          SymbolMap.app impexp exports
79          !ok      end
80      end      end
81  end  end

Legend:
Removed from v.303  
changed lines
  Added in v.651

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