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 402, Fri Aug 27 07:50:43 1999 UTC revision 404, Wed Sep 1 07:03:22 1999 UTC
# Line 18  Line 18 
18      type env = E.dynenv      type env = E.dynenv
19  in  in
20      signature LINK = sig      signature LINK = sig
21    
22            type bfc
23            type bfcGetter = SmlInfo.info -> bfc
24    
25          (* Evict value from cache if it exists *)          (* Evict value from cache if it exists *)
26          val evict : GP.info -> SmlInfo.info -> unit          val evict : GP.info -> SmlInfo.info -> unit
27    
# Line 25  Line 29 
29           * meanwhile evicted ones. *)           * meanwhile evicted ones. *)
30          val cleanup : GP.info -> unit          val cleanup : GP.info -> unit
31    
32          val newTraversal : GG.group ->          val newTraversal : GG.group * bfcGetter ->
33              { group: GP.info -> env option,              { group: GP.info -> env option,
34                exports: (GP.info -> env option) SymbolMap.map }                exports: (GP.info -> env option) SymbolMap.map }
35    
# Line 36  Line 40 
40      end      end
41    
42      functor LinkFn (structure MachDepVC : MACHDEP_VC      functor LinkFn (structure MachDepVC : MACHDEP_VC
43                      val getBFC : SmlInfo.info -> MachDepVC.Binfile.bfContent                      val system_values : env ref) :> LINK
44                      val system_values : env ref) :> LINK = struct          where type bfc = MachDepVC.Binfile.bfContent =
45        struct
46    
47          structure BF = MachDepVC.Binfile          structure BF = MachDepVC.Binfile
48    
49            type bfc = BF.bfContent
50            type bfcGetter = SmlInfo.info -> bfc
51    
52          type bfun = GP.info -> E.dynenv -> E.dynenv          type bfun = GP.info -> E.dynenv -> E.dynenv
53    
54          datatype bnode =          datatype bnode =
# Line 68  Line 76 
76              raise exn              raise exn
77          end          end
78    
79          fun execute (bfc, de) = let          fun execute (bfc, de) =
             fun exec () = E.dynamicPart (BF.exec (bfc, de))  
         in  
80              case sysval (BF.exportPidOf bfc) of              case sysval (BF.exportPidOf bfc) of
81                  NONE => exec ()                  NONE => BF.exec (bfc, de)
82                | SOME de => de                | SOME de' => de'
         end  
83    
84          fun memoize thunk = let          fun memoize thunk = let
85              val r = ref (fn _ => raise Fail "Link:memoize")              val r = ref (fn _ => raise Fail "Link:memoize")
# Line 162  Line 167 
167              end              end
168          end          end
169    
170          fun link_sml (gp, i, getE, snl) = let          fun link_sml (gp, i, getBFC, getE, snl) = let
171              fun fresh () = let              fun fresh () = let
172                  val bfc = getBFC i                  val bfc = getBFC i
173              in              in
# Line 273  Line 278 
278                      | _ => ())                      | _ => ())
279          end          end
280    
281          fun newTraversal (group as GG.GROUP { exports, ... }) = let          fun newTraversal (group as GG.GROUP { exports, ... }, getBFC) = let
282              val _ = registerGroup group              val _ = registerGroup group
283    
284              val l_stablemap = ref StableMap.empty              val l_stablemap = ref StableMap.empty
# Line 321  Line 326 
326                          val gi = foldl add (SOME o getPerv, [])                          val gi = foldl add (SOME o getPerv, [])
327                                             (map fsbn globalimports)                                             (map fsbn globalimports)
328                          val (getE, snl) = foldl add gi (map sn localimports)                          val (getE, snl) = foldl add gi (map sn localimports)
329                          fun thunk gp = link_sml (gp, i, getE, snl)                          fun thunk gp = link_sml (gp, i, getBFC, getE, snl)
330                          val m_thunk = memoize thunk                          val m_thunk = memoize thunk
331                      in                      in
332                          l_smlmap := SmlInfoMap.insert (!l_smlmap, i, m_thunk);                          l_smlmap := SmlInfoMap.insert (!l_smlmap, i, m_thunk);

Legend:
Removed from v.402  
changed lines
  Added in v.404

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