Mercurial > urweb

comparison src/compiler.sml @ 2202:606af2c9b828

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Identifies tables read or touched by queries.
author Ziv Scully <ziv@mit.edu>
date Sat, 08 Mar 2014 05:06:22 -0500
parents b15a4c2cb542
children 39faa4a037f4
comparison
equal deleted inserted replaced
1994:94529780bbcf 2202:606af2c9b828
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
1088 in 1088 in
1089 if SS.member (!fulls, full) then 1089 if SS.member (!fulls, full) then
1090 ErrorMsg.error ("Rooted module " ^ full ^ " has multiple versions.") 1090 ErrorMsg.error ("Rooted module " ^ full ^ " has multiple versions.")
1091 else 1091 else
1092 (); 1092 ();
1093 1093
1094 makeD true "" pieces 1094 makeD true "" pieces
1095 before ignore (foldl (fn (new, path) => 1095 before ignore (foldl (fn (new, path) =>
1096 let 1096 let
1097 val new' = case path of 1097 val new' = case path of
1098 "" => new 1098 "" => new
1436 print = MonoPrint.p_file MonoEnv.empty 1436 print = MonoPrint.p_file MonoEnv.empty
1437 } 1437 }
1438 1438
1439 val toSigcheck = transform sigcheck "sigcheck" o toSidecheck 1439 val toSigcheck = transform sigcheck "sigcheck" o toSidecheck
1440 1440
1441 val sqlcache = {
1442 func = (fn file => (Sql.go file; file)),
1443 print = MonoPrint.p_file MonoEnv.empty
1444 }
1445
1446 val toSqlcache = transform sqlcache "sqlcache" o toSigcheck
1447
1441 val cjrize = { 1448 val cjrize = {
1442 func = Cjrize.cjrize, 1449 func = Cjrize.cjrize,
1443 print = CjrPrint.p_file CjrEnv.empty 1450 print = CjrPrint.p_file CjrEnv.empty
1444 } 1451 }
1445 1452
1446 val toCjrize = transform cjrize "cjrize" o toSigcheck 1453 val toCjrize = transform cjrize "cjrize" o toSqlcache
1447 1454
1448 val prepare = { 1455 val prepare = {
1449 func = Prepare.prepare, 1456 func = Prepare.prepare,
1450 print = CjrPrint.p_file CjrEnv.empty 1457 print = CjrPrint.p_file CjrEnv.empty
1451 } 1458 }
1594 TextIO.closeOut outf 1601 TextIO.closeOut outf
1595 end; 1602 end;
1596 1603
1597 compileC {cname = cname, oname = oname, ename = ename, libs = libs, 1604 compileC {cname = cname, oname = oname, ename = ename, libs = libs,
1598 profile = #profile job, debug = #debug job, linker = #linker job, link = #link job} 1605 profile = #profile job, debug = #debug job, linker = #linker job, link = #link job}
1599 1606
1600 before cleanup ()) 1607 before cleanup ())
1601 end 1608 end
1602 handle ex => (((cleanup ()) handle _ => ()); raise ex) 1609 handle ex => (((cleanup ()) handle _ => ()); raise ex)
1603 end 1610 end
1604 1611