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/to-portable.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/depend/to-portable.sml

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

revision 975, Wed Oct 31 20:22:44 2001 UTC revision 977, Wed Nov 14 16:53:16 2001 UTC
# Line 12  Line 12 
12                   PortableGraph.graph * SrcPath.file list                   PortableGraph.graph * SrcPath.file list
13  end = struct  end = struct
14    
15        structure SS = SymbolSet
16      structure GG = GroupGraph      structure GG = GroupGraph
17      structure DG = DependencyGraph      structure DG = DependencyGraph
18      structure P = PortableGraph      structure P = PortableGraph
# Line 34  Line 35 
35                 | unequal => unequal)                 | unequal => unequal)
36    
37      structure SSM = RedBlackMapFn      structure SSM = RedBlackMapFn
38          (type ord_key = SymbolSet.set          (type ord_key = SS.set
39           val compare = SymbolSet.compare)           val compare = SS.compare)
40    
41      structure IM = RedBlackMapFn      structure IM = RedBlackMapFn
42          (type ord_key = SrcPath.file * string          (type ord_key = SrcPath.file * string
# Line 44  Line 45 
45                   EQUAL => String.compare (s, s')                   EQUAL => String.compare (s, s')
46                 | unequal => unequal)                 | unequal => unequal)
47    
48      val ignoredSyms = SymbolSet.addList      val ignoredSyms = SS.addList (SS.empty,
                           (SymbolSet.empty,  
49                             [PervAccess.pervStrSym, CoreSym.coreSym])                             [PervAccess.pervStrSym, CoreSym.coreSym])
50    
51      fun export (GG.ERRORGROUP, _) = raise Fail "ToPortable.export ERRORGROUP"      fun export (GG.ERRORGROUP, _) = raise Fail "ToPortable.export ERRORGROUP"
# Line 68  Line 68 
68                              case find (m, i) of                              case find (m, i) of
69                                  NONE => insert (m, i, (p, ex))                                  NONE => insert (m, i, (p, ex))
70                                | SOME (p', ex') =>                                | SOME (p', ex') =>
71                                  insert (m, i, (p', SymbolSet.union (ex, ex')))                                  insert (m, i, (p', SS.union (ex, ex')))
72                          val su = update (SmlInfoMap.find, SmlInfoMap.insert)                          val su = update (SmlInfoMap.find, SmlInfoMap.insert)
73                          val bu = update (StableMap.find, StableMap.insert)                          val bu = update (StableMap.find, StableMap.insert)
74                          fun oneE (sy, (th, _, ex), (sm, bm)) =                          fun oneE (sy, (th, _, ex), (sm, bm)) =
# Line 84  Line 84 
84                            | _ => (sm, bm)                            | _ => (sm, bm)
85                      end                      end
86                  val (sm, bm) = mkInvMap sublibs                  val (sm, bm) = mkInvMap sublibs
87                  fun trim (p, ex) = (p, SymbolSet.difference (ex, ignoredSyms))                  fun trim (p, ex) = (p, SS.difference (ex, ignoredSyms))
88                  val sm = SmlInfoMap.map trim sm                  val sm = SmlInfoMap.map trim sm
89                  val bm = StableMap.map trim bm                  val bm = StableMap.map trim bm
90              in              in
# Line 106  Line 106 
106    
107              fun relname i = let              fun relname i = let
108                  val p = toAbsolute (SrcPath.osstring (SmlInfo.sourcepath i))                  val p = toAbsolute (SrcPath.osstring (SmlInfo.sourcepath i))
109                    val s = OS.Path.mkRelative { path = p, relativeTo = groupdir }
110                    val { arcs, isAbs, vol } = OS.Path.fromString s
111                    fun badarc a =
112                        a <> OS.Path.currentArc andalso
113                        a <> OS.Path.parentArc andalso
114                        (a = "." orelse a = ".." orelse Char.contains a #"/")
115                    fun toUnix [] = "."
116                      | toUnix (h :: t) = let
117                            fun trans a =
118                                if a = OS.Path.currentArc then "."
119                                else if a = OS.Path.parentArc then ".."
120                                else a
121                        in
122                            concat (rev (foldl (fn (a, l) =>
123                                                   trans a :: "/" :: l)
124                                               [trans h] t))
125                        end
126              in              in
127                  OS.Path.mkRelative { path = p, relativeTo = groupdir }                  if isAbs orelse vol <> "" orelse List.exists badarc arcs then
128                        (s, true)
129                    else
130                        (toUnix arcs, false)
131              end              end
132    
133              val gensym = let val next = ref 0              val gensym = let val next = ref 0
# Line 157  Line 177 
177                  case SSM.find (!sets, ss) of                  case SSM.find (!sets, ss) of
178                      SOME v => v                      SOME v => v
179                    | NONE => let val v = gensym "ss"                    | NONE => let val v = gensym "ss"
180                                  val sl = SymbolSet.listItems ss                                  val sl = SS.listItems ss
181                              in                              in
182                                  genBind (v, P.SYMS (map genSYM sl));                                  genBind (v, P.SYMS (map genSYM sl));
183                                  sets := SSM.insert (!sets, ss, v);                                  sets := SSM.insert (!sets, ss, v);
# Line 186  Line 206 
206                              end                              end
207              end              end
208    
209                fun genFILTER' (vex as (v, ex), f) = let
210                    val f' = SS.intersection (ex, f)
211                in
212                    if SS.equal (ex, f') then vex
213                    else (genFILTER (v, f'), f')
214                end
215    
216              fun unlayer l = let              fun unlayer l = let
217                  fun loop ([], _, a) = rev a                  fun loop ([], _, a) = rev a
218                    | loop ((h, hss) :: t, ss, a) = let                    | loop ((h, hss) :: t, ss, a) = let
219                          val i = SymbolSet.intersection (ss, hss)                          val i = SS.intersection (ss, hss)
220                          val u = SymbolSet.union (ss, hss)                          val u = SS.union (ss, hss)
221                          val f = SymbolSet.difference (hss, ss)                          val f = SS.difference (hss, ss)
222                      in                      in
223                          if SymbolSet.isEmpty f then loop (t, u, a)                          if SS.isEmpty f then loop (t, u, a)
224                          else if SymbolSet.isEmpty i then loop (t, u, h :: a)                          else if SS.isEmpty i then loop (t, u, h :: a)
225                          else loop (t, u, genFILTER (h, f) :: a)                          else loop (t, u, genFILTER (h, f) :: a)
226                      end                      end
227              in              in
228                  loop (l, SymbolSet.empty, [])                  loop (l, SS.empty, [])
229              end              end
230    
231              local              local
# Line 220  Line 247 
247                  val ss = genSYMS ex                  val ss = genSYMS ex
248              in              in
249                  preventFilter (v, ss);                  preventFilter (v, ss);
250                  genBind (v, P.COMPILE { src = s, env = e, syms = ss,                  genBind (v, P.COMPILE { src = s, env = e, syms = ss })
                                         native = true })(* for now! FIXME *)  
251              end              end
252    
253              fun genIMPORT (lib, ex) =              fun genIMPORT (lib, ex) =
254                  if SymbolSet.isEmpty ex then ("dummy", ex)                  if SS.isEmpty ex then ("dummy", ex)
255                  else                  else
256                      let val s = genSYMS ex                      let val s = genSYMS ex
257                      in case IM.find (!imps, (lib, s)) of                      in case IM.find (!imps, (lib, s)) of
# Line 269  Line 295 
295                      end                      end
296    
297              and fsbn (NONE, n) = sbn n              and fsbn (NONE, n) = sbn n
298                | fsbn (SOME f, n) = let                | fsbn (SOME f, n) = genFILTER' (sbn n, f)
                     val vex as (v, ex) = sbn n  
                 in  
                     if SymbolSet.isSubset (ex, f) then vex  
                     else let val f' = SymbolSet.intersection (f, ex)  
                              val v' = genFILTER (v, f')  
                          in  
                              (v', f')  
                          end  
                 end  
299    
300              and sbn (DG.SB_SNODE (n as DG.SNODE { smlinfo, ... })) =              and sbn (DG.SB_SNODE (n as DG.SNODE { smlinfo, ... })) =
301                  (case smlImport smlinfo of                  (case smlImport smlinfo of
# Line 287  Line 304 
304                | sbn (DG.SB_BNODE (DG.BNODE { bininfo, ... }, _, _)) =                | sbn (DG.SB_BNODE (DG.BNODE { bininfo, ... }, _, _)) =
305                  binImport bininfo                  binImport bininfo
306    
307              fun impexp (th, _, ss) =              fun impexp (th, _, ss) = #1 (genFILTER' (fsbn (th ()), ss))
                 genFILTER (#1 (fsbn (th ())), ss)  
308    
309              val iel = SymbolMap.foldr (fn (ie, l) => impexp ie :: l) [] exports              val iel = SymbolMap.foldr (fn (ie, l) => impexp ie :: l) [] exports
310    

Legend:
Removed from v.975  
changed lines
  Added in v.977

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