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

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

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

revision 295, Wed May 26 09:20:25 1999 UTC revision 297, Thu May 27 08:29:19 1999 UTC
# Line 15  Line 15 
15      structure E = GenericVC.Environment      structure E = GenericVC.Environment
16      structure PID = GenericVC.PersStamps      structure PID = GenericVC.PersStamps
17      structure BF = MachDepVC.Binfile      structure BF = MachDepVC.Binfile
18        structure PP = PrettyPrint
19        structure EM = GenericVC.ErrorMsg
20    
21      type pid = PID.persstamp      type pid = PID.persstamp
22    
# Line 101  Line 103 
103            sym = (BF.symenvOf bfc, BF.lambdaPidOf bfc),            sym = (BF.symenvOf bfc, BF.lambdaPidOf bfc),
104            ctxt = ctxt }            ctxt = ctxt }
105    
106      fun lookstable (i, mkenv) =      fun lookstable (i, mkenv, gp) =
107          case PS.recomp_look_stable i of          case PS.recomp_look_stable i of
108              SOME memo => FOUND (memo2envdelta memo)              SOME memo => FOUND (memo2envdelta memo)
109            | NONE => NOTFOUND (mkenv ())            | NONE => NOTFOUND (mkenv ())
110    
111      fun dostable (i, be, gp: GeneralParams.params) = let      fun dostable (i, be, gp: GeneralParams.params) = let
112          val stable = BinInfo.stablePath i          val fnp = #fnpolicy gp
113            val stable = FilenamePolicy.mkStablePath fnp (BinInfo.group i)
114          val os = BinInfo.offset i          val os = BinInfo.offset i
115          val descr = BinInfo.describe i          val descr = BinInfo.describe i
116          val _ = Say.vsay (concat ["[consulting ", descr, "]\n"])          val _ = Say.vsay (concat ["[consulting ", descr, "]\n"])
# Line 125  Line 128 
128      in      in
129          SOME (load ()) handle exn => let          SOME (load ()) handle exn => let
130              fun pphist pps =              fun pphist pps =
131                  (PrettyPrint.add_string pps (General.exnMessage exn);                  (PP.add_string pps (General.exnMessage exn);
132                   PrettyPrint.add_newline pps)                   PP.add_newline pps)
133          in          in
134              BinIO.closeIn s;              BinIO.closeIn s;
135              BinInfo.error i GenericVC.ErrorMsg.COMPLAIN              BinInfo.error gp i EM.COMPLAIN
136                   "unable to load stable library module" pphist;                   "unable to load stable library module" pphist;
137              NONE              NONE
138          end          end
139      end      end
140    
141      fun looksml (i, e: env) =      fun looksml (i, e: env, gp) =
142          Option.map memo2envdelta (PS.recomp_look_sml (i, #pids e))          Option.map memo2envdelta (PS.recomp_look_sml (i, #pids e, gp))
143    
144      fun dosml (i, e, gp) =      fun dosml (i, { stat, sym, pids }, gp) = let
145    
146            val mkBinPath = FilenamePolicy.mkBinPath (#fnpolicy gp)
147            val binpath = mkBinPath (SmlInfo.sourcepath i)
148            val binname = AbsPath.name binpath
149            fun delete () = OS.FileSys.remove binname handle _ => ()
150    
151            fun save bfc = let
152                val s = AbsPath.openBinOut binpath
153                fun writer () =
154                    BF.write { stream = s, content = bfc, keep_code = true }
155            in
156                Interrupt.guarded writer
157                handle exn => (BinIO.closeOut s; raise exn);
158                BinIO.closeOut s;
159                Say.vsay (concat ["wrote ", binname, "]\n"])
160            end handle e as Interrupt.Interrupt => (delete (); raise e)
161                     | exn => let
162                           fun pphist pps =
163                               (PP.add_string pps (General.exnMessage exn);
164                                PP.add_newline pps)
165                       in
166                           delete ();
167                           SmlInfo.error gp i EM.WARN
168                                         ("failed to write " ^ binname) pphist
169                       end
170    
171            fun load () = let
172                val s = AbsPath.openBinIn binpath
173                fun read () = BF.read { stream = s, name = binname, senv = stat,
174                                        keep_code = true }
175            in
176                SOME (Interrupt.guarded read)
177                handle exn => (BinIO.closeIn s; raise exn)
178            end handle e as Interrupt.Interrupt => raise e
179                     | _ => NONE
180        in
181          Dummy.f ()          Dummy.f ()
182  end  end
183    end

Legend:
Removed from v.295  
changed lines
  Added in v.297

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