annotate src/mono_opt.sml @ 105:da760c34f5ed

Stringifying attributes
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 15:19:06 -0400
parents 82aaa1c406d3
children d101cb1efe55
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@96 36 fun exp e =
adamc@96 37 case e of
adamc@96 38 EPrim (Prim.String s) =>
adamc@96 39 let
adamc@96 40 val (_, chs) =
adamc@96 41 CharVector.foldl (fn (ch, (lastSpace, chs)) =>
adamc@96 42 let
adamc@96 43 val isSpace = Char.isSpace ch
adamc@96 44 in
adamc@96 45 if isSpace andalso lastSpace then
adamc@96 46 (true, chs)
adamc@96 47 else
adamc@96 48 (isSpace, ch :: chs)
adamc@96 49 end)
adamc@96 50 (false, []) s
adamc@96 51 in
adamc@96 52 EPrim (Prim.String (String.implode (rev chs)))
adamc@96 53 end
adamc@96 54
adamc@96 55 | EStrcat ((EPrim (Prim.String s1), loc), (EPrim (Prim.String s2), _)) =>
adamc@96 56 let
adamc@96 57 val s =
adamc@96 58 if size s1 > 0 andalso size s2 > 0
adamc@96 59 andalso Char.isSpace (String.sub (s1, size s1 - 1))
adamc@96 60 andalso Char.isSpace (String.sub (s2, 0)) then
adamc@96 61 s1 ^ String.extract (s2, 1, NONE)
adamc@96 62 else
adamc@96 63 s1 ^ s2
adamc@96 64 in
adamc@96 65 EPrim (Prim.String s)
adamc@96 66 end
adamc@105 67
adamc@105 68 | EStrcat ((EPrim (Prim.String s1), loc), (EStrcat ((EPrim (Prim.String s2), _), rest), _)) =>
adamc@105 69 let
adamc@105 70 val s =
adamc@105 71 if size s1 > 0 andalso size s2 > 0
adamc@105 72 andalso Char.isSpace (String.sub (s1, size s1 - 1))
adamc@105 73 andalso Char.isSpace (String.sub (s2, 0)) then
adamc@105 74 s1 ^ String.extract (s2, 1, NONE)
adamc@105 75 else
adamc@105 76 s1 ^ s2
adamc@105 77 in
adamc@105 78 EStrcat ((EPrim (Prim.String s), loc), rest)
adamc@105 79 end
adamc@105 80
adamc@105 81 | EStrcat ((EStrcat (e1, e2), loc), e3) =>
adamc@105 82 optExp (EStrcat (e1, (EStrcat (e2, e3), loc)), loc)
adamc@105 83
adamc@96 84 | _ => e
adamc@96 85
adamc@105 86 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
adamc@105 87
adamc@96 88 val optimize = U.File.map {typ = typ, exp = exp, decl = decl}
adamc@96 89
adamc@96 90 end