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 371, Mon Jul 5 14:34:41 1999 UTC revision 387, Mon Jul 26 02:44:20 1999 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))
                 s  
44              end              end
45    
46          val smlmap = ref SmlInfoMap.empty          val smlmap = ref SmlInfoMap.empty
         val stablemap = ref StableMap.empty  
47    
48          fun bn (DG.PNODE _, s) = s          fun bn (DG.PNODE _) = StringSet.empty
49            | bn (DG.BNODE { bininfo = i, localimports, globalimports }, s) =            | bn (DG.BNODE { bininfo = i, ... }) =
50              case StableMap.find (!stablemap, i) of              case BinInfo.sh_mode i of
51                  SOME s' => StringSet.union (s, s')                  Sharing.DONTSHARE => StringSet.singleton (BinInfo.describe i)
52                | NONE => let                | _ => StringSet.empty
53                      val gs = foldl fbn empty globalimports  
54                      val ls = foldl bn gs localimports          fun sn (DG.SNODE n) = let
55                      val s' = check (BinInfo.share i, BinInfo.describe i, ls,              val { smlinfo = i, localimports = li, globalimports = gi, ... } = n
56                                      BinInfo.error i)              fun acc f (arg, s) = StringSet.union (f arg, s)
                 in  
                     stablemap := StableMap.insert (!stablemap, i, s');  
                     StringSet.union (s, s')  
                 end  
   
         and fbn ((_, n), s) = bn (n, s)  
   
         fun sn (DG.SNODE n, s) = let  
             val { smlinfo = i, localimports, globalimports, ... } = n  
57          in          in
58              case SmlInfoMap.find (!smlmap, i) of              case SmlInfoMap.find (!smlmap, i) of
59                  SOME s' => StringSet.union (s, s')                  SOME s => s
60                | NONE => let                | NONE => let
61                      val gs = foldl fsbn empty globalimports                      val gs = foldl (acc fsbn) StringSet.empty gi
62                      val ls = foldl sn gs localimports                      val ls = foldl (acc sn) gs li
63                      val s' = check (SmlInfo.share i, SmlInfo.descr i, ls,                      val (s, m) = check (SmlInfo.sh_spec i, SmlInfo.descr i, ls,
64                                      SmlInfo.error gp i)                                      SmlInfo.error gp i)
65                  in                  in
66                      smlmap := SmlInfoMap.insert (!smlmap, i, s');                      smlmap := SmlInfoMap.insert (!smlmap, i, s);
67                      StringSet.union (s, s')                      SmlInfo.set_sh_mode (i, m);
68                        s
69                  end                  end
70          end          end
71    
72          and sbn (DG.SB_BNODE n, s) = bn (n, s)          and sbn (DG.SB_BNODE n) = bn n
73            | sbn (DG.SB_SNODE n, s) = sn (n, s)            | sbn (DG.SB_SNODE n) = sn n
74    
75          and fsbn ((_, n), s) = sbn (n, s)          and fsbn (_, n) = sbn n
76    
77          fun impexp (n, _) = ignore (fsbn (n, StringSet.empty))          fun impexp (n, _) = ignore (fsbn n)
78      in      in
79          SymbolMap.app impexp exports;          SymbolMap.app impexp exports
80          !ok      end
81      end      end
82  end  end

Legend:
Removed from v.371  
changed lines
  Added in v.387

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