lib/stubs/basis-stubs-for-smlnj/ieee-real.sml

   1 (* Copyright (C) 2009 Matthew Fluet.
   2  * Copyright (C) 2005 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 (* SML/NJ uses an old version of datatype IEEEReal.float_class. *)
  10 signature IEEE_REAL =
  11    sig
  12       exception Unordered
  13       datatype real_order = EQUAL | GREATER | LESS | UNORDERED
  14       datatype float_class = INF | NAN | NORMAL | SUBNORMAL | ZERO
  15       datatype rounding_mode = TO_NEAREST | TO_NEGINF | TO_POSINF | TO_ZERO
  16       val setRoundingMode : rounding_mode -> unit
  17       val getRoundingMode : unit -> rounding_mode
  18       type decimal_approx = {digits:int list, exp:int, kind:float_class, sign:bool}
  19       val toString : decimal_approx -> string
  20       val fromString : string -> decimal_approx option
  21       val scan : (char,'a) StringCvt.reader -> (decimal_approx,'a) StringCvt.reader
  22    end
  23
  24 structure IEEEReal : IEEE_REAL =
  25    struct
  26       open IEEEReal
  27
  28       datatype float_class = NAN | INF | ZERO | NORMAL | SUBNORMAL
  29       type decimal_approx = {digits:int list, exp:int, kind:float_class, sign:bool}
  30
  31       local
  32          structure P = Pervasive.IEEEReal
  33          fun toGoodFC c =
  34             case c of
  35                P.NAN _ => NAN
  36              | P.INF => INF
  37              | P.ZERO => ZERO
  38              | P.NORMAL => NORMAL
  39              | P.SUBNORMAL => SUBNORMAL
  40          fun toBadFC c =
  41             case c of
  42                NAN => P.NAN P.QUIET
  43              | INF => P.INF
  44              | ZERO => P.ZERO
  45              | NORMAL => P.NORMAL
  46              | SUBNORMAL => P.SUBNORMAL
  47          fun toGoodDA {digits, exp, kind, sign} =
  48             {digits = digits, exp = exp, kind = toGoodFC kind, sign = sign}
  49          fun toBadDA {digits, exp, kind, sign} =
  50             {digits = digits, exp = exp, kind = toBadFC kind, sign = sign}
  51       in
  52          val toString = P.toString o toBadDA
  53          val fromString = (Option.map toGoodDA) o P.fromString
  54          fun scan r s =
  55             Option.map (fn (da,x) => (toGoodDA da,x)) (P.scan r s)
  56       end
  57
  58    end