Annotation of /sml/trunk/src/compiler/TopLevel/interact/interact.sml

Parent Directory | Revision Log

---

Revision 260 - (view) (download)

1 :	monnier	16	(* COPYRIGHT (c) 1996 Bell Laboratories. *)
2 :			(* interact.sml *)
3 :
4 :			functor Interact(EvalLoop : EVALLOOP) : INTERACT =
5 :			struct
6 :			exception Interrupt = EvalLoop.Interrupt
7 :
8 :	monnier	45	(* This is where CM can install itelf into. Added for the purpose of
9 :	monnier	16	* autoloading. (blume)
10 :			*)
11 :			type envref = EnvRef.envref
12 :
13 :			fun installCompManager m = (#compManagerHook EvalLoop.stdParams) := m
14 :
15 :			fun interact() = (
16 :			EvalLoop.interact EvalLoop.stdParams;
17 :			OS.Process.exit OS.Process.success)
18 :
19 :			fun useFile (fname: string) =
20 :			(app Control.Print.say ["[opening ",fname,"]\n"];
21 :			EvalLoop.evalStream EvalLoop.stdParams
22 :			(fname,(TextIO.openIn fname
23 :			handle e as IO.Io _ =>
24 :			(app Control.Print.say["[use failed: ",
25 :			General.exnMessage e,
26 :			"]\n"];
27 :			raise ErrorMsg.Error))))
28 :
29 :			fun useStream (stream: TextIO.instream) =
30 :	monnier	45	EvalLoop.evalStream EvalLoop.stdParams ("<instream>", stream)
31 :	monnier	16
32 :	monnier	95	fun evalStream (stream: TextIO.instream, baseEnv: CMEnv.Env.environment) :
33 :			CMEnv.Env.environment =
34 :	monnier	16	let val r = ref Environment.emptyEnv
35 :			val localEnvRef = {get=(fn()=> !r),set=(fn x=>r:=x)}
36 :			val b = ref baseEnv
37 :	monnier	45	val baseEnvRef =
38 :			{get=(fn()=> !b),set=(fn _ => raise Fail "evalStream")}
39 :	monnier	16	in EvalLoop.evalStream
40 :			({compManagerHook = ref NONE,
41 :			(* ???? should CM get its hands into that? *)
42 :			baseEnvRef = baseEnvRef,
43 :			localEnvRef=localEnvRef,
44 :	monnier	45	transform=(fn x => x),
45 :			instrument=(fn _ => fn x => x),
46 :	monnier	16	perform=(fn x => x),
47 :			isolate= #isolate EvalLoop.stdParams,
48 :			printer= #printer EvalLoop.stdParams})
49 :			("<instream>", stream);
50 :	monnier	95	CMEnv.CM (#get localEnvRef ())
51 :	monnier	16	end
52 :
53 :	monnier	45	(* These mUse functions should really be part of the Open Compiler *)
54 :			val mUseFile_hiddenList =
55 :			ref [ [((fn () => (print "--mUseFile not reset!")),"Error!")] ];
56 :
57 :			fun mUseFile_reset () = (mUseFile_hiddenList := [])
58 :			fun mUseFile_add f = (mUseFile_hiddenList := (f::(!mUseFile_hiddenList)))
59 :			fun mUseFile_list () = (List.rev(!mUseFile_hiddenList))
60 :
61 :			fun mUseFile (test) (fname: string) =
62 :			let fun repeat test n =
63 :			if (test n) then (useFile fname; repeat test (n+1)) else ()
64 :			in repeat test 0 end
65 :
66 :	monnier	16	end (* functor Interact *)
67 :	monnier	95
68 :			(*
69 :	monnier	118	* $Log$
70 :	monnier	95	*)

---

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