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