Mercurial > urweb

comparison src/compiler.sml @ 1362:fd34210bc3e5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add an extra Especialize pass before Rpcify
author Adam Chlipala <adam@chlipala.net>
date Fri, 24 Dec 2010 12:51:46 -0500
parents 0a2b630f2463
children b2bc8bcd546f
comparison
equal deleted inserted replaced
1361:7a436b6267ab 1362:fd34210bc3e5
131 | SOME v => 131 | SOME v =>
132 (print "Success\n"; 132 (print "Success\n";
133 Print.print (#print tr v); 133 Print.print (#print tr v);
134 print "\n")) 134 print "\n"))
135 135
136 fun runPrintToFile (tr : ('src, 'dst) transform) input fname =
137 (ErrorMsg.resetErrors ();
138 case #func tr input of
139 NONE => print "Failure\n"
140 | SOME v =>
141 let
142 val outf = TextIO.openOut fname
143 val str = Print.openOut {dst = outf, wid = 80}
144 in
145 print "Success\n";
146 Print.fprint str (#print tr v);
147 Print.PD.PPS.closeStream str;
148 TextIO.closeOut outf
149 end)
150
136 fun time (tr : ('src, 'dst) transform) input = 151 fun time (tr : ('src, 'dst) transform) input =
137 let 152 let
138 val (_, pmap) = #time tr (input, []) 153 val (_, pmap) = #time tr (input, [])
139 in 154 in
140 app (fn (name, time) => 155 app (fn (name, time) =>
156 | SOME v => 171 | SOME v =>
157 (print "Success\n"; 172 (print "Success\n";
158 Print.print (#print tr v); 173 Print.print (#print tr v);
159 print "\n") 174 print "\n")
160 end 175 end
176
177 fun runPrintCoreFuncs (tr : ('src, Core.file) transform) input =
178 (ErrorMsg.resetErrors ();
179 case #func tr input of
180 NONE => print "Failure\n"
181 | SOME file =>
182 (print "Success\n";
183 app (fn (d, _) =>
184 case d of
185 Core.DVal (x, _, t, _, _) => Print.preface(x, CorePrint.p_con CoreEnv.empty t)
186 | Core.DValRec xts => app (fn (x, _, t, _, _) => Print.preface(x, CorePrint.p_con CoreEnv.empty t)) xts
187 | _ => ()) file))
161 188
162 val parseUrs = 189 val parseUrs =
163 {func = fn filename => let 190 {func = fn filename => let
164 val fname = OS.FileSys.tmpName () 191 val fname = OS.FileSys.tmpName ()
165 val outf = TextIO.openOut fname 192 val outf = TextIO.openOut fname
1058 print = CorePrint.p_file CoreEnv.empty 1085 print = CorePrint.p_file CoreEnv.empty
1059 } 1086 }
1060 1087
1061 val toShake1 = transform shake "shake1" o toCore_untangle 1088 val toShake1 = transform shake "shake1" o toCore_untangle
1062 1089
1090 val toEspecialize1' = transform especialize "especialize1'" o toShake1
1091 val toShake1' = transform shake "shake1'" o toEspecialize1'
1092
1063 val rpcify = { 1093 val rpcify = {
1064 func = Rpcify.frob, 1094 func = Rpcify.frob,
1065 print = CorePrint.p_file CoreEnv.empty 1095 print = CorePrint.p_file CoreEnv.empty
1066 } 1096 }
1067 1097
1068 val toRpcify = transform rpcify "rpcify" o toShake1 1098 val toRpcify = transform rpcify "rpcify" o toShake1'
1069 1099
1070 val toCore_untangle2 = transform core_untangle "core_untangle2" o toRpcify 1100 val toCore_untangle2 = transform core_untangle "core_untangle2" o toRpcify
1071 val toShake2 = transform shake "shake2" o toCore_untangle2 1101 val toShake2 = transform shake "shake2" o toCore_untangle2
1072 1102
1073 val toEspecialize1 = transform especialize "especialize1" o toShake2 1103 val toEspecialize1 = transform especialize "especialize1" o toShake2
1262 1292
1263 val compile = "gcc " ^ Config.gccArgs ^ " -Wimplicit -Werror -O3 -fno-inline -I " ^ Config.includ 1293 val compile = "gcc " ^ Config.gccArgs ^ " -Wimplicit -Werror -O3 -fno-inline -I " ^ Config.includ
1264 ^ " " ^ #compile proto 1294 ^ " " ^ #compile proto
1265 ^ " -c " ^ cname ^ " -o " ^ oname 1295 ^ " -c " ^ cname ^ " -o " ^ oname
1266 1296
1267 val link = "gcc -Werror -O3 -lm -pthread " ^ Config.gccArgs ^ " " ^ libs ^ " " ^ lib ^ " " ^ mhash ^ " " ^ oname 1297 val link = "gcc -Werror -O3 -lm -lcrypt -pthread " ^ Config.gccArgs ^ " " ^ libs ^ " " ^ lib ^ " " ^ mhash ^ " " ^ oname
1268 ^ " -o " ^ ename 1298 ^ " -o " ^ ename
1269 1299
1270 val (compile, link) = 1300 val (compile, link) =
1271 if profile then 1301 if profile then
1272 (compile ^ " -pg", link ^ " -pg") 1302 (compile ^ " -pg", link ^ " -pg")