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 350, Wed Jun 23 00:38:58 1999 UTC revision 351, Wed Jun 23 06:44:27 1999 UTC
# Line 17  Line 17 
17          type envdelta = CT.envdelta          type envdelta = CT.envdelta
18          type result = CT.result          type result = CT.result
19    
         (* "bnode" does not expect failures, and "group" automatically  
          * clears failures... *)  
20          val bnode : GP.info -> DG.bnode -> envdelta option          val bnode : GP.info -> DG.bnode -> envdelta option
21          val group : GP.info -> GG.group -> result option          val group : GP.info -> GG.group -> result option
22    
23          (* ... but if you go through the "snode" interface, then          (* if you go through the "snode" interface, then
24           * you must clear failures explicitly when you are done. *)           * you must reset explicitly when you are done. *)
25          val snode : GP.info -> DG.snode -> envdelta option          val snode : GP.info -> DG.snode -> envdelta option
26          val clearFailures : unit -> unit          val reset : unit -> unit
27    
28            val resetAll : unit -> unit
29      end = struct      end = struct
30    
31          type envdelta = CT.envdelta          type envdelta = CT.envdelta
# Line 33  Line 33 
33          type benv = CT.benv          type benv = CT.benv
34          type result = CT.result          type result = CT.result
35    
36          (* This is to prevent re-execution of dosml if the first one failed *)          val smlcache = ref (SmlInfoMap.empty: envdelta option SmlInfoMap.map)
37          local          val stablecache = ref (StableMap.empty: envdelta option StableMap.map)
38              val failures = ref SmlInfoSet.empty          fun reset () = smlcache := SmlInfoMap.empty
39          in          fun resetAll () = (reset (); stablecache := StableMap.empty)
             fun dosml (i, e, gp) =  
                 if SmlInfoSet.member (!failures, i) then NONE  
                 else case CT.dosml (i, e, gp) of  
                     SOME r => SOME r  
                   | NONE => (failures := SmlInfoSet.add (!failures, i); NONE)  
             fun clearFailures () = failures := SmlInfoSet.empty  
         end  
40    
41          (* To implement "keep_going" we have two different ways of          (* To implement "keep_going" we have two different ways of
42           * combining a "work" function with a "layer" function.           * combining a "work" function with a "layer" function.
# Line 68  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 (DG.BNODE n) = let                | bn (DG.BNODE n) = let
63                      val { bininfo, localimports = li, globalimports = gi } = n                      val { bininfo, localimports = li, globalimports = gi } = n
                     fun mkenv () = loc (glob (SOME (CT.bpervasive gp)) gi) li  
64                  in                  in
65                      CT.dostable (bininfo, mkenv, gp)                      case StableMap.find (!stablecache, bininfo) of
66                            SOME r => r
67                          | NONE => let
68                                fun mkenv () =
69                                    loc (glob (SOME (CT.bpervasive gp)) gi) li
70                                val r = CT.dostable (bininfo, mkenv, gp)
71                            in
72                                stablecache :=
73                                   StableMap.insert (!stablecache, bininfo, r);
74                                r
75                            end
76                  end                  end
77          in          in
78              (* don't eta-reduce this -- it'll lead to an infinite loop! *)              (* don't eta-reduce this -- it'll lead to an infinite loop! *)
# Line 93  Line 95 
95                                    Option.map CT.nofilter o snode gp))                                    Option.map CT.nofilter o snode gp))
96    
97              val { smlinfo, localimports = li, globalimports = gi } = n              val { smlinfo, localimports = li, globalimports = gi } = n
98              val desc = SmlInfo.fullSpec smlinfo          in
99                case SmlInfoMap.find (!smlcache, smlinfo) of
100                    SOME r => r
101                  | 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 gi
104              val e = loc ge li              val e = loc ge li
105          in                      val r = case e of
             case e of  
106                  NONE => NONE                  NONE => NONE
107                | SOME e => dosml (smlinfo, e, gp)                        | SOME e => CT.dosml (smlinfo, e, gp)
108                    in
109                        smlcache := SmlInfoMap.insert (!smlcache, smlinfo, r);
110                        r
111                    end
112          end          end
113    
114          and sbnode gp (DG.SB_BNODE b) = bnode gp b          and sbnode gp (DG.SB_BNODE b) = bnode gp b
# Line 120  Line 128 
128                                 impexp gp))                                 impexp gp))
129                     (SOME CT.empty)                     (SOME CT.empty)
130                     (SymbolMap.listItems exports))                     (SymbolMap.listItems exports))
131              before clearFailures ()              before reset ()
132      end      end
133  end  end

Legend:
Removed from v.350  
changed lines
  Added in v.351

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