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/batch/cmsa.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/TopLevel/batch/cmsa.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)

1 : monnier 16 (* COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies *)
2 :     (* cmsa.sml *)
3 :    
4 :     functor CMSAFun (structure BU : BATCHUTIL
5 :     structure C : COMPILE) :> CMSA = struct
6 :    
7 :     structure E = SCEnv.Env
8 :     structure P = Control.Print
9 :     structure S = Symbol
10 :    
11 :     type env = E.environment (* environments *)
12 :     type sym = S.symbol (* symbols *)
13 :    
14 :     (* build symbols from strings *)
15 :     val STR = S.strSymbol (* structure *)
16 :     val SIG = S.sigSymbol (* signature *)
17 :     val FCT = S.fctSymbol (* functor *)
18 :     val FSIG = S.fsigSymbol (* funsig *)
19 :    
20 :     (* fetch the pervasive environment *)
21 :     fun pervenv () = #get EnvRef.pervasive ()
22 :    
23 :     (* add a delta to the toplevel environment *)
24 :     fun register e = let
25 :     val tl = EnvRef.topLevel
26 :     val base = #get tl ()
27 :     val new = Environment.concatEnv (SCEnv.unSC e, base)
28 :     in
29 :     #set tl new
30 :     end
31 :    
32 :     (* build a layered environment from a list of environments;
33 :     * the head of the list goes on top *)
34 :     val layer = foldr E.concatEnv E.emptyEnv
35 :    
36 :    
37 :     (* filter environment by list of symbols *)
38 :     fun filter sl e = E.filterEnv (e, sl)
39 :    
40 :     (* first try loading the binfile (derived from 1st argument);
41 :     * if this fails, then try compiling the source (1st argument);
42 :     * after one of the two steps succeeds run the code *)
43 :     fun run (source, base) = let
44 :     fun loadbin () = let
45 :     val { dir, file } = OS.Path.splitDirFile source
46 :     val cmdir = OS.Path.joinDirFile { dir = dir, file = "CM" }
47 :     val file = file ^ ".bin"
48 :     val oskind =
49 :     case SMLofNJ.SysInfo.getOSKind () of
50 :     SMLofNJ.SysInfo.UNIX => "unix"
51 :     | SMLofNJ.SysInfo.WIN32 => "win32"
52 :     | SMLofNJ.SysInfo.MACOS => "macos"
53 :     | SMLofNJ.SysInfo.OS2 => "os2"
54 :     | SMLofNJ.SysInfo.BEOS => "beos"
55 :     val arch'os = concat [BU.arch, "-", oskind]
56 :     val archosdir = OS.Path.joinDirFile { dir = cmdir, file = arch'os }
57 :     val bin = OS.Path.joinDirFile { dir = archosdir, file = file }
58 :     val _ = P.say (concat ["Loading: ", bin, "..."])
59 :     val f = BinIO.openIn bin
60 :     fun rest () = let
61 :     val cu = BU.readUnit { name = bin,
62 :     stream = f,
63 :     pids2iid = fn _ => (),
64 :     senv = E.staticPart base,
65 :     keep_code = true }
66 :     val _ = BinIO.closeIn f
67 :     val _ = P.say "ok - executing..."
68 :     val e = BU.execUnit(cu, E.dynamicPart base)
69 :     val _ = P.say "done\n"
70 :     in
71 :     e
72 :     end
73 :     in
74 :     rest () handle e => (BinIO.closeIn f; raise e)
75 :     end
76 :     fun compilesource () = let
77 :     val filename = source
78 :     val _ = P.say (concat ["failed.\n\tTrying to compile ",
79 :     filename, "... "])
80 :     val s = TextIO.openIn filename
81 :     val source = Source.newSource (filename, 1, s, false,
82 :     { linewidth = !P.linewidth,
83 :     flush = P.flush,
84 :     consumer = P.say })
85 :     val ast = C.parse source
86 :     handle exn => (TextIO.closeIn s; raise exn)
87 :     val _ = TextIO.closeIn s
88 :     val errors = ErrorMsg.errors source
89 :     fun check phase =
90 :     if ErrorMsg.anyErrors errors then let
91 :     val msg = phase ^ " failed."
92 :     val _ = P.say msg
93 :     in
94 :     raise C.Compile msg
95 :     end
96 :     else ()
97 :     val corenv = #get EnvRef.core ()
98 :     val cinfo = C.mkCompInfo (source, corenv, fn x => x)
99 :    
100 :     val {csegments=code, newstatenv, exportPid, imports,
101 :     inlineExp, ...} =
102 :     C.compile {source=source, ast=ast,
103 :     statenv=E.staticPart base,
104 :     symenv=E.symbolicPart base,
105 :     compInfo=cinfo, checkErr=check,
106 :     runtimePid=NONE, splitting=true}
107 :     val obj = C.mkexec code
108 :     val _ = P.say "ok - executing..."
109 :     val ndenv = C.execute {executable=C.mkexec code,
110 :     imports=imports, exportPid=exportPid,
111 :     dynenv=E.dynamicPart base}
112 :     val _ = P.say "done\n"
113 :     in
114 :     E.mkenv {static=newstatenv, dynamic=ndenv,
115 :     symbolic= C.mksymenv(exportPid, inlineExp)}
116 :     end
117 :     in
118 :     loadbin () handle _ => compilesource ()
119 :     end
120 :    
121 :     end (* functor CMSAFun *)
122 :    
123 :    
124 :    
125 :    
126 :    
127 :    
128 :    
129 :    
130 :    

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