basis-library/text/char0.sml

   1 (* Copyright (C) 2017 Matthew Fluet.
   2  * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  * Copyright (C) 1997-2000 NEC Research Institute.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 local
  11    structure PreCharX =
  12       struct
  13          structure Prim8  = Primitive.Char8
  14          structure Prim16 = Primitive.Char16
  15          structure Prim32 = Primitive.Char32
  16
  17          type 'a t = {
  18             chrUnsafe: int -> 'a,
  19             ord:       'a -> int,
  20             minChar:   'a,
  21             maxChar:   'a,
  22             numChars:  int
  23             }
  24
  25          val fChar8 : Prim8.char t = {
  26             chrUnsafe = Prim8.idFromWord8 o Int.sextdToWord8,
  27             ord       = Int.zextdFromWord8 o Prim8.idToWord8,
  28             minChar   = #"\000",
  29             maxChar   = #"\255",
  30             numChars  = 256 (* 0x100 *)
  31          }
  32          val fChar16 : Prim16.char t = {
  33             chrUnsafe = Prim16.idFromWord16 o Int.sextdToWord16,
  34             ord       = Int.zextdFromWord16 o Prim16.idToWord16,
  35             minChar   = #"\000",
  36             maxChar   = #"\uFFFF",
  37             numChars  = 65536 (* 0x10000 *)
  38             }
  39          val fChar32 : Prim32.char t = {
  40             chrUnsafe = Prim32.idFromWord32 o Int.sextdToWord32,
  41             ord       = Int.zextdFromWord32 o Prim32.idToWord32,
  42             minChar   = #"\000",
  43             maxChar   = Prim32.idFromWord32 0wx0010FFFF,
  44             numChars  = 1114112 (* 0x110000 *)
  45          }
  46       end
  47 in
  48    structure Char : PRE_CHAR =
  49       struct
  50          (* set by config/default/default-charX.sml *)
  51          open Char
  52          type string = String.string
  53
  54          local
  55             structure PCX = Char_ChooseChar(PreCharX)
  56          in
  57             val { chrUnsafe, ord, minChar, maxChar, numChars } = PCX.f
  58          end
  59
  60          fun fromChar x = x
  61       end
  62
  63    structure WideChar : PRE_CHAR =
  64       struct
  65          (* set by config/default/default-widecharX.sml *)
  66          open WideChar
  67          type string = WideString.string
  68
  69          local
  70             structure PCX = WideChar_ChooseChar(PreCharX)
  71          in
  72             val { chrUnsafe, ord, minChar, maxChar, numChars } = PCX.f
  73          end
  74
  75          (* safe b/c WideChar >= Char *)
  76          val fromChar = chrUnsafe o Char.ord
  77       end
  78 end