807 lines
22 KiB
Standard ML
807 lines
22 KiB
Standard ML
(*------------------------------------------------------------------*)
|
|
(* The Rosetta Code lexical analyzer, in Standard ML. Based on the ATS
|
|
and the OCaml. The intended compiler is Mlton or Poly/ML; there is
|
|
a tiny difference near the end of the file, depending on which
|
|
compiler is used. *)
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* The following functions are compatible with ASCII. *)
|
|
|
|
fun
|
|
is_digit ichar =
|
|
48 <= ichar andalso ichar <= 57
|
|
|
|
fun
|
|
is_lower ichar =
|
|
97 <= ichar andalso ichar <= 122
|
|
|
|
fun
|
|
is_upper ichar =
|
|
65 <= ichar andalso ichar <= 90
|
|
|
|
fun
|
|
is_alpha ichar =
|
|
is_lower ichar orelse is_upper ichar
|
|
|
|
fun
|
|
is_alnum ichar =
|
|
is_digit ichar orelse is_alpha ichar
|
|
|
|
fun
|
|
is_ident_start ichar =
|
|
is_alpha ichar orelse ichar = 95
|
|
|
|
fun
|
|
is_ident_continuation ichar =
|
|
is_alnum ichar orelse ichar = 95
|
|
|
|
fun
|
|
is_space ichar =
|
|
ichar = 32 orelse (9 <= ichar andalso ichar <= 13)
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* Character input more like that of C. There are various advantages
|
|
and disadvantages to this method, but key points in its favor are:
|
|
(a) it is how character input is done in the original ATS code, (b)
|
|
Unicode code points are 21-bit positive integers. *)
|
|
|
|
val eof = ~1
|
|
|
|
fun
|
|
input_ichar inpf =
|
|
case TextIO.input1 inpf of
|
|
NONE => eof
|
|
| SOME c => Char.ord c
|
|
|
|
(*------------------------------------------------------------------*)
|
|
|
|
(* The type of an input character. *)
|
|
|
|
structure Ch =
|
|
struct
|
|
|
|
type t = {
|
|
ichar : int,
|
|
line_no : int,
|
|
column_no : int
|
|
}
|
|
|
|
end
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* Inputting with unlimited pushback, and with counting of lines and
|
|
columns. *)
|
|
|
|
structure Inp =
|
|
struct
|
|
|
|
type t = {
|
|
inpf : TextIO.instream,
|
|
pushback : Ch.t list,
|
|
line_no : int,
|
|
column_no : int
|
|
}
|
|
|
|
fun
|
|
of_instream inpf =
|
|
{
|
|
inpf = inpf,
|
|
pushback = [],
|
|
line_no = 1,
|
|
column_no = 1
|
|
} : t
|
|
|
|
fun
|
|
get_ch ({ inpf = inpf,
|
|
pushback = pushback,
|
|
line_no = line_no,
|
|
column_no = column_no } : t) =
|
|
case pushback of
|
|
ch :: tail =>
|
|
let
|
|
val inp = { inpf = inpf,
|
|
pushback = tail,
|
|
line_no = line_no,
|
|
column_no = column_no }
|
|
in
|
|
(ch, inp)
|
|
end
|
|
| [] =>
|
|
let
|
|
val ichar = input_ichar inpf
|
|
val ch = { ichar = ichar,
|
|
line_no = line_no,
|
|
column_no = column_no }
|
|
in
|
|
if ichar = Char.ord #"\n" then
|
|
let
|
|
val inp = { inpf = inpf,
|
|
pushback = [],
|
|
line_no = line_no + 1,
|
|
column_no = 1 }
|
|
in
|
|
(ch, inp)
|
|
end
|
|
else
|
|
let
|
|
val inp = { inpf = inpf,
|
|
pushback = [],
|
|
line_no = line_no,
|
|
column_no = column_no + 1 }
|
|
in
|
|
(ch, inp)
|
|
end
|
|
end
|
|
|
|
fun
|
|
push_back_ch (ch, inp : t) =
|
|
{
|
|
inpf = #inpf inp,
|
|
pushback = ch :: #pushback inp,
|
|
line_no = #line_no inp,
|
|
column_no = #column_no inp
|
|
}
|
|
|
|
end
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* Tokens, appearing in tuples with arguments, and with line and
|
|
column numbers. The tokens are integers, so they can be used as
|
|
array indices. *)
|
|
|
|
val token_ELSE = 0
|
|
val token_IF = 1
|
|
val token_PRINT = 2
|
|
val token_PUTC = 3
|
|
val token_WHILE = 4
|
|
val token_MULTIPLY = 5
|
|
val token_DIVIDE = 6
|
|
val token_MOD = 7
|
|
val token_ADD = 8
|
|
val token_SUBTRACT = 9
|
|
val token_NEGATE = 10
|
|
val token_LESS = 11
|
|
val token_LESSEQUAL = 12
|
|
val token_GREATER = 13
|
|
val token_GREATEREQUAL = 14
|
|
val token_EQUAL = 15
|
|
val token_NOTEQUAL = 16
|
|
val token_NOT = 17
|
|
val token_ASSIGN = 18
|
|
val token_AND = 19
|
|
val token_OR = 20
|
|
val token_LEFTPAREN = 21
|
|
val token_RIGHTPAREN = 22
|
|
val token_LEFTBRACE = 23
|
|
val token_RIGHTBRACE = 24
|
|
val token_SEMICOLON = 25
|
|
val token_COMMA = 26
|
|
val token_IDENTIFIER = 27
|
|
val token_INTEGER = 28
|
|
val token_STRING = 29
|
|
val token_END_OF_INPUT = 30
|
|
|
|
(* A *very* simple perfect hash for the reserved words. (Yes, this is
|
|
overkill, except for demonstration of the principle.) *)
|
|
|
|
val reserved_words =
|
|
Vector.fromList ["if", "print", "else",
|
|
"", "putc", "",
|
|
"", "while", ""]
|
|
val reserved_word_tokens =
|
|
Vector.fromList [token_IF, token_PRINT, token_ELSE,
|
|
token_IDENTIFIER, token_PUTC, token_IDENTIFIER,
|
|
token_IDENTIFIER, token_WHILE, token_IDENTIFIER]
|
|
|
|
fun
|
|
reserved_word_lookup (s, line_no, column_no) =
|
|
if (String.size s) < 2 then
|
|
(token_IDENTIFIER, s, line_no, column_no)
|
|
else
|
|
let
|
|
val hashval =
|
|
(Char.ord (String.sub (s, 0)) +
|
|
Char.ord (String.sub (s, 1)))
|
|
mod 9
|
|
val token = Vector.sub (reserved_word_tokens, hashval)
|
|
in
|
|
if token = token_IDENTIFIER orelse
|
|
s <> Vector.sub (reserved_words, hashval) then
|
|
(token_IDENTIFIER, s, line_no, column_no)
|
|
else
|
|
(token, s, line_no, column_no)
|
|
end
|
|
|
|
(* Token to string lookup. *)
|
|
|
|
val token_names =
|
|
Vector.fromList
|
|
["Keyword_else",
|
|
"Keyword_if",
|
|
"Keyword_print",
|
|
"Keyword_putc",
|
|
"Keyword_while",
|
|
"Op_multiply",
|
|
"Op_divide",
|
|
"Op_mod",
|
|
"Op_add",
|
|
"Op_subtract",
|
|
"Op_negate",
|
|
"Op_less",
|
|
"Op_lessequal",
|
|
"Op_greater",
|
|
"Op_greaterequal",
|
|
"Op_equal",
|
|
"Op_notequal",
|
|
"Op_not",
|
|
"Op_assign",
|
|
"Op_and",
|
|
"Op_or",
|
|
"LeftParen",
|
|
"RightParen",
|
|
"LeftBrace",
|
|
"RightBrace",
|
|
"Semicolon",
|
|
"Comma",
|
|
"Identifier",
|
|
"Integer",
|
|
"String",
|
|
"End_of_input"]
|
|
|
|
fun
|
|
token_name token =
|
|
Vector.sub (token_names, token)
|
|
|
|
(*------------------------------------------------------------------*)
|
|
|
|
exception Unterminated_comment of int * int
|
|
exception Unterminated_character_literal of int * int
|
|
exception Multicharacter_literal of int * int
|
|
exception End_of_input_in_string_literal of int * int
|
|
exception End_of_line_in_string_literal of int * int
|
|
exception Unsupported_escape of int * int * char
|
|
exception Invalid_integer_literal of int * int * string
|
|
exception Unexpected_character of int * int * char
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* Skipping past spaces and comments. (In the Rosetta Code tiny
|
|
language, a comment, if you think about it, is a kind of space.) *)
|
|
|
|
fun
|
|
scan_comment (inp, line_no, column_no) =
|
|
let
|
|
fun
|
|
loop inp =
|
|
let
|
|
val (ch, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch = eof then
|
|
raise Unterminated_comment (line_no, column_no)
|
|
else if #ichar ch = Char.ord #"*" then
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = eof then
|
|
raise Unterminated_comment (line_no, column_no)
|
|
else if #ichar ch1 = Char.ord #"/" then
|
|
inp
|
|
else
|
|
loop inp
|
|
end
|
|
else
|
|
loop inp
|
|
end
|
|
in
|
|
loop inp
|
|
end
|
|
|
|
fun
|
|
skip_spaces_and_comments inp =
|
|
let
|
|
fun
|
|
loop inp =
|
|
let
|
|
val (ch, inp) = Inp.get_ch inp
|
|
in
|
|
if is_space (#ichar ch) then
|
|
loop inp
|
|
else if #ichar ch = Char.ord #"/" then
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = Char.ord #"*" then
|
|
loop (scan_comment (inp, #line_no ch, #column_no ch))
|
|
else
|
|
let
|
|
val inp = Inp.push_back_ch (ch1, inp)
|
|
val inp = Inp.push_back_ch (ch, inp)
|
|
in
|
|
inp
|
|
end
|
|
end
|
|
else
|
|
Inp.push_back_ch (ch, inp)
|
|
end
|
|
in
|
|
loop inp
|
|
end
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* Integer literals, identifiers, and reserved words. *)
|
|
|
|
fun
|
|
scan_word (lst, inp) =
|
|
let
|
|
val (ch, inp) = Inp.get_ch inp
|
|
in
|
|
if is_ident_continuation (#ichar ch) then
|
|
scan_word (Char.chr (#ichar ch) :: lst, inp)
|
|
else
|
|
(lst, Inp.push_back_ch (ch, inp))
|
|
end
|
|
|
|
fun
|
|
scan_integer_literal inp =
|
|
let
|
|
val (ch, inp) = Inp.get_ch inp
|
|
val (lst, inp) = scan_word ([Char.chr (#ichar ch)], inp)
|
|
val s = String.implode (List.rev lst)
|
|
in
|
|
if List.all (fn c => is_digit (Char.ord c)) lst then
|
|
((token_INTEGER, s, #line_no ch, #column_no ch), inp)
|
|
else
|
|
raise Invalid_integer_literal (#line_no ch, #column_no ch, s)
|
|
end
|
|
|
|
fun
|
|
scan_identifier_or_reserved_word inp =
|
|
let
|
|
val (ch, inp) = Inp.get_ch inp
|
|
val (lst, inp) = scan_word ([Char.chr (#ichar ch)], inp)
|
|
val s = String.implode (List.rev lst)
|
|
val toktup = reserved_word_lookup (s, #line_no ch, #column_no ch)
|
|
in
|
|
(toktup, inp)
|
|
end
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* String literals. *)
|
|
|
|
fun
|
|
scan_string_literal inp =
|
|
let
|
|
val (ch, inp) = Inp.get_ch inp
|
|
|
|
fun
|
|
scan (lst, inp) =
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = eof then
|
|
raise End_of_input_in_string_literal
|
|
(#line_no ch, #column_no ch)
|
|
else if #ichar ch1 = Char.ord #"\n" then
|
|
raise End_of_line_in_string_literal
|
|
(#line_no ch, #column_no ch)
|
|
else if #ichar ch1 = Char.ord #"\"" then
|
|
(lst, inp)
|
|
else if #ichar ch1 <> Char.ord #"\\" then
|
|
scan (Char.chr (#ichar ch1) :: lst, inp)
|
|
else
|
|
let
|
|
val (ch2, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch2 = Char.ord #"n" then
|
|
scan (#"n" :: #"\\" :: lst, inp)
|
|
else if #ichar ch2 = Char.ord #"\\" then
|
|
scan (#"\\" :: #"\\" :: lst, inp)
|
|
else if #ichar ch2 = eof then
|
|
raise End_of_input_in_string_literal
|
|
(#line_no ch, #column_no ch)
|
|
else if #ichar ch2 = Char.ord #"\n" then
|
|
raise End_of_line_in_string_literal
|
|
(#line_no ch, #column_no ch)
|
|
else
|
|
raise Unsupported_escape (#line_no ch1, #column_no ch1,
|
|
Char.chr (#ichar ch2))
|
|
end
|
|
end
|
|
|
|
val lst = #"\"" :: []
|
|
val (lst, inp) = scan (lst, inp)
|
|
val lst = #"\"" :: lst
|
|
val s = String.implode (List.rev lst)
|
|
in
|
|
((token_STRING, s, #line_no ch, #column_no ch), inp)
|
|
end
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* Character literals. *)
|
|
|
|
fun
|
|
scan_character_literal_without_checking_end inp =
|
|
let
|
|
val (ch, inp) = Inp.get_ch inp
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = eof then
|
|
raise Unterminated_character_literal
|
|
(#line_no ch, #column_no ch)
|
|
else if #ichar ch1 = Char.ord #"\\" then
|
|
let
|
|
val (ch2, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch2 = eof then
|
|
raise Unterminated_character_literal
|
|
(#line_no ch, #column_no ch)
|
|
else if #ichar ch2 = Char.ord #"n" then
|
|
let
|
|
val s = Int.toString (Char.ord #"\n")
|
|
in
|
|
((token_INTEGER, s, #line_no ch, #column_no ch), inp)
|
|
end
|
|
else if #ichar ch2 = Char.ord #"\\" then
|
|
let
|
|
val s = Int.toString (Char.ord #"\\")
|
|
in
|
|
((token_INTEGER, s, #line_no ch, #column_no ch), inp)
|
|
end
|
|
else
|
|
raise Unsupported_escape (#line_no ch1, #column_no ch1,
|
|
Char.chr (#ichar ch2))
|
|
end
|
|
else
|
|
let
|
|
val s = Int.toString (#ichar ch1)
|
|
in
|
|
((token_INTEGER, s, #line_no ch, #column_no ch), inp)
|
|
end
|
|
end
|
|
|
|
fun
|
|
scan_character_literal inp =
|
|
let
|
|
val (toktup, inp) =
|
|
scan_character_literal_without_checking_end inp
|
|
val (_, _, line_no, column_no) = toktup
|
|
|
|
fun
|
|
check_end inp =
|
|
let
|
|
val (ch, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch = Char.ord #"'" then
|
|
inp
|
|
else
|
|
let
|
|
fun
|
|
loop_to_end (ch1 : Ch.t, inp) =
|
|
if #ichar ch1 = eof then
|
|
raise Unterminated_character_literal (line_no, column_no)
|
|
else if #ichar ch1 = Char.ord #"'" then
|
|
raise Multicharacter_literal (line_no, column_no)
|
|
else
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
loop_to_end (ch1, inp)
|
|
end
|
|
in
|
|
loop_to_end (ch, inp)
|
|
end
|
|
end
|
|
|
|
val inp = check_end inp
|
|
in
|
|
(toktup, inp)
|
|
end
|
|
|
|
(*------------------------------------------------------------------*)
|
|
|
|
fun
|
|
get_next_token inp =
|
|
let
|
|
val inp = skip_spaces_and_comments inp
|
|
val (ch, inp) = Inp.get_ch inp
|
|
val ln = #line_no ch
|
|
val cn = #column_no ch
|
|
in
|
|
if #ichar ch = eof then
|
|
((token_END_OF_INPUT, "", ln, cn), inp)
|
|
else
|
|
case Char.chr (#ichar ch) of
|
|
#"," => ((token_COMMA, ",", ln, cn), inp)
|
|
| #";" => ((token_SEMICOLON, ";", ln, cn), inp)
|
|
| #"(" => ((token_LEFTPAREN, "(", ln, cn), inp)
|
|
| #")" => ((token_RIGHTPAREN, ")", ln, cn), inp)
|
|
| #"{" => ((token_LEFTBRACE, "{", ln, cn), inp)
|
|
| #"}" => ((token_RIGHTBRACE, "}", ln, cn), inp)
|
|
| #"*" => ((token_MULTIPLY, "*", ln, cn), inp)
|
|
| #"/" => ((token_DIVIDE, "/", ln, cn), inp)
|
|
| #"%" => ((token_MOD, "%", ln, cn), inp)
|
|
| #"+" => ((token_ADD, "+", ln, cn), inp)
|
|
| #"-" => ((token_SUBTRACT, "-", ln, cn), inp)
|
|
| #"<" =>
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = Char.ord #"=" then
|
|
((token_LESSEQUAL, "<=", ln, cn), inp)
|
|
else
|
|
let
|
|
val inp = Inp.push_back_ch (ch1, inp)
|
|
in
|
|
((token_LESS, "<", ln, cn), inp)
|
|
end
|
|
end
|
|
| #">" =>
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = Char.ord #"=" then
|
|
((token_GREATEREQUAL, ">=", ln, cn), inp)
|
|
else
|
|
let
|
|
val inp = Inp.push_back_ch (ch1, inp)
|
|
in
|
|
((token_GREATER, ">", ln, cn), inp)
|
|
end
|
|
end
|
|
| #"=" =>
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = Char.ord #"=" then
|
|
((token_EQUAL, "==", ln, cn), inp)
|
|
else
|
|
let
|
|
val inp = Inp.push_back_ch (ch1, inp)
|
|
in
|
|
((token_ASSIGN, "=", ln, cn), inp)
|
|
end
|
|
end
|
|
| #"!" =>
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = Char.ord #"=" then
|
|
((token_NOTEQUAL, "!=", ln, cn), inp)
|
|
else
|
|
let
|
|
val inp = Inp.push_back_ch (ch1, inp)
|
|
in
|
|
((token_NOT, "!", ln, cn), inp)
|
|
end
|
|
end
|
|
| #"&" =>
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = Char.ord #"&" then
|
|
((token_AND, "&&", ln, cn), inp)
|
|
else
|
|
raise Unexpected_character (#line_no ch, #column_no ch,
|
|
Char.chr (#ichar ch))
|
|
end
|
|
| #"|" =>
|
|
let
|
|
val (ch1, inp) = Inp.get_ch inp
|
|
in
|
|
if #ichar ch1 = Char.ord #"|" then
|
|
((token_OR, "||", ln, cn), inp)
|
|
else
|
|
raise Unexpected_character (#line_no ch, #column_no ch,
|
|
Char.chr (#ichar ch))
|
|
end
|
|
| #"\"" =>
|
|
let
|
|
val inp = Inp.push_back_ch (ch, inp)
|
|
in
|
|
scan_string_literal inp
|
|
end
|
|
| #"'" =>
|
|
let
|
|
val inp = Inp.push_back_ch (ch, inp)
|
|
in
|
|
scan_character_literal inp
|
|
end
|
|
| _ =>
|
|
if is_digit (#ichar ch) then
|
|
let
|
|
val inp = Inp.push_back_ch (ch, inp)
|
|
in
|
|
scan_integer_literal inp
|
|
end
|
|
else if is_ident_start (#ichar ch) then
|
|
let
|
|
val inp = Inp.push_back_ch (ch, inp)
|
|
in
|
|
scan_identifier_or_reserved_word inp
|
|
end
|
|
else
|
|
raise Unexpected_character (#line_no ch, #column_no ch,
|
|
Char.chr (#ichar ch))
|
|
end
|
|
|
|
fun
|
|
output_integer_rightjust (outf, num) =
|
|
(if num < 10 then
|
|
TextIO.output (outf, " ")
|
|
else if num < 100 then
|
|
TextIO.output (outf, " ")
|
|
else if num < 1000 then
|
|
TextIO.output (outf, " ")
|
|
else if num < 10000 then
|
|
TextIO.output (outf, " ")
|
|
else
|
|
();
|
|
TextIO.output (outf, Int.toString num))
|
|
|
|
fun
|
|
print_token (outf, toktup) =
|
|
let
|
|
val (token, arg, line_no, column_no) = toktup
|
|
val name = token_name token
|
|
val (padding, str) =
|
|
if token = token_IDENTIFIER then
|
|
(" ", arg)
|
|
else if token = token_INTEGER then
|
|
(" ", arg)
|
|
else if token = token_STRING then
|
|
(" ", arg)
|
|
else("", "")
|
|
in
|
|
output_integer_rightjust (outf, line_no);
|
|
TextIO.output (outf, " ");
|
|
output_integer_rightjust (outf, column_no);
|
|
TextIO.output (outf, " ");
|
|
TextIO.output (outf, name);
|
|
TextIO.output (outf, padding);
|
|
TextIO.output (outf, str);
|
|
TextIO.output (outf, "\n")
|
|
end
|
|
|
|
fun
|
|
scan_text (outf, inp) =
|
|
let
|
|
fun
|
|
loop inp =
|
|
let
|
|
val (toktup, inp) = get_next_token inp
|
|
in
|
|
(print_token (outf, toktup);
|
|
let
|
|
val (token, _, _, _) = toktup
|
|
in
|
|
if token <> token_END_OF_INPUT then
|
|
loop inp
|
|
else
|
|
()
|
|
end)
|
|
end
|
|
in
|
|
loop inp
|
|
end
|
|
|
|
(*------------------------------------------------------------------*)
|
|
|
|
fun
|
|
main () =
|
|
let
|
|
val args = CommandLine.arguments ()
|
|
val (inpf_filename, outf_filename) =
|
|
case args of
|
|
[] => ("-", "-")
|
|
| name :: [] => (name, "-")
|
|
| name1 :: name2 :: _ => (name1, name2)
|
|
val inpf =
|
|
if inpf_filename = "-" then
|
|
TextIO.stdIn
|
|
else
|
|
TextIO.openIn inpf_filename
|
|
handle
|
|
(IO.Io _) =>
|
|
(TextIO.output (TextIO.stdErr, "Failure opening \"");
|
|
TextIO.output (TextIO.stdErr, inpf_filename);
|
|
TextIO.output (TextIO.stdErr, "\" for input\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
val outf =
|
|
if outf_filename = "-" then
|
|
TextIO.stdOut
|
|
else
|
|
TextIO.openOut outf_filename
|
|
handle
|
|
(IO.Io _) =>
|
|
(TextIO.output (TextIO.stdErr, "Failure opening \"");
|
|
TextIO.output (TextIO.stdErr, outf_filename);
|
|
TextIO.output (TextIO.stdErr, "\" for output\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
val inp = Inp.of_instream inpf
|
|
in
|
|
scan_text (outf, inp)
|
|
end
|
|
handle Unterminated_comment (line_no, column_no) =>
|
|
(TextIO.output (TextIO.stdErr, ": unterminated comment ");
|
|
TextIO.output (TextIO.stdErr, "starting at ");
|
|
TextIO.output (TextIO.stdErr, Int.toString line_no);
|
|
TextIO.output (TextIO.stdErr, ":");
|
|
TextIO.output (TextIO.stdErr, Int.toString column_no);
|
|
TextIO.output (TextIO.stdErr, "\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
| Unterminated_character_literal (line_no, column_no) =>
|
|
(TextIO.output (TextIO.stdErr, ": unterminated character ");
|
|
TextIO.output (TextIO.stdErr, "literal starting at ");
|
|
TextIO.output (TextIO.stdErr, Int.toString line_no);
|
|
TextIO.output (TextIO.stdErr, ":");
|
|
TextIO.output (TextIO.stdErr, Int.toString column_no);
|
|
TextIO.output (TextIO.stdErr, "\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
| Multicharacter_literal (line_no, column_no) =>
|
|
(TextIO.output (TextIO.stdErr, ": unsupported multicharacter");
|
|
TextIO.output (TextIO.stdErr, " literal starting at ");
|
|
TextIO.output (TextIO.stdErr, Int.toString line_no);
|
|
TextIO.output (TextIO.stdErr, ":");
|
|
TextIO.output (TextIO.stdErr, Int.toString column_no);
|
|
TextIO.output (TextIO.stdErr, "\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
| End_of_input_in_string_literal (line_no, column_no) =>
|
|
(TextIO.output (TextIO.stdErr, ": end of input in string");
|
|
TextIO.output (TextIO.stdErr, " literal starting at ");
|
|
TextIO.output (TextIO.stdErr, Int.toString line_no);
|
|
TextIO.output (TextIO.stdErr, ":");
|
|
TextIO.output (TextIO.stdErr, Int.toString column_no);
|
|
TextIO.output (TextIO.stdErr, "\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
| End_of_line_in_string_literal (line_no, column_no) =>
|
|
(TextIO.output (TextIO.stdErr, ": end of line in string");
|
|
TextIO.output (TextIO.stdErr, " literal starting at ");
|
|
TextIO.output (TextIO.stdErr, Int.toString line_no);
|
|
TextIO.output (TextIO.stdErr, ":");
|
|
TextIO.output (TextIO.stdErr, Int.toString column_no);
|
|
TextIO.output (TextIO.stdErr, "\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
| Unsupported_escape (line_no, column_no, c) =>
|
|
(TextIO.output (TextIO.stdErr, CommandLine.name ());
|
|
TextIO.output (TextIO.stdErr, ": unsupported escape \\");
|
|
TextIO.output (TextIO.stdErr, Char.toString c);
|
|
TextIO.output (TextIO.stdErr, " at ");
|
|
TextIO.output (TextIO.stdErr, Int.toString line_no);
|
|
TextIO.output (TextIO.stdErr, ":");
|
|
TextIO.output (TextIO.stdErr, Int.toString column_no);
|
|
TextIO.output (TextIO.stdErr, "\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
| Invalid_integer_literal (line_no, column_no, str) =>
|
|
(TextIO.output (TextIO.stdErr, CommandLine.name ());
|
|
TextIO.output (TextIO.stdErr, ": invalid integer literal ");
|
|
TextIO.output (TextIO.stdErr, str);
|
|
TextIO.output (TextIO.stdErr, " at ");
|
|
TextIO.output (TextIO.stdErr, Int.toString line_no);
|
|
TextIO.output (TextIO.stdErr, ":");
|
|
TextIO.output (TextIO.stdErr, Int.toString column_no);
|
|
TextIO.output (TextIO.stdErr, "\n");
|
|
OS.Process.exit OS.Process.failure)
|
|
| Unexpected_character (line_no, column_no, c) =>
|
|
(TextIO.output (TextIO.stdErr, CommandLine.name ());
|
|
TextIO.output (TextIO.stdErr, ": unexpected character '");
|
|
TextIO.output (TextIO.stdErr, Char.toString c);
|
|
TextIO.output (TextIO.stdErr, "' at ");
|
|
TextIO.output (TextIO.stdErr, Int.toString line_no);
|
|
TextIO.output (TextIO.stdErr, ":");
|
|
TextIO.output (TextIO.stdErr, Int.toString column_no);
|
|
TextIO.output (TextIO.stdErr, "\n");
|
|
OS.Process.exit OS.Process.failure);
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* For the Mlton compiler, include the following. For Poly/ML, comment
|
|
it out. *)
|
|
main ();
|
|
|
|
(*------------------------------------------------------------------*)
|
|
(* Instructions for GNU Emacs. *)
|
|
|
|
(* local variables: *)
|
|
(* mode: sml *)
|
|
(* sml-indent-level: 2 *)
|
|
(* sml-indent-args: 2 *)
|
|
(* end: *)
|
|
(*------------------------------------------------------------------*)
|