SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/smlfile/smlinfo.sml

[smlnj] / sml / trunk / src / cm / smlfile / smlinfo.sml

Diff of /sml/trunk/src/cm/smlfile/smlinfo.sml

-revision 1631, Fri Sep 24 21:21:31 2004 UTC
+revision 1632, Mon Sep 27 22:18:07 2004 UTC
 Line 25
            explicit_core_sym: Symbol.symbol option,
            extra_compenv: StaticEnv.staticEnv option }
+     type controller =
+          { save'restore : unit -> unit -> unit,
+            set : unit -> unit }
      type info_args =
          { sourcepath: SrcPath.file,
            group: SrcPath.file * region,
            sh_spec: Sharing.request,
            setup: string option * string option,
-           locl: bool }
+           locl: bool,
+           controllers: controller list }
      val eq : info * info -> bool        (* compares sourcepaths *)
      val compare : info * info -> order  (* compares sourcepaths *)
-Line 69
+Line 74
      val attribs : info -> attribs
      val lastseen : info -> TStamp.t
      val setup : info -> string option * string option
+     val controllers : info -> controller list
      val is_local : info -> bool
      val setguid : info * string -> unit
      val guid : info -> string
-Line 117
+Line 123
                       explicit_core_sym: Symbol.symbol option,
                       extra_compenv: StaticEnv.staticEnv option }
+     type controller =
+          { save'restore : unit -> unit -> unit,
+            set : unit -> unit }
      type info_args = { sourcepath: SrcPath.file,
                         group: SrcPath.file * region,
                         sh_spec: Sharing.request,
                         setup: string option * string option,
-                        locl: bool }
+                        locl: bool,
+                        controllers: controller list }
      type generation = unit ref
-Line 145
+Line 156
                    sh_spec: Sharing.request,
                    attribs: attribs,
                    setup: string option * string option,
-                   locl:  bool }
+                   locl:  bool,
+                   controllers: controller list }
      type ord_key = info
-Line 165
+Line 177
          sh_mode := m
      fun attribs (INFO { attribs = a, ... }) = a
      fun setup (INFO { setup = s, ... }) = s
+     fun controllers (INFO { controllers = c, ... }) = c
      fun is_local (INFO { locl, ... }) = locl
      fun gerror (gp: GeneralParams.info) = GroupReg.error (#groupreg gp)
-Line 225
+Line 238
      end
      fun info' attribs (gp: GeneralParams.info) arg = let
-         val { sourcepath, group = gr as (group, region), sh_spec, setup, locl }
+         val { sourcepath, group = gr as (group, region), sh_spec, setup,
+               locl, controllers }
              = arg
          val policy = #fnpolicy (#param gp)
          fun mkSkelname () = FNP.mkSkelName policy sourcepath
-Line 322
+Line 336
                 sh_spec = sh_spec,
                 attribs = attribs,
                 setup = setup,
-                locl = locl }
+                locl = locl,
+                controllers = controllers }
      end
      fun info (split, noguid) =
-Line 333
+Line 348
      (* the following functions are only concerned with getting the data,
       * not with checking time stamps *)
      fun getParseTree gp (i as INFO ir, quiet, noerrors) = let
-         val { sourcepath, persinfo = PERS { parsetree, ... }, ... } = ir
+         val { sourcepath, persinfo = PERS { parsetree, ... },
+               controllers, ... } =
+             ir
          val err = if noerrors then (fn m => ())
                    else (fn m => error gp i EM.COMPLAIN m EM.nullErrorBody)
      in
          case !parsetree of
              SOME pt => SOME pt
            | NONE => let
+                 val orig_settings =
+                     map (fn c => #save'restore c ()) controllers
                  fun work stream = let
                      val _ = if noerrors orelse quiet then ()
                              else Say.vsay ["[parsing ",
-Line 378
+Line 397
                          else (source, source)
                      end
                  in
+                     app (fn c => #set c ()) controllers;
                      (SF.parse parse_source, source)
+                     before app (fn r => r ()) orig_settings
                  end
                  fun openIt () = TextIO.openIn (SrcPath.osstring sourcepath)
+                 fun cleanup _ = app (fn r => r ()) orig_settings
                  val pto =
                      SOME (SafeIO.perform { openIt = openIt,
                                             closeIt = TextIO.closeIn,
                                             work = work,
-                                            cleanup = fn _ => () })
+                                            cleanup = cleanup })
                  (* Counting the trees explicitly may be a bit slow,
                   * but maintaining an accurate count is difficult, so
                   * this method should be robust.  (I don't think that

 Legend:



Removed from v.1631
 


changed lines


 
Added in v.1632
 Legend:



Removed from v.1631
 


changed lines


 
Added in v.1632
-Removed from v.1631
+Added in v.1632

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