mlton/ast/ast-const.fun

   1 (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  * Copyright (C) 1997-2000 NEC Research Institute.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 functor AstConst (S: AST_CONST_STRUCTS): AST_CONST =
  10 struct
  11
  12 open S Region.Wrap
  13
  14 datatype node =
  15    Bool of bool
  16  | Char of IntInf.t
  17  | Int of IntInf.t
  18  | Real of string
  19  | String of IntInf.t vector
  20  | Word of IntInf.t
  21 type t = node Region.Wrap.t
  22 type node' = node
  23 type obj = t
  24
  25 fun ordToString (c: IntInf.t): string =
  26       let
  27          fun loop (n: int, c: IntInf.t, ac: char list) =
  28             if n = 0
  29                then implode ac
  30             else
  31                let
  32                   val (q, r) = IntInf.quotRem (c, 0x10)
  33                in
  34                   loop (n - 1, q, Char.fromHexDigit (Int.fromIntInf r) :: ac)
  35                end
  36          fun doit (n, esc) = concat ["\\", esc, loop (n, c, [])]
  37       in
  38          if c <= 0xFF
  39             then Char.escapeSML (Char.fromInt (Int.fromIntInf c))
  40          else if c <= 0xFFFF
  41             then doit (4, "u")
  42          else doit (8, "U")
  43       end
  44
  45 local
  46    open Layout
  47 in
  48    fun layout c =
  49       case node c of
  50          Bool b => if b then str "true" else str "false"
  51        | Char c => str (concat ["#\"", ordToString c, "\""])
  52        | Int s => str (IntInf.toString s)
  53        | Real l => String.layout l
  54        | String s =>
  55             str (concat ["\"", concat (Vector.toListMap (s, ordToString)), "\""])
  56        | Word w => str (concat ["0wx", IntInf.format (w, StringCvt.HEX)])
  57 end
  58
  59 end