Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/TopLevel/interact/interact.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 24 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/TopLevel/interact/interact.sml

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

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