Saving environment variables across file executions

diff --git a/src/autodoc.sml b/src/autodoc.sml
index c64180d..bdf2527 100644 (file)
--- a/src/autodoc.sml
+++ b/src/autodoc.sml
@@ -36,7 +36,7 @@ fun check' G fname =
        if !ErrorMsg.anyErrors then
            G
        else
-           Tycheck.checkFile G (Defaults.tInit ()) prog
+           Tycheck.checkFile G (Defaults.tInit prog) prog
     end
 
 fun autodoc {outdir, infiles} =

diff --git a/src/defaults.sig b/src/defaults.sig
index c380705..7dbe773 100644 (file)
--- a/src/defaults.sig
+++ b/src/defaults.sig
@@ -21,6 +21,6 @@
 signature DEFAULTS = sig
     val registerDefault : string * Ast.typ * (unit -> Ast.exp) -> unit
 
-    val tInit : unit -> Ast.typ
+    val tInit : Ast.file -> Ast.typ
     val eInit : unit -> Env.env_vars
 end

diff --git a/src/defaults.sml b/src/defaults.sml
index 43dced5..8ca63f7 100644 (file)
--- a/src/defaults.sml
+++ b/src/defaults.sml
@@ -35,10 +35,27 @@ fun registerDefault (name, t, v) =
                 defaultV := SM.insert (!defaultV, name, v))
       | SOME _ => raise Fail "Duplicate default environment variable"
 
-fun tInit () = (TAction ((CRoot, dmy),
-                        !defaultT,
-                        StringMap.empty),
-               dmy)
+fun allSets (e, _) =
+    case e of
+       ESkip => true
+      | ESet _ => true
+      | ESeq es => List.all allSets es
+      | _ => false
+
+val dmy = ErrorMsg.dummyLoc
+
+fun bodyType (_, _, SOME e) =
+    if allSets e then
+       (CPrefix (CRoot, dmy), dmy)
+    else
+       (CRoot, dmy)
+  | bodyType _ = (CRoot, dmy)
+
+fun tInit p =
+    (TAction (bodyType p,
+             !defaultT,
+             StringMap.empty),
+     dmy)
 
 fun eInit () = SM.map (fn f => f ()) (!defaultV)
 

diff --git a/src/domtool.grm b/src/domtool.grm
index 0cc4fbd..13ee80b 100644 (file)
--- a/src/domtool.grm
+++ b/src/domtool.grm
@@ -79,7 +79,7 @@ open Ast
 
 %%
 
-file   : docOpt decls expOpt               (docOpt, decls, expOpt)
+file   : docOpt decls expOpt SEMIopt       (docOpt, decls, expOpt)
 
 decls  :                                   ([])
        | decl decls                        (decl :: decls)
@@ -96,8 +96,7 @@ docOpt :                                   (NONE)
        | DOC                               (SOME DOC)
 
 expOpt :                                   (NONE)
-       | exp                               (SOME (ELocal (exp, (ESkip, (expleft, expright))),
-                                                 (expleft, expright)))
+       | exp                               (SOME exp)
 
 
 exp    : apps                              (apps)

diff --git a/src/eval.sml b/src/eval.sml
index c41f796..08fd7f5 100644 (file)
--- a/src/eval.sml
+++ b/src/eval.sml
@@ -118,4 +118,6 @@ fun exec evs e =
        Env.post ()
     end
 
+val exec' = fn evs => fn e => conjoin (evs, exec' evs e)
+
 end

diff --git a/src/main-client.sml b/src/main-client.sml
index 8d5f012..ef083b4 100644 (file)
--- a/src/main-client.sml
+++ b/src/main-client.sml
@@ -33,7 +33,7 @@ fun domtoolRoot () =
 
 val (doit, doitDir, args) =
     case CommandLine.arguments () of
-       "-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check fname)),
+       "-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check (Main.basis ()) fname)),
                          Main.checkDir,
                          args)
       | args => (Main.request,

diff --git a/src/main.sig b/src/main.sig
index 53f019d..29f41b1 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -23,14 +23,14 @@ signature MAIN = sig
     val init : unit -> unit
     val setupUser : unit -> string
 
-    val check : string -> Env.env * Ast.exp option
+    val check : Env.env -> string -> Env.env * Ast.exp option
     val check' : Env.env -> string -> Env.env
     val checkDir : string -> unit
 
     val basis : unit -> Env.env
 
-    val reduce : string -> Ast.exp option
-    val eval : string -> unit
+    val reduce : Env.env -> string -> (Env.env * Ast.exp) option
+    val eval : Env.env -> Env.env_vars -> string -> Env.env * Env.env_vars
 
     val request : string -> unit
     val requestDir : string -> unit

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)))