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/compile/link.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/link.sml

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

revision 586, Thu Mar 30 05:08:07 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 UTC
# Line 11  Line 11 
11      structure DG = DependencyGraph      structure DG = DependencyGraph
12      structure GG = GroupGraph      structure GG = GroupGraph
13      structure E = GenericVC.Environment      structure E = GenericVC.Environment
     structure BE = GenericVC.BareEnvironment  
14      structure DE = DynamicEnv      structure DE = DynamicEnv
15      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
16      structure PP = PrettyPrint      structure PP = PrettyPrint
# Line 107  Line 106 
106              app (visit o #1) (SmlInfoMap.listItemsi (!smlmap))              app (visit o #1) (SmlInfoMap.listItemsi (!smlmap))
107          end          end
108    
109          fun newTraversal (group, getBFC) = let          fun newTraversal (GG.ERRORGROUP, _) =
110                { group = fn _ => NONE, exports = SymbolMap.empty }
111              | newTraversal (group as GG.GROUP grec, getBFC) = let
112    
113              val GG.GROUP { exports, grouppath, ... } = group              val { exports, grouppath, ... } = grec
114    
115              fun exn_err (msg, error, descr, exn) = let              fun exn_err (msg, error, descr, exn) = let
116                  fun ppb pps =                  fun ppb pps =
# Line 130  Line 131 
131                      NONE =>                      NONE =>
132                          BF.exec (bfc,                          BF.exec (bfc,
133                                   DE.atop (mk_de gp,                                   DE.atop (mk_de gp,
134                                            BE.dynamicPart(#corenv (#param gp))))                                            E.dynamicPart(#corenv (#param gp))))
135                    | SOME de' => de'                    | SOME de' => de'
136    
137              (* Construction of the environment is delayed until we are              (* Construction of the environment is delayed until we are
# Line 188  Line 189 
189    
190              val visited = ref SrcPathSet.empty              val visited = ref SrcPathSet.empty
191    
192              fun registerGroup g = let              fun registerGroup GG.ERRORGROUP = ()
193                  val GG.GROUP { grouppath, kind, sublibs, ... } = g                | registerGroup (g as GG.GROUP grec) = let
194                  fun registerStableLib (GG.GROUP sg) = let                      val { grouppath, kind, sublibs, ... } = grec
195                        fun registerStableLib GG.ERRORGROUP = ()
196                          | registerStableLib (GG.GROUP sg) = let
197                      val { exports, grouppath = sgp, ... } = sg                      val { exports, grouppath = sgp, ... } = sg
198                      val sysvals =                      val sysvals =
199                          let val (m', e) =                          let val (m', e) =
# Line 199  Line 202 
202                          end handle LibBase.NotFound => emptyDyn                          end handle LibBase.NotFound => emptyDyn
203    
204                      fun sv (SOME pid) =                      fun sv (SOME pid) =
205                          (SOME (DE.bind (pid, DE.look sysvals pid, emptyDyn))                                  (SOME (DE.bind (pid, DE.look sysvals pid,
206                                                    emptyDyn))
207                           handle DE.Unbound => NONE)                           handle DE.Unbound => NONE)
208                        | sv _ = NONE                        | sv _ = NONE
209    
210                      val localmap = ref StableMap.empty                      val localmap = ref StableMap.empty
211                      fun bn (DG.BNODE n) = let                      fun bn (DG.BNODE n) = let
212                          val { bininfo = i, localimports, globalimports } = n                                  val i = #bininfo n
213                                    val li = #localimports n
214                                    val gi = #globalimports n
215    
216                          fun new () = let                          fun new () = let
217                              val e0 = (fn _ => emptyDyn, [])                              val e0 = (fn _ => emptyDyn, [])
218                              fun join ((f, NONE), (e, l)) =                              fun join ((f, NONE), (e, l)) =
219                                  (fn gp => DE.atop (f gp emptyDyn, e gp), l)                                          (fn gp => DE.atop (f gp emptyDyn,
220                                                               e gp),
221                                             l)
222                                | join ((f, SOME (i, l')), (e, l)) =                                | join ((f, SOME (i, l')), (e, l)) =
223                                  (e, B (f, i, l') :: l)                                  (e, B (f, i, l') :: l)
224                              val ge = foldl join e0 (map fbn globalimports)                                      val ge = foldl join e0 (map fbn gi)
225                              val le = foldl join ge (map bn localimports)                                      val le = foldl join ge (map bn li)
226                          in                          in
227                              case (BinInfo.sh_mode i, le) of                              case (BinInfo.sh_mode i, le) of
228                                  (Sharing.SHARE _, (e, [])) => let                                  (Sharing.SHARE _, (e, [])) => let
229                                      fun thunk gp = link_stable sv (i, e, gp)                                              fun thunk gp =
230                                                    link_stable sv (i, e, gp)
231                                      val m_thunk = Memoize.memoize thunk                                      val m_thunk = Memoize.memoize thunk
232                                  in                                  in
233                                      (fn gp => fn _ => m_thunk gp, NONE)                                      (fn gp => fn _ => m_thunk gp, NONE)
234                                  end                                  end
235                                | (Sharing.SHARE _, _) =>                                | (Sharing.SHARE _, _) =>
236                                  EM.impossible "Link: sh_mode inconsistent"                                          EM.impossible
237                                                "Link: sh_mode inconsistent"
238                                | (Sharing.DONTSHARE, (e, l)) =>                                | (Sharing.DONTSHARE, (e, l)) =>
239                                  (fn gp => fn e' =>                                  (fn gp => fn e' =>
240                                   link_stable sv                                   link_stable sv
# Line 237  Line 248 
248                                       Sharing.DONTSHARE => (f, SOME (i, []))                                       Sharing.DONTSHARE => (f, SOME (i, []))
249                                     | _ => (f, NONE))                                     | _ => (f, NONE))
250                            | SOME (B (f, i, l)) => (f, SOME (i, l))                            | SOME (B (f, i, l)) => (f, SOME (i, l))
251                            | NONE => (case StableMap.find (!localmap, i) of                                    | NONE =>
252                                        (case StableMap.find (!localmap, i) of
253                                           SOME x => x                                           SOME x => x
254                                         | NONE => let val x = new ()                                         | NONE => let
255                                           in localmap := StableMap.insert                                               val x = new ()
256                                             in
257                                                 localmap := StableMap.insert
258                                                     (!localmap, i, x);                                                     (!localmap, i, x);
259                                              x                                              x
260                                           end)                                           end)
# Line 250  Line 264 
264    
265                      fun sbn (DG.SB_SNODE n) =                      fun sbn (DG.SB_SNODE n) =
266                          EM.impossible "Link:SNODE in stable lib"                          EM.impossible "Link:SNODE in stable lib"
267                        | sbn (DG.SB_BNODE (n as DG.BNODE { bininfo, ... }, _)) =                                | sbn (DG.SB_BNODE (n as DG.BNODE bnrec, _)) =
268                          let                                  let val bininfo = #bininfo bnrec
269                              val b as B (_, i, _) =                              val b as B (_, i, _) =
270                                  case bn n of                                  case bn n of
271                                      (f, NONE) => B (f, bininfo, [])                                      (f, NONE) => B (f, bininfo, [])
272                                    | (f, SOME (i, l)) => B (f, i, l)                                    | (f, SOME (i, l)) => B (f, i, l)
273                          in                          in
274                              stablemap := StableMap.insert (!stablemap, i, b)                                      stablemap :=
275                                        StableMap.insert (!stablemap, i, b)
276                          end                          end
277    
278                      fun fsbn (_, n) = sbn n                      fun fsbn (_, n) = sbn n

Legend:
Removed from v.586  
changed lines
  Added in v.587

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