Mercurial > urweb

annotate src/prim.sml @ 1591:20f898c29525

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tweaks to choices of source positions to use in error messages, including for subSgn
author Adam Chlipala <adam@chlipala.net>
date Sat, 05 Nov 2011 13:12:07 -0400
parents 4d04cb89649b
children 3e7c7e200713
rev   line source
adamc@14 1 (* Copyright (c) 2008, Adam Chlipala
adamc@14 2 * All rights reserved.
adamc@14 3 *
adamc@14 4 * Redistribution and use in source and binary forms, with or without
adamc@14 5 * modification, are permitted provided that the following conditions are met:
adamc@14 6 *
adamc@14 7 * - Redistributions of source code must retain the above copyright notice,
adamc@14 8 * this list of conditions and the following disclaimer.
adamc@14 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@14 10 * this list of conditions and the following disclaimer in the documentation
adamc@14 11 * and/or other materials provided with the distribution.
adamc@14 12 * - The names of contributors may not be used to endorse or promote products
adamc@14 13 * derived from this software without specific prior written permission.
adamc@14 14 *
adamc@14 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@14 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@14 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@14 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@14 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@14 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@14 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@14 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@14 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@14 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@14 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@14 26 *)
adamc@14 27
adamc@14 28 structure Prim :> PRIM = struct
adamc@14 29
adamc@14 30 datatype t =
adamc@14 31 Int of Int64.int
adamc@14 32 | Float of Real64.real
adamc@14 33 | String of string
adamc@821 34 | Char of char
adamc@14 35
adamc@14 36 open Print.PD
adamc@14 37 open Print
adamc@14 38
adamc@14 39 fun p_t t =
adamc@14 40 case t of
adamc@14 41 Int n => string (Int64.toString n)
adamc@14 42 | Float n => string (Real64.toString n)
adamc@95 43 | String s => box [string "\"", string (String.toString s), string "\""]
adamc@942 44 | Char ch => box [string "#\"", string (String.toString (String.str ch)), string "\""]
adamc@14 45
adamc@276 46 fun int2s n =
adamc@276 47 if Int64.compare (n, Int64.fromInt 0) = LESS then
adamc@276 48 "-" ^ Int64.toString (Int64.~ n) ^ "LL"
adamc@276 49 else
adamc@276 50 Int64.toString n ^ "LL"
adamc@276 51
adamc@582 52 fun int2s' n =
adamc@582 53 if Int64.compare (n, Int64.fromInt 0) = LESS then
adamc@582 54 "-" ^ Int64.toString (Int64.~ n)
adamc@582 55 else
adamc@582 56 Int64.toString n
adamc@582 57
adam@1468 58 val float2s = String.translate (fn #"~" => "-" | ch => str ch) o Real64.toString
adamc@276 59
adamc@567 60 fun toString t =
adamc@567 61 case t of
adamc@582 62 Int n => int2s' n
adamc@567 63 | Float n => float2s n
adamc@567 64 | String s => s
adamc@821 65 | Char ch => str ch
adamc@567 66
adamc@1053 67 fun pad (n, ch, s) =
adamc@1053 68 if size s >= n then
adamc@1053 69 s
adamc@1053 70 else
adamc@1053 71 str ch ^ pad (n-1, ch, s)
adamc@1053 72
adamc@276 73 fun p_t_GCC t =
adamc@276 74 case t of
adamc@276 75 Int n => string (int2s n)
adamc@276 76 | Float n => string (float2s n)
adamc@1257 77 | String s => box [string "\"", string (String.toCString s), string "\""]
adamc@1257 78 | Char ch => box [string "'", string (Char.toCString ch), string "'"]
adamc@276 79
adamc@183 80 fun equal x =
adamc@183 81 case x of
adamc@183 82 (Int n1, Int n2) => n1 = n2
adamc@183 83 | (Float n1, Float n2) => Real64.== (n1, n2)
adamc@183 84 | (String s1, String s2) => s1 = s2
adamc@821 85 | (Char ch1, Char ch2) => ch1 = ch2
adamc@183 86
adamc@183 87 | _ => false
adamc@183 88
adamc@479 89 fun compare (p1, p2) =
adamc@479 90 case (p1, p2) of
adamc@479 91 (Int n1, Int n2) => Int64.compare (n1, n2)
adamc@479 92 | (Int _, _) => LESS
adamc@479 93 | (_, Int _) => GREATER
adamc@479 94
adamc@479 95 | (Float n1, Float n2) => Real64.compare (n1, n2)
adamc@479 96 | (Float _, _) => LESS
adamc@821 97 | (_, Float _) => GREATER
adamc@479 98
adamc@479 99 | (String n1, String n2) => String.compare (n1, n2)
adamc@821 100 | (String _, _) => LESS
adamc@821 101 | (_, String _) => GREATER
adamc@821 102
adamc@821 103 | (Char ch1, Char ch2) => Char.compare (ch1, ch2)
adamc@479 104
adamc@14 105 end