Saving environment variables across file executions

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index eaee4fc..a0f402d 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -25,16 +25,29 @@ open Ast MsgTypes Print
 structure SM = StringMap
 
 fun init () = Acl.read Config.aclFile
-           
+
+fun isLib fname = OS.Path.file fname = "lib.dtl"
+
+fun wrapFile (fname, file) =
+    case (isLib fname, file) of
+       (true, (comment, ds, SOME e)) =>
+       let
+           val (_, loc) = e
+       in
+           (comment, ds, SOME (ELocal (e, (ESkip, loc)), loc))
+       end
+      | _ => file
+
 fun check' G fname =
     let
        val prog = Parse.parse fname
+       val prog = wrapFile (fname, prog)
     in
        if !ErrorMsg.anyErrors then
            G
        else
            (Option.app (Unused.check G) (#3 prog);
-            Tycheck.checkFile G (Defaults.tInit ()) prog)
+            Tycheck.checkFile G (Defaults.tInit prog) prog)
     end
 
 fun basis () =
@@ -64,12 +77,12 @@ fun basis () =
             before Tycheck.disallowExterns ())
     end
 
-fun check fname =
+(* val b = basis () *)
+
+fun check G fname =
     let
        val _ = ErrorMsg.reset ()
        val _ = Env.preTycheck ()
-
-       val b = basis ()
     in
        if !ErrorMsg.anyErrors then
            raise ErrorMsg.Error
@@ -78,17 +91,18 @@ fun check fname =
                val _ = Tycheck.disallowExterns ()
                val _ = ErrorMsg.reset ()
                val prog = Parse.parse fname
+               val prog = wrapFile (fname, prog)
            in
                if !ErrorMsg.anyErrors then
                    raise ErrorMsg.Error
                else
                    let
-                       val G' = Tycheck.checkFile b (Defaults.tInit ()) prog
+                       val G' = Tycheck.checkFile G (Defaults.tInit prog) prog
                    in
                        if !ErrorMsg.anyErrors then
                            raise ErrorMsg.Error
                        else
-                           (Option.app (Unused.check b) (#3 prog);
+                           (Option.app (Unused.check G) (#3 prog);
                             (G', #3 prog))
                    end
            end
@@ -150,9 +164,9 @@ fun checkDir dname =
     (setupUser ();
      checkDir' dname)
 
-fun reduce fname =
+fun reduce G fname =
     let
-       val (G, body) = check fname
+       val (G, body) = check G fname
     in
        if !ErrorMsg.anyErrors then
            NONE
@@ -166,28 +180,25 @@ fun reduce fname =
                                         [PD.string "Result:",
                                          PD.space 1,
                                          p_exp body']))*)
-                   SOME body'
+                   SOME (G, body')
                end
              | _ => NONE
     end
 
-fun eval fname =
-    case reduce fname of
-       (SOME body') =>
-       if !ErrorMsg.anyErrors then
-           raise ErrorMsg.Error
-       else
-           Eval.exec (Defaults.eInit ()) body'
-      | NONE => ()
+(*(Defaults.eInit ())*)
 
-fun eval' fname =
-    case reduce fname of
-       (SOME body') =>
+fun eval G evs fname =
+    case reduce G fname of
+       SOME (G, body') =>
        if !ErrorMsg.anyErrors then
            raise ErrorMsg.Error
        else
-           ignore (Eval.exec' (Defaults.eInit ()) body')
-      | NONE => ()
+           let
+               val evs' = Eval.exec' evs body'
+           in
+               (G, evs')
+           end
+      | NONE => (G, evs)
 
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
@@ -232,7 +243,7 @@ fun requestSlaveBio () =
 
 fun request fname =
     let
-       val (user, bio) = requestBio (fn () => ignore (check fname))
+       val (user, bio) = requestBio (fn () => ignore (check (basis ()) fname))
 
        val inf = TextIO.openIn fname
 
@@ -1017,6 +1028,9 @@ fun regenerateEither tc checker context =
 
                        val files = loop []
                        val (_, files) = Order.order (SOME b) files
+
+                       fun checker' (file, (G, evs)) =
+                           checker G evs file
                    in
                        if !ErrorMsg.anyErrors then
                            (ErrorMsg.reset ();
@@ -1024,7 +1038,7 @@ fun regenerateEither tc checker context =
                             ok := false)
                        else
                            ();
-                       app checker files
+                       ignore (foldl checker' (basis (), Defaults.eInit ()) files)
                    end
                else if String.isSuffix "_admin" user then
                    ()    
@@ -1065,8 +1079,10 @@ fun regenerateEither tc checker context =
        !ok
     end
 
-val regenerate = regenerateEither false eval'
-val regenerateTc = regenerateEither true (ignore o check)
+val regenerate = regenerateEither false eval
+val regenerateTc = regenerateEither true
+                                   (fn G => fn evs => fn file =>
+                                                         (#1 (check G file), evs))
 
 fun rmuser user =
     let
@@ -1165,17 +1181,17 @@ fun service () =
 
                             val outname = OS.FileSys.tmpName ()
 
-                            fun doOne code =
+                            fun doOne (code, (G, evs)) =
                                 let
                                     val outf = TextIO.openOut outname
                                 in
                                     TextIO.output (outf, code);
                                     TextIO.closeOut outf;
-                                    eval' outname
+                                    eval G evs outname
                                 end
                         in
                             doIt (fn () => (Env.pre ();
-                                            app doOne codes;
+                                            ignore (foldl doOne (basis (), Defaults.eInit ()) codes);
                                             Env.post ();
                                             Msg.send (bio, MsgOk);
                                             ("Configuration complete.", NONE)))