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/compiler/TopLevel/main/compile.sml
ViewVC logotype

Annotation of /sml/trunk/compiler/TopLevel/main/compile.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4448 - (view) (download)

1 : jhr 4432 (* compile.sml
2 :     *
3 :     * COPYRIGHT (c) 2017 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 :     *)
6 : monnier 16
7 :     functor CompileF(structure M : CODEGENERATOR
8 : blume 1078 structure CC : CCONFIG
9 :     val cproto_conv : string) : COMPILE0 =
10 : monnier 16 struct
11 :    
12 : blume 879 fun mkCompInfo { source, transform } =
13 :     CompInfo.mkCompInfo { source = source,
14 :     transform = transform,
15 :     mkMkStamp = CC.mkMkStamp }
16 : monnier 16
17 : blume 879 type pickle = CC.pickle (* pickled format *)
18 :     type hash = CC.hash (* environment hash id *)
19 : blume 1058 type pid = CC.pid
20 : blume 1137 type guid = CC.guid
21 : monnier 16
22 : blume 879 (*************************************************************************
23 :     * ELABORATION *
24 :     *************************************************************************)
25 : monnier 16
26 : blume 879 (** several preprocessing phases done after parsing or
27 :     ** after elaborations *)
28 :     (*
29 :     val fixityparse =
30 : jhr 4448 (* Stats.doPhase (Stats.makePhase "Compiler 005 fixityparse") *)
31 : blume 879 FixityParse.fixityparse
32 :     val lazycomp =
33 :     (* Stats.doPhase (Stats.makePhase "Compiler 006 lazycomp") *)
34 :     LazyComp.lazycomp
35 :     *)
36 : jhr 4448 val pickUnpick =
37 : blume 879 Stats.doPhase (Stats.makePhase "Compiler 036 pickunpick") CC.pickUnpick
38 : monnier 16
39 : blume 879 (** take ast, do semantic checks,
40 :     ** and output the new env, absyn and pickles *)
41 : blume 1137 fun elaborate {ast, statenv=senv, compInfo=cinfo, guid} = let
42 : monnier 16
43 : blume 879 val (absyn, nenv) = ElabTop.elabTop(ast, senv, cinfo)
44 : jhr 4448 val (absyn, nenv) =
45 : blume 879 if CompInfo.anyErrors cinfo then
46 :     (Absyn.SEQdec nil, StaticEnv.empty)
47 :     else (absyn, nenv)
48 : blume 1137 val { pid, pickle, exportLvars, exportPid, newenv } =
49 :     pickUnpick { context = senv, env = nenv, guid = guid }
50 : jhr 4448 in {absyn=absyn, newstatenv=newenv, exportPid=exportPid,
51 : blume 1137 exportLvars=exportLvars, staticPid = pid, pickle = pickle }
52 : blume 879 end (* function elaborate *)
53 : monnier 16
54 : blume 879 val elaborate =
55 :     Stats.doPhase(Stats.makePhase "Compiler 030 elaborate") elaborate
56 : monnier 16
57 : blume 879 (*************************************************************************
58 :     * ABSYN INSTRUMENTATION *
59 :     *************************************************************************)
60 : monnier 16
61 : blume 903 local
62 :     val isSpecial = let
63 :     val l = [SpecialSymbols.paramId,
64 :     SpecialSymbols.functorId,
65 :     SpecialSymbols.hiddenId,
66 :     SpecialSymbols.tempStrId,
67 :     SpecialSymbols.tempFctId,
68 :     SpecialSymbols.fctbodyId,
69 :     SpecialSymbols.anonfsigId,
70 :     SpecialSymbols.resultId,
71 :     SpecialSymbols.returnId,
72 :     SpecialSymbols.internalVarId]
73 :     in
74 :     fn s => List.exists (fn s' => Symbol.eq (s, s')) l
75 :     end
76 :     in
77 : blume 879 (** instrumenting the abstract syntax to do time- and space-profiling *)
78 :     fun instrument {source, senv, compInfo} =
79 : jhr 4448 SProf.instrumDec (senv, compInfo) source
80 : jhr 4432 o TProf.instrumDec PrimopId.isPrimCallcc (senv, compInfo)
81 : mblume 1650 o TDPInstrument.instrument isSpecial (senv, compInfo)
82 : blume 903 end
83 : monnier 16
84 : blume 879 val instrument =
85 :     Stats.doPhase (Stats.makePhase "Compiler 039 instrument") instrument
86 : monnier 16
87 : blume 879 (*************************************************************************
88 :     * TRANSLATION INTO FLINT *
89 :     *************************************************************************)
90 : monnier 16
91 : blume 879 (** take the abstract syntax tree, generate the flint intermediate code *)
92 :     fun translate{absyn, exportLvars, newstatenv, oldstatenv, compInfo} =
93 :     (*** statenv used for printing Absyn in messages ***)
94 :     let val statenv = StaticEnv.atop (newstatenv, oldstatenv)
95 :     in
96 : blume 1078 Translate.transDec { rootdec = absyn,
97 :     exportLvars = exportLvars,
98 : dbm 2492 oldenv = oldstatenv,
99 :     env = statenv,
100 : blume 1078 cproto_conv = cproto_conv,
101 :     compInfo = compInfo }
102 : blume 879 end
103 : monnier 16
104 : blume 879 val translate =
105 : jhr 4448 Stats.doPhase (Stats.makePhase "Compiler 040 translate") translate
106 : monnier 16
107 :    
108 : blume 879 (*************************************************************************
109 :     * CODE GENERATION *
110 :     *************************************************************************)
111 : monnier 16
112 : blume 879 (** take the flint code and generate the machine binary code *)
113 :     local
114 :     val inline = LSplitInline.inline
115 :     val addCode = Stats.addStat (Stats.makeStat "Code Size")
116 :     in
117 :     fun codegen { flint, imports, symenv, splitting, compInfo } = let
118 :     (* hooks for cross-module inlining and specialization *)
119 :     val (flint, revisedImports) = inline (flint, imports, symenv)
120 : monnier 113
121 : blume 879 (* from optimized FLINT code, generate the machine code. *)
122 :     val (csegs,inlineExp) = M.flintcomp(flint, compInfo, splitting)
123 :     (* Obey the nosplit directive used during bootstrapping. *)
124 :     (* val inlineExp = if isSome splitting then inlineExp else NONE *)
125 :     val codeSz =
126 :     List.foldl
127 :     (fn (co, n) => n + CodeObj.size co)
128 :     (CodeObj.size(#c0 csegs) + Word8Vector.length(#data csegs))
129 : monnier 251 (#cn csegs)
130 : blume 879 in
131 :     addCode codeSz;
132 :     { csegments=csegs, inlineExp=inlineExp, imports = revisedImports }
133 : jhr 4448 end
134 : blume 879 end (* local codegen *)
135 : monnier 16
136 : blume 587 (*
137 : blume 879 val codegen =
138 :     Stats.doPhase (Stats.makePhase "Compiler 140 CodeGen") codegen
139 : blume 587 *)
140 : monnier 16
141 : blume 879 (*************************************************************************
142 :     * COMPILATION *
143 :     * = ELABORATION + TRANSLATION TO FLINT + CODE GENERATION *
144 : jhr 4448 * used by interact/evalloop.sml, cm/compile/compile.sml only *
145 : blume 879 *************************************************************************)
146 :     (** compiling the ast into the binary code = elab + translate + codegen *)
147 : blume 1058 fun compile {source, ast, statenv, symenv, compInfo=cinfo,
148 : jhr 4448 checkErr=check, splitting, guid } =
149 : blume 1058 let val {absyn, newstatenv, exportLvars, exportPid,
150 : blume 1137 staticPid, pickle } =
151 : blume 1058 elaborate {ast=ast, statenv=statenv, compInfo=cinfo,
152 : blume 1137 guid = guid}
153 : blume 879 before (check "elaborate")
154 : monnier 16
155 : blume 879 val absyn = instrument {source=source, senv = statenv,
156 :     compInfo=cinfo} absyn
157 :     before (check "instrument")
158 : monnier 16
159 : jhr 4448 val {flint, imports} =
160 :     translate {absyn=absyn, exportLvars=exportLvars,
161 :     newstatenv=newstatenv, oldstatenv=statenv,
162 : blume 879 compInfo=cinfo}
163 :     before check "translate"
164 : monnier 16
165 : jhr 4448 val { csegments, inlineExp, imports = revisedImports } =
166 :     codegen { flint = flint, imports = imports, symenv = symenv,
167 : blume 879 splitting = splitting, compInfo = cinfo }
168 :     before (check "codegen")
169 :     (*
170 :     * interp mode was currently turned off.
171 :     *
172 :     * if !Control.interp then Interp.interp flint
173 :     * else codegen {flint=flint, splitting=splitting, compInfo=cinfo})
174 :     *)
175 :     in
176 :     { csegments = csegments,
177 :     newstatenv = newstatenv,
178 :     absyn = absyn,
179 :     exportPid = exportPid,
180 :     exportLvars = exportLvars,
181 :     staticPid = staticPid,
182 :     pickle = pickle,
183 :     inlineExp = inlineExp,
184 :     imports = revisedImports }
185 :     end (* function compile *)
186 : monnier 16 end (* functor CompileF *)

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