Mercurial > urweb

comparison src/compiler.sml @ 2304:6fb9232ade99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge Sqlcache
author Adam Chlipala <adam@chlipala.net>
date Sun, 20 Dec 2015 14:18:52 -0500
parents 6eae499c56cb f8903af753ff
children
comparison
equal deleted inserted replaced
2201:1091227f535a 2304:6fb9232ade99
14 * 14 *
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
25 * POSSIBILITY OF SUCH DAMAGE. 25 * POSSIBILITY OF SUCH DAMAGE.
26 *) 26 *)
27 27
28 structure Compiler :> COMPILER = struct 28 structure Compiler :> COMPILER = struct
29 29
30 structure UrwebLrVals = UrwebLrValsFn(structure Token = LrParser.Token) 30 structure UrwebLrVals = UrwebLrValsFn(structure Token = LrParser.Token)
31 structure Lex = UrwebLexFn(structure Tokens = UrwebLrVals.Tokens) 31 structure Lex = UrwebLexFn(structure Tokens = UrwebLrVals.Tokens)
32 structure UrwebP = Join(structure ParserData = UrwebLrVals.ParserData 32 structure UrwebP = Join(structure ParserData = UrwebLrVals.ParserData
33 structure Lex = Lex 33 structure Lex = Lex
266 char = 0}} "File starts with 'sig'"; 266 char = 0}} "File starts with 'sig'";
267 []) 267 [])
268 | _ => absyn 268 | _ => absyn
269 end 269 end
270 handle LrParser.ParseError => [], 270 handle LrParser.ParseError => [],
271 print = SourcePrint.p_file} 271 print = SourcePrint.p_file}
272 272
273 fun p_job ({prefix, database, exe, sql, sources, debug, profile, 273 fun p_job ({prefix, database, exe, sql, sources, debug, profile,
274 timeout, ffi, link, headers, scripts, 274 timeout, ffi, link, headers, scripts,
275 clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsFuncs, ...} : job) = 275 clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsFuncs, ...} : job) =
276 let 276 let
1092 in 1092 in
1093 if SS.member (!fulls, full) then 1093 if SS.member (!fulls, full) then
1094 ErrorMsg.error ("Rooted module " ^ full ^ " has multiple versions.") 1094 ErrorMsg.error ("Rooted module " ^ full ^ " has multiple versions.")
1095 else 1095 else
1096 (); 1096 ();
1097 1097
1098 makeD true "" pieces 1098 makeD true "" pieces
1099 before ignore (foldl (fn (new, path) => 1099 before ignore (foldl (fn (new, path) =>
1100 let 1100 let
1101 val new' = case path of 1101 val new' = case path of
1102 "" => new 1102 "" => new
1447 print = MonoPrint.p_file MonoEnv.empty 1447 print = MonoPrint.p_file MonoEnv.empty
1448 } 1448 }
1449 1449
1450 val toSigcheck = transform sigcheck "sigcheck" o toSidecheck 1450 val toSigcheck = transform sigcheck "sigcheck" o toSidecheck
1451 1451
1452 val sqlcache = {
1453 func = (fn file =>
1454 if Settings.getSqlcache ()
1455 then let val file = MonoInline.inlineFull file in Sqlcache.go file end
1456 else file),
1457 print = MonoPrint.p_file MonoEnv.empty
1458 }
1459
1460 val toSqlcache = transform sqlcache "sqlcache" o toSigcheck
1461
1452 val cjrize = { 1462 val cjrize = {
1453 func = Cjrize.cjrize, 1463 func = Cjrize.cjrize,
1454 print = CjrPrint.p_file CjrEnv.empty 1464 print = CjrPrint.p_file CjrEnv.empty
1455 } 1465 }
1456 1466
1457 val toCjrize = transform cjrize "cjrize" o toSigcheck 1467 val toCjrize = transform cjrize "cjrize" o toSqlcache
1458 1468
1459 val prepare = { 1469 val prepare = {
1460 func = Prepare.prepare, 1470 func = Prepare.prepare,
1461 print = CjrPrint.p_file CjrEnv.empty 1471 print = CjrPrint.p_file CjrEnv.empty
1462 } 1472 }
1608 TextIO.closeOut outf 1618 TextIO.closeOut outf
1609 end; 1619 end;
1610 1620
1611 compileC {cname = cname, oname = oname, ename = ename, libs = libs, 1621 compileC {cname = cname, oname = oname, ename = ename, libs = libs,
1612 profile = #profile job, debug = #debug job, linker = #linker job, link = #link job} 1622 profile = #profile job, debug = #debug job, linker = #linker job, link = #link job}
1613 1623
1614 before cleanup ()) 1624 before cleanup ())
1615 end 1625 end
1616 handle ex => (((cleanup ()) handle _ => ()); raise ex) 1626 handle ex => (((cleanup ()) handle _ => ()); raise ex)
1617 end 1627 end
1618 1628