1structure base_tokens :> base_tokens =
2struct
3
4open base_tokens_dtype
5exception LEX_ERR of string * locn.locn
6
7val allow_octal_input = ref false
8val preferred_output_base = ref StringCvt.DEC
9
10
11fun toString (BT_Ident s) = s
12  | toString (BT_Numeral(s, copt)) = Arbnum.toString s ^
13                                     (case copt of SOME c => String.str c
14                                                 | NONE => "")
15  | toString (BT_DecimalFraction{wholepart,fracpart,places}) =
16      Arbnum.toString wholepart ^ "." ^
17      StringCvt.padLeft #"0" places (Arbnum.toString fracpart)
18  | toString (BT_StrLit{ldelim,contents}) =
19      "BTStrL(" ^ ldelim ^ ",\"" ^ String.toString contents ^ "\")"
20  | toString (BT_AQ x) = "<AntiQuote>"
21  | toString BT_EOI = "<End of Input>"
22
23fun check p exnstring (s,loc) = let
24  open Substring
25  fun check ss =
26      case getc ss of
27        NONE => s
28      | SOME (c,ss) => if p c then check ss
29                       else raise LEX_ERR (exnstring ^ ": " ^ s, loc)
30in
31  check (full s)
32end
33
34val check_binary = check (fn c => c = #"0" orelse c = #"1")
35                         "Illegal binary literal"
36val check_octal = check (fn c => #"0" <= c andalso c <= #"7")
37                        "Illegal octal literal"
38val check_hex = check (fn c => (#"0" <= c andalso c <= #"9") orelse
39                               (let val c' = Char.toLower c
40                                in
41                                  #"a" <= c' andalso c' <= #"f"
42                                end))
43                      "Illegal hex literal"
44val check_decimal = check Char.isDigit "Illegal numeral"
45
46fun strip_underscores s =
47    String.translate (fn #"_" => "" | c => str c) s
48
49fun parse_numeric_literal (s,locn) = let
50  val c = String.sub (s, size s - 1)
51  val clower = Char.toLower c
52  val chexp = #"a" <= clower andalso clower <= #"f"
53  val (s,copt) =
54      if Char.isAlpha c andalso not (String.isPrefix "0x" s andalso chexp)
55      then (String.substring(s,0,size s - 1), SOME c)
56      else (s, NONE)
57in
58  if String.sub(s, 0) <> #"0" orelse size s = 1 then
59    (Arbnum.fromString (check_decimal (strip_underscores s, locn)), copt)
60  else let
61      val c = String.sub(s, 1)
62    in
63      case c of
64        #"x" => (Arbnum.fromHexString
65                     (check_hex (strip_underscores (String.extract(s,2,NONE)),
66                                 locn)),
67                 copt)
68      | #"b" => (Arbnum.fromBinString
69                     (check_binary
70                          (strip_underscores (String.extract(s,2,NONE)), locn)),
71                 copt)
72      | _ => if !allow_octal_input then
73               (Arbnum.fromOctString (check_octal (strip_underscores s, locn)),
74                copt)
75             else
76               (Arbnum.fromString (check_decimal (strip_underscores s, locn)),
77                copt)
78    end
79end
80
81fun parse_fraction (s, loc) =
82    case String.fields (Lib.equal #".") s of
83      [] => raise Fail ("parse_fraction: impossible: "^s)
84    | [_] => raise LEX_ERR ("Decimal fraction with no fractional part: " ^s,
85                            loc)
86    | [npart, fpart] => let
87        val fpart = strip_underscores fpart
88      in
89        {wholepart = Arbnum.fromString (strip_underscores npart),
90         fracpart = Arbnum.fromString fpart,
91         places = String.size fpart}
92      end
93    | _ => raise LEX_ERR ("Decimal fraction with too many decimal points: "^s,
94                          loc)
95
96
97end; (* struct *)
98