Mercurial > urweb

comparison src/mono_opt.sml @ 2221:278e10629ba1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Basic field-resolution invalidation.
author Ziv Scully <ziv@mit.edu>
date Sat, 29 Nov 2014 03:37:59 -0500
parents 4d64af730e35
children 5709482a2afd
comparison
equal deleted inserted replaced
2220:794017f378de 2221:278e10629ba1
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
164 end 164 end
165 else 165 else
166 e 166 e
167 167
168 | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => exp (EStrcat (e1, e2)) 168 | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => exp (EStrcat (e1, e2))
169 169
170 | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EPrim (Prim.String (Prim.Html, s2)), _)) => 170 | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EPrim (Prim.String (Prim.Html, s2)), _)) =>
171 let 171 let
172 val s = 172 val s =
173 if size s1 > 0 andalso size s2 > 0 173 if size s1 > 0 andalso size s2 > 0
174 andalso Char.isSpace (String.sub (s1, size s1 - 1)) 174 andalso Char.isSpace (String.sub (s1, size s1 - 1))
177 else 177 else
178 s1 ^ s2 178 s1 ^ s2
179 in 179 in
180 EPrim (Prim.String (Prim.Html, s)) 180 EPrim (Prim.String (Prim.Html, s))
181 end 181 end
182 182
183 | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EPrim (Prim.String (_, s2)), _)) => 183 | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EPrim (Prim.String (_, s2)), _)) =>
184 EPrim (Prim.String (Prim.Normal, s1 ^ s2)) 184 EPrim (Prim.String (Prim.Normal, s1 ^ s2))
185 185
186 | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EStrcat ((EPrim (Prim.String (Prim.Html, s2)), _), rest), _)) => 186 | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EStrcat ((EPrim (Prim.String (Prim.Html, s2)), _), rest), _)) =>
187 let 187 let
395 395
396 | EWrite (EQuery {exps, tables, state, query, 396 | EWrite (EQuery {exps, tables, state, query,
397 initial = (EPrim (Prim.String (k, "")), _), 397 initial = (EPrim (Prim.String (k, "")), _),
398 body = (EStrcat ((EPrim (Prim.String (_, s)), _), 398 body = (EStrcat ((EPrim (Prim.String (_, s)), _),
399 (EStrcat ((ERel 0, _), 399 (EStrcat ((ERel 0, _),
400 e'), _)), _)}, loc) => 400 e'), _)), _),
401 sqlcacheInfo}, loc) =>
401 if (case k of Prim.Normal => s = "" | Prim.Html => CharVector.all Char.isSpace s) then 402 if (case k of Prim.Normal => s = "" | Prim.Html => CharVector.all Char.isSpace s) then
402 EQuery {exps = exps, tables = tables, query = query, 403 EQuery {exps = exps, tables = tables, query = query,
403 state = (TRecord [], loc), 404 state = (TRecord [], loc),
404 initial = (ERecord [], loc), 405 initial = (ERecord [], loc),
405 body = (optExp (EWrite e', loc), loc)} 406 body = (optExp (EWrite e', loc), loc),
407 sqlcacheInfo = Monoize.urlifiedUnit}
406 else 408 else
407 e 409 e
408 410
409 | EWrite (EQuery {exps, tables, state, query, 411 | EWrite (EQuery {exps, tables, state, query,
410 initial = (EPrim (Prim.String (_, "")), _), 412 initial = (EPrim (Prim.String (_, "")), _),
411 body}, loc) => 413 body, sqlcacheInfo}, loc) =>
412 let 414 let
413 fun passLets (depth, (e', _), lets) = 415 fun passLets (depth, (e', _), lets) =
414 case e' of 416 case e' of
415 EStrcat ((ERel x, _), e'') => 417 EStrcat ((ERel x, _), e'') =>
416 if x = depth then 418 if x = depth then
421 body lets 423 body lets
422 in 424 in
423 EQuery {exps = exps, tables = tables, query = query, 425 EQuery {exps = exps, tables = tables, query = query,
424 state = (TRecord [], loc), 426 state = (TRecord [], loc),
425 initial = (ERecord [], loc), 427 initial = (ERecord [], loc),
426 body = body} 428 body = body,
429 sqlcacheInfo = Monoize.urlifiedUnit}
427 end 430 end
428 else 431 else
429 e 432 e
430 | ELet (x, t, e', e'') => 433 | ELet (x, t, e', e'') =>
431 passLets (depth + 1, e'', (x, t, e') :: lets) 434 passLets (depth + 1, e'', (x, t, e') :: lets)
530 (if Settings.checkEnvVar s then 533 (if Settings.checkEnvVar s then
531 ESome ((TFfi ("Basis", "string"), loc), (se, loc)) 534 ESome ((TFfi ("Basis", "string"), loc), (se, loc))
532 else 535 else
533 ENone (TFfi ("Basis", "string"), loc)) 536 ENone (TFfi ("Basis", "string"), loc))
534 537
535 | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) => 538 | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) =>
536 let 539 let
537 fun uwify (cs, acc) = 540 fun uwify (cs, acc) =
538 case cs of 541 case cs of
539 [] => String.concat (rev acc) 542 [] => String.concat (rev acc)
540 | #"(" :: #"_" :: cs => uwify (cs, "(uw_" :: acc) 543 | #"(" :: #"_" :: cs => uwify (cs, "(uw_" :: acc)
558 | cs => uwify (cs, []) 561 | cs => uwify (cs, [])
559 in 562 in
560 EPrim (Prim.String (Prim.Normal, s)) 563 EPrim (Prim.String (Prim.Normal, s))
561 end 564 end
562 565
563 | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String (_, s)), loc), _)]) => 566 | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String (_, s)), loc), _)]) =>
564 let 567 let
565 fun uwify (cs, acc) = 568 fun uwify (cs, acc) =
566 case cs of 569 case cs of
567 [] => String.concat (rev acc) 570 [] => String.concat (rev acc)
568 | #"A" :: #"S" :: #" " :: #"_" :: cs => uwify (cs, "AS uw_" :: acc) 571 | #"A" :: #"S" :: #" " :: #"_" :: cs => uwify (cs, "AS uw_" :: acc)
583 val s = uwify (String.explode s, []) 586 val s = uwify (String.explode s, [])
584 in 587 in
585 EPrim (Prim.String (Prim.Normal, s)) 588 EPrim (Prim.String (Prim.Normal, s))
586 end 589 end
587 590
588 | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String (_, s)), _), _)]) => 591 | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String (_, s)), _), _)]) =>
589 EPrim (Prim.String (Prim.Normal, unAs s)) 592 EPrim (Prim.String (Prim.Normal, unAs s))
590 | EFfiApp ("Basis", "unAs", [(e', _)]) => 593 | EFfiApp ("Basis", "unAs", [(e', _)]) =>
591 let 594 let
592 fun parts (e as (_, loc)) = 595 fun parts (e as (_, loc)) =
593 case #1 e of 596 case #1 e of
618 EFfiApp ("Basis", "attrifyChar", [e]) 621 EFfiApp ("Basis", "attrifyChar", [e])
619 | EFfiApp ("Basis", "attrifyString_w", [((EFfiApp ("Basis", "str1", [e]), _), _)]) => 622 | EFfiApp ("Basis", "attrifyString_w", [((EFfiApp ("Basis", "str1", [e]), _), _)]) =>
620 EFfiApp ("Basis", "attrifyChar_w", [e]) 623 EFfiApp ("Basis", "attrifyChar_w", [e])
621 624
622 | EBinop (_, "+", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.+ (n1, n2))) 625 | EBinop (_, "+", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.+ (n1, n2)))
623 626
624 | _ => e 627 | _ => e
625 628
626 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e) 629 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
627 630
628 val optimize = U.File.map {typ = typ, exp = exp, decl = decl} 631 val optimize = U.File.map {typ = typ, exp = exp, decl = decl}