Update of /cvsroot/hcoop/domtool2/src
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv11070/src
Modified Files:
autodoc.sml defaults.sig defaults.sml domtool.grm eval.sml
main-client.sml main.sig main.sml
Log Message:
Saving environment variables across file executions
Index: defaults.sml
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/defaults.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** defaults.sml 3 Sep 2006 19:38:36 -0000 1.1
--- defaults.sml 24 Feb 2008 20:10:15 -0000 1.2
***************
*** 36,43 ****
| SOME _ => raise Fail "Duplicate default environment variable"
! fun tInit () = (TAction ((CRoot, dmy),
! !defaultT,
! StringMap.empty),
! dmy)
fun eInit () = SM.map (fn f => f ()) (!defaultV)
--- 36,60 ----
| SOME _ => raise Fail "Duplicate default environment variable"
! 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)
Index: autodoc.sml
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/autodoc.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** autodoc.sml 16 Dec 2007 20:22:03 -0000 1.8
--- autodoc.sml 24 Feb 2008 20:10:15 -0000 1.9
***************
*** 37,41 ****
G
else
! Tycheck.checkFile G (Defaults.tInit ()) prog
end
--- 37,41 ----
G
else
! Tycheck.checkFile G (Defaults.tInit prog) prog
end
Index: defaults.sig
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/defaults.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** defaults.sig 3 Sep 2006 19:38:36 -0000 1.1
--- defaults.sig 24 Feb 2008 20:10:15 -0000 1.2
***************
*** 22,26 ****
val registerDefault : string * Ast.typ * (unit -> Ast.exp) -> unit
! val tInit : unit -> Ast.typ
val eInit : unit -> Env.env_vars
end
--- 22,26 ----
val registerDefault : string * Ast.typ * (unit -> Ast.exp) -> unit
! val tInit : Ast.file -> Ast.typ
val eInit : unit -> Env.env_vars
end
Index: main.sig
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/main.sig,v
retrieving revision 1.45
retrieving revision 1.46
diff -C2 -d -r1.45 -r1.46
*** main.sig 17 Nov 2007 17:44:11 -0000 1.45
--- main.sig 24 Feb 2008 20:10:15 -0000 1.46
***************
*** 24,28 ****
val setupUser : unit -> string
! val check : string -> Env.env * Ast.exp option
val check' : Env.env -> string -> Env.env
val checkDir : string -> unit
--- 24,28 ----
val setupUser : unit -> string
! val check : Env.env -> string -> Env.env * Ast.exp option
val check' : Env.env -> string -> Env.env
val checkDir : string -> unit
***************
*** 30,35 ****
val basis : unit -> Env.env
! val reduce : string -> Ast.exp option
! val eval : string -> unit
val request : string -> unit
--- 30,35 ----
val basis : unit -> Env.env
! 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
Index: domtool.grm
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/domtool.grm,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** domtool.grm 15 Dec 2007 20:17:26 -0000 1.16
--- domtool.grm 24 Feb 2008 20:10:15 -0000 1.17
***************
*** 80,84 ****
%%
! file : docOpt decls expOpt (docOpt, decls, expOpt)
decls : ([])
--- 80,84 ----
%%
! file : docOpt decls expOpt SEMIopt (docOpt, decls, expOpt)
decls : ([])
***************
*** 97,102 ****
expOpt : (NONE)
! | exp (SOME (ELocal (exp, (ESkip,
(expleft, expright))),
! (expleft, expright)))
--- 97,101 ----
expOpt : (NONE)
! | exp (SOME exp)
Index: eval.sml
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/eval.sml,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** eval.sml 15 Dec 2007 20:17:26 -0000 1.9
--- eval.sml 24 Feb 2008 20:10:15 -0000 1.10
***************
*** 119,121 ****
--- 119,123 ----
end
+ val exec' = fn evs => fn e => conjoin (evs, exec' evs e)
+
end
Index: main-client.sml
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/main-client.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** main-client.sml 17 Nov 2007 13:51:22 -0000 1.8
--- main-client.sml 24 Feb 2008 20:10:15 -0000 1.9
***************
*** 34,38 ****
val (doit, doitDir, args) =
case CommandLine.arguments () of
! "-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check
fname)),
Main.checkDir,
args)
--- 34,38 ----
val (doit, doitDir, args) =
case CommandLine.arguments () of
! "-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check
(Main.basis ()) fname)),
Main.checkDir,
args)
Index: main.sml
===================================================================
RCS file: /cvsroot/hcoop/domtool2/src/main.sml,v
retrieving revision 1.97
retrieving revision 1.98
diff -C2 -d -r1.97 -r1.98
*** main.sml 1 Jan 2008 22:27:58 -0000 1.97
--- main.sml 24 Feb 2008 20:10:16 -0000 1.98
***************
*** 26,33 ****
fun init () = Acl.read Config.aclFile
!
fun check' G fname =
let
val prog = Parse.parse fname
in
if !ErrorMsg.anyErrors then
--- 26,46 ----
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
***************
*** 35,39 ****
else
(Option.app (Unused.check G) (#3 prog);
! Tycheck.checkFile G (Defaults.tInit ()) prog)
end
--- 48,52 ----
else
(Option.app (Unused.check G) (#3 prog);
! Tycheck.checkFile G (Defaults.tInit prog) prog)
end
***************
*** 65,74 ****
end
! fun check fname =
let
val _ = ErrorMsg.reset ()
val _ = Env.preTycheck ()
-
- val b = basis ()
in
if !ErrorMsg.anyErrors then
--- 78,87 ----
end
! (* val b = basis () *)
!
! fun check G fname =
let
val _ = ErrorMsg.reset ()
val _ = Env.preTycheck ()
in
if !ErrorMsg.anyErrors then
***************
*** 79,82 ****
--- 92,96 ----
val _ = ErrorMsg.reset ()
val prog = Parse.parse fname
+ val prog = wrapFile (fname, prog)
in
if !ErrorMsg.anyErrors then
***************
*** 84,93 ****
else
let
! val G' = Tycheck.checkFile b (Defaults.tInit ()) prog
in
if !ErrorMsg.anyErrors then
raise ErrorMsg.Error
else
! (Option.app (Unused.check b) (#3 prog);
(G', #3 prog))
end
--- 98,107 ----
else
let
! val G' = Tycheck.checkFile G (Defaults.tInit prog) prog
in
if !ErrorMsg.anyErrors then
raise ErrorMsg.Error
else
! (Option.app (Unused.check G) (#3 prog);
(G', #3 prog))
end
***************
*** 151,157 ****
checkDir' dname)
! fun reduce fname =
let
! val (G, body) = check fname
in
if !ErrorMsg.anyErrors then
--- 165,171 ----
checkDir' dname)
! fun reduce G fname =
let
! val (G, body) = check G fname
in
if !ErrorMsg.anyErrors then
***************
*** 167,192 ****
PD.space 1,
p_exp body']))*)
! SOME 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 => ()
! fun eval' fname =
! case reduce fname of
! (SOME body') =>
if !ErrorMsg.anyErrors then
raise ErrorMsg.Error
else
! ignore (Eval.exec' (Defaults.eInit ()) body')
! | NONE => ()
val dispatcher =
--- 181,203 ----
PD.space 1,
p_exp body']))*)
! SOME (G, body')
end
| _ => NONE
end
! (*(Defaults.eInit ())*)
! fun eval G evs fname =
! case reduce G fname of
! SOME (G, body') =>
if !ErrorMsg.anyErrors then
raise ErrorMsg.Error
else
! let
! val evs' = Eval.exec' evs body'
! in
! (G, evs')
! end
! | NONE => (G, evs)
val dispatcher =
***************
*** 233,237 ****
fun request fname =
let
! val (user, bio) = requestBio (fn () => ignore (check fname))
val inf = TextIO.openIn fname
--- 244,248 ----
fun request fname =
let
! val (user, bio) = requestBio (fn () => ignore (check (basis ()) fname))
val inf = TextIO.openIn fname
***************
*** 1018,1021 ****
--- 1029,1035 ----
val files = loop []
val (_, files) = Order.order (SOME b) files
+
+ fun checker' (file, (G, evs)) =
+ checker G evs file
in
if !ErrorMsg.anyErrors then
***************
*** 1025,1029 ****
else
();
! app checker files
end
else if String.isSuffix "_admin" user then
--- 1039,1043 ----
else
();
! ignore (foldl checker' (basis (), Defaults.eInit ())
files)
end
else if String.isSuffix "_admin" user then
***************
*** 1066,1071 ****
end
! val regenerate = regenerateEither false eval'
! val regenerateTc = regenerateEither true (ignore o check)
fun rmuser user =
--- 1080,1087 ----
end
! val regenerate = regenerateEither false eval
! val regenerateTc = regenerateEither true
! (fn G => fn evs => fn file =>
! (#1 (check G file),
evs))
fun rmuser user =
***************
*** 1166,1170 ****
val outname = OS.FileSys.tmpName ()
! fun doOne code =
let
val outf = TextIO.openOut outname
--- 1182,1186 ----
val outname = OS.FileSys.tmpName ()
! fun doOne (code, (G, evs)) =
let
val outf = TextIO.openOut outname
***************
*** 1172,1180 ****
TextIO.output (outf, code);
TextIO.closeOut outf;
! eval' outname
end
in
doIt (fn () => (Env.pre ();
! app doOne codes;
Env.post ();
Msg.send (bio, MsgOk);
--- 1188,1196 ----
TextIO.output (outf, code);
TextIO.closeOut outf;
! eval G evs outname
end
in
doIt (fn () => (Env.pre ();
! ignore (foldl doOne (basis (),
Defaults.eInit ()) codes);
Env.post ();
Msg.send (bio, MsgOk);
-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/
_______________________________________________
hcoop-cvs mailing list
hcoop-cvs@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/hcoop-cvs
