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 317, Fri Jun 4 09:00:10 1999 UTC revision 318, Mon Jun 7 09:32:09 1999 UTC
# Line 39  Line 39 
39              fun clearFailures () = failures := SmlInfoSet.empty              fun clearFailures () = failures := SmlInfoSet.empty
40          end          end
41    
42          (* To implement "keep_going" we have two different ways to "fold"          (* To implement "keep_going" we have two different ways of
43           * a "layer" function over a list.  The _k version is to be used           * combining a "work" function with a "layer" function.
44           * if keep_going is true, otherwise the _s version applies.           * One way is to give up and do no further work once there
45           * Note that there is a bit of typing mystery in the way I use           * is a result of NONE, the other one is to continue
46           * these functions later: I had to be more verbose than I wanted           * working (but to ignore the results of such work). *)
47           * to because of the "value restriction rule" in SML'97. *)          fun layerwork (k, layer, work) (x, NONE) =
48          fun foldlayer_k layer f = let              (if k then ignore (work x) else (); NONE)
49              fun loop r [] = r            | layerwork (k, layer, work) (x, SOME e) =
50                | loop NONE (h :: t) = (ignore (f h); loop NONE t)              case work x of
               | loop (SOME e) (h :: t) =  
                 case f h of  
                     NONE => loop NONE t  
                   | SOME e' => loop (SOME (layer (e', e))) t  
         in  
             loop  
         end  
   
         fun foldlayer_s layer f NONE l = NONE  
           | foldlayer_s layer f (SOME i) l = let  
                 fun loop e [] = SOME e  
                   | loop e (h :: t) =  
                     case f h of  
51                          NONE => NONE                          NONE => NONE
52                        | SOME e' => loop (layer (e', e)) t                | SOME e' => SOME (layer (e', e))
             in  
                 loop i l  
             end  
53    
54          fun bnode (gp: GP.info) n = let          fun bnode (gp: GP.info) n = let
55    
56              val (glob, loc) = let              val k = #keep_going (#param gp)
57                  val globf = farbnode gp              val glob = foldl (layerwork (k, CT.blayer, farbnode gp))
58                  val locf = Option.map CT.bnofilter o bnode gp              val loc =
59                  fun k f = foldlayer_k CT.blayer f                  foldl (layerwork (k, CT.blayer,
60                  fun s f = foldlayer_s CT.blayer f                                    Option.map CT.bnofilter o bnode gp))
             in  
                 if #keep_going (#param gp) then (k globf, k locf)  
                 else (s globf, s locf)  
             end  
61    
62              fun bn (DG.PNODE p) = SOME (CT.primitive gp p)              fun bn (DG.PNODE p) = SOME (CT.primitive gp p)
63                | bn (DG.BNODE n) = let                | bn (DG.BNODE n) = let
# Line 99  Line 79 
79    
80          fun snode gp (DG.SNODE n) = let          fun snode gp (DG.SNODE n) = let
81    
82              val (glob, loc) = let              val k = #keep_going (#param gp)
83                  val globf = farsbnode gp              val glob =
84                  val locf = Option.map CT.nofilter o snode gp                  foldl (layerwork (k, CT.layer, farsbnode gp))
85                  fun k f = foldlayer_k CT.layer f              val loc =
86                  fun s f = foldlayer_s CT.layer f                  foldl (layerwork (k, CT.layer,
87              in                                    Option.map CT.nofilter o snode gp))
                 if #keep_going (#param gp) then (k globf, k locf)  
                 else (s globf, s locf)  
             end  
88    
89              val { smlinfo, localimports = li, globalimports = gi } = n              val { smlinfo, localimports = li, globalimports = gi } = n
90              val desc = SmlInfo.fullSpec smlinfo              val desc = SmlInfo.fullSpec smlinfo
# Line 131  Line 108 
108    
109          fun impexp gp (n, _) = Option.map CT.env2result (farsbnode gp n)          fun impexp gp (n, _) = Option.map CT.env2result (farsbnode gp n)
110    
111          fun group gp (GG.GROUP { exports, ... }) = let          fun group gp (GG.GROUP { exports, ... }) =
112              val fl =              (foldl (layerwork (#keep_going (#param gp),
113                  if #keep_going (#param gp) then foldlayer_k else foldlayer_s                                 CT.rlayer,
114          in                                 impexp gp))
             (fl CT.rlayer (impexp gp)  
115                            (SOME CT.empty)                            (SOME CT.empty)
116                            (SymbolMap.listItems exports))                            (SymbolMap.listItems exports))
117              before clearFailures ()              before clearFailures ()
118          end          end
119      end      end
 end  

Legend:
Removed from v.317  
changed lines
  Added in v.318

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