Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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 |