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