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

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

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

revision 369, Sun Jul 4 12:55:20 1999 UTC revision 370, Mon Jul 5 08:59:13 1999 UTC
# Line 12  Line 12 
12      structure DG = DependencyGraph      structure DG = DependencyGraph
13      structure GG = GroupGraph      structure GG = GroupGraph
14  in  in
15      functor CompileGenericFn (structure CT: COMPILATION_TYPE) :> TRAVERSAL      functor CompileGenericFn (structure CT: COMPILATION_TYPE
16                                  val thinTraversal: bool) :> TRAVERSAL
17          where type envdelta = CT.envdelta          where type envdelta = CT.envdelta
18            and type result = CT.result =            and type result = CT.result =
19      struct      struct
# Line 40  Line 41 
41                  NONE => NONE                  NONE => NONE
42                | SOME e' => SOME (layer (e', e))                | SOME e' => SOME (layer (e', e))
43    
44            fun thinOut l = let
45                fun one ((n, false), l) = l
46                  | one ((n, true), l) = n :: l
47            in
48                foldr one [] l
49            end
50    
51            fun dontThinOut l = map (fn (n, _) => n) l
52    
53          fun bnode (gp: GP.info) n = let          fun bnode (gp: GP.info) n = let
54    
55              val k = #keep_going (#param gp)              val k = #keep_going (#param gp)
# Line 51  Line 61 
61              fun bn (DG.PNODE p) = SOME (CT.primitive gp p)              fun bn (DG.PNODE p) = SOME (CT.primitive gp p)
62                | bn (node as DG.BNODE n) = let                | bn (node as DG.BNODE n) = let
63                      val { bininfo, localimports = li, globalimports = gi } = n                      val { bininfo, localimports = li, globalimports = gi } = n
64                        val (li, gi) =
65                            if thinTraversal then (thinOut li, thinOut gi)
66                            else (dontThinOut li, dontThinOut gi)
67                  in                  in
68                      case StableMap.find (!stablecache, bininfo) of                      case StableMap.find (!stablecache, bininfo) of
69                          SOME r => r                          SOME r => r
# Line 78  Line 91 
91          fun snode gp (node as DG.SNODE n) = let          fun snode gp (node as DG.SNODE n) = let
92    
93              val k = #keep_going (#param gp)              val k = #keep_going (#param gp)
94              val glob =              val glob = foldl (layerwork (k, CT.layer, sglobi gp))
95                  foldl (layerwork (k, CT.layer, farsbnode gp))              val loc = foldl (layerwork (k, CT.layer, sloci gp))
             val loc =  
                 foldl (layerwork (k, CT.layer,  
                                   Option.map CT.nofilter o snode gp))  
96    
97              val { smlinfo, localimports = li, globalimports = gi } = n              val i = #smlinfo n
98          in          in
99              case SmlInfoMap.find (!smlcache, smlinfo) of              case SmlInfoMap.find (!smlcache, i) of
100                  SOME r => r                  SOME r => r
101                | NONE => let                | NONE => let
102                      val pe = SOME (CT.pervasive gp)                      val pe = SOME (CT.pervasive gp)
103                      val ge = glob pe gi                      val ge = glob pe (#globalimports n)
104                      val e = loc ge li                      val e = loc ge (#localimports n)
105                      val r = case e of                      val r = case e of
106                          NONE => NONE                          NONE => NONE
107                        | SOME e => CT.dosml (smlinfo, e, gp, node)                        | SOME e => CT.dosml (i, e, gp, node)
108                  in                  in
109                      smlcache := SmlInfoMap.insert (!smlcache, smlinfo, r);                      smlcache := SmlInfoMap.insert (!smlcache, i, r);
110                      r                      r
111                  end                  end
112          end          end
113    
114            and sglobi gp (n, r) =
115                Option.map (CT.withAccessTrap r) (farsbnode gp n)
116            and sloci gp (n, r) =
117                Option.map (CT.withAccessTrap r o CT.nofilter) (snode gp n)
118    
119          and sbnode gp (DG.SB_BNODE b) = bnode gp b          and sbnode gp (DG.SB_BNODE b) = bnode gp b
120            | sbnode gp (DG.SB_SNODE s) = snode gp s            | sbnode gp (DG.SB_SNODE s) = snode gp s
121    

Legend:
Removed from v.369  
changed lines
  Added in v.370

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