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