Mercurial > urweb

annotate src/mono_opt.sml @ 109:813e5a52063d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove closure conversion in favor of zany fun with modules, which also replaces 'page'
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Jul 2008 10:17:06 -0400
parents bed5cf0b6b75
children 6230bdd122e7
rev   line source
adamc@96 1 (* Copyright (c) 2008, Adam Chlipala
adamc@96 2 * All rights reserved.
adamc@96 3 *
adamc@96 4 * Redistribution and use in source and binary forms, with or without
adamc@96 5 * modification, are permitted provided that the following conditions are met:
adamc@96 6 *
adamc@96 7 * - Redistributions of source code must retain the above copyright notice,
adamc@96 8 * this list of conditions and the following disclaimer.
adamc@96 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@96 10 * this list of conditions and the following disclaimer in the documentation
adamc@96 11 * and/or other materials provided with the distribution.
adamc@96 12 * - The names of contributors may not be used to endorse or promote products
adamc@96 13 * derived from this software without specific prior written permission.
adamc@96 14 *
adamc@96 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@96 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@96 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@96 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@96 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@96 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@96 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@96 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@96 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@96 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@96 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@96 26 *)
adamc@96 27
adamc@96 28 structure MonoOpt :> MONO_OPT = struct
adamc@96 29
adamc@96 30 open Mono
adamc@96 31 structure U = MonoUtil
adamc@96 32
adamc@96 33 fun typ t = t
adamc@96 34 fun decl d = d
adamc@96 35
adamc@107 36 fun attrifyInt n =
adamc@107 37 if n < 0 then
adamc@107 38 "-" ^ Int64.toString (Int64.~ n)
adamc@107 39 else
adamc@107 40 Int64.toString n
adamc@107 41
adamc@107 42 fun attrifyFloat n =
adamc@107 43 if n < 0.0 then
adamc@107 44 "-" ^ Real.toString (Real.~ n)
adamc@107 45 else
adamc@107 46 Real.toString n
adamc@107 47
adamc@107 48 val attrifyString = String.translate (fn #"\"" => "&quot;"
adamc@107 49 | ch => if Char.isPrint ch then
adamc@107 50 str ch
adamc@107 51 else
adamc@107 52 "&#" ^ Int.toString (ord ch) ^ ";")
adamc@107 53
adamc@96 54 fun exp e =
adamc@96 55 case e of
adamc@96 56 EPrim (Prim.String s) =>
adamc@96 57 let
adamc@96 58 val (_, chs) =
adamc@96 59 CharVector.foldl (fn (ch, (lastSpace, chs)) =>
adamc@96 60 let
adamc@96 61 val isSpace = Char.isSpace ch
adamc@96 62 in
adamc@96 63 if isSpace andalso lastSpace then
adamc@96 64 (true, chs)
adamc@96 65 else
adamc@96 66 (isSpace, ch :: chs)
adamc@96 67 end)
adamc@96 68 (false, []) s
adamc@96 69 in
adamc@96 70 EPrim (Prim.String (String.implode (rev chs)))
adamc@96 71 end
adamc@96 72
adamc@96 73 | EStrcat ((EPrim (Prim.String s1), loc), (EPrim (Prim.String s2), _)) =>
adamc@96 74 let
adamc@96 75 val s =
adamc@96 76 if size s1 > 0 andalso size s2 > 0
adamc@96 77 andalso Char.isSpace (String.sub (s1, size s1 - 1))
adamc@96 78 andalso Char.isSpace (String.sub (s2, 0)) then
adamc@96 79 s1 ^ String.extract (s2, 1, NONE)
adamc@96 80 else
adamc@96 81 s1 ^ s2
adamc@96 82 in
adamc@96 83 EPrim (Prim.String s)
adamc@96 84 end
adamc@105 85
adamc@105 86 | EStrcat ((EPrim (Prim.String s1), loc), (EStrcat ((EPrim (Prim.String s2), _), rest), _)) =>
adamc@105 87 let
adamc@105 88 val s =
adamc@105 89 if size s1 > 0 andalso size s2 > 0
adamc@105 90 andalso Char.isSpace (String.sub (s1, size s1 - 1))
adamc@105 91 andalso Char.isSpace (String.sub (s2, 0)) then
adamc@105 92 s1 ^ String.extract (s2, 1, NONE)
adamc@105 93 else
adamc@105 94 s1 ^ s2
adamc@105 95 in
adamc@105 96 EStrcat ((EPrim (Prim.String s), loc), rest)
adamc@105 97 end
adamc@105 98
adamc@105 99 | EStrcat ((EStrcat (e1, e2), loc), e3) =>
adamc@105 100 optExp (EStrcat (e1, (EStrcat (e2, e3), loc)), loc)
adamc@105 101
adamc@106 102 | EWrite (EStrcat (e1, e2), loc) =>
adamc@106 103 ESeq ((optExp (EWrite e1, loc), loc),
adamc@106 104 (optExp (EWrite e2, loc), loc))
adamc@106 105
adamc@107 106 | EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]) =>
adamc@107 107 EPrim (Prim.String (attrifyInt n))
adamc@107 108 | EWrite (EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]), loc) =>
adamc@107 109 EWrite (EPrim (Prim.String (attrifyInt n)), loc)
adamc@106 110 | EWrite (EFfiApp ("Basis", "attrifyInt", [e]), _) =>
adamc@106 111 EFfiApp ("Basis", "attrifyInt_w", [e])
adamc@107 112
adamc@107 113 | EFfiApp ("Basis", "attrifyFloat", [(EPrim (Prim.Float n), _)]) =>
adamc@107 114 EPrim (Prim.String (attrifyFloat n))
adamc@107 115 | EWrite (EFfiApp ("Basis", "attrifyFloat", [(EPrim (Prim.Float n), _)]), loc) =>
adamc@107 116 EWrite (EPrim (Prim.String (attrifyFloat n)), loc)
adamc@106 117 | EWrite (EFfiApp ("Basis", "attrifyFloat", [e]), _) =>
adamc@106 118 EFfiApp ("Basis", "attrifyFloat_w", [e])
adamc@107 119
adamc@107 120 | EFfiApp ("Basis", "attrifyString", [(EPrim (Prim.String s), _)]) =>
adamc@107 121 EPrim (Prim.String (attrifyString s))
adamc@107 122 | EWrite (EFfiApp ("Basis", "attrifyString", [(EPrim (Prim.String s), _)]), loc) =>
adamc@107 123 EWrite (EPrim (Prim.String (attrifyString s)), loc)
adamc@106 124 | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) =>
adamc@106 125 EFfiApp ("Basis", "attrifyString_w", [e])
adamc@106 126
adamc@96 127 | _ => e
adamc@96 128
adamc@105 129 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
adamc@105 130
adamc@96 131 val optimize = U.File.map {typ = typ, exp = exp, decl = decl}
adamc@96 132
adamc@96 133 end