Definition from Wikipedia:

 Lexical analysis is the process of converting a sequence of characters (such as in a computer program or web page) into a sequence of tokens (strings with an identified "meaning"). A program that performs lexical analysis may be called a lexer, tokenizer, or scanner (though "scanner" is also used to refer to the first stage of a lexer).
Task[edit]
Create a lexical analyzer for the simple programming language specified below. The
program should read input from a file and/or stdin, and write output to a file and/or
stdout. If the language being used has a lexer module/library/class, it would be great
if two versions of the solution are provided: One without the lexer module, and one with.

Input Specification
The simple programming language to be analyzed is more or less a subset of C. It supports the following tokens:

Operators


 Name 
 Common name 
 Character sequence


 Op_multiply 
 multiply 
 *


 Op_divide 
 divide 
 /


 Op_mod 
 mod 
 %


 Op_add 
 plus 
 +


 Op_subtract 
 minus 
 -


 Op_negate 
 unary minus 
 -


 Op_less 
 less than 
 <


 Op_lessequal 
 less than or equal 
 <=


 Op_greater 
 greater than 
 >


 Op_greaterequal 
 greater than or equal 
 >=


 Op_equal 
 equal 
 ==


 Op_notequal 
 not equal 
 !=


 Op_not 
 unary not 
 !


 Op_assign 
 assignment 
 =


 Op_and 
 logical and 
 &&


 Op_or 
 logical or 
 ¦¦

 The - token should always be interpreted as Op_subtract by the lexer. Turning some Op_subtract into Op_negate will be the job of the syntax analyzer, which is not part of this task.
Symbols


 Name 
 Common name 
 Character


 LeftParen 
 left parenthesis 
 (


 RightParen 
 right parenthesis 
 )


 LeftBrace 
 left brace 
 {


 RightBrace 
 right brace 
 }


 Semicolon 
 semi-colon 
 ;


 Comma 
 comma 
 ,

Keywords


 Name 
 Character sequence


 Keyword_if 
 if


 Keyword_else 
 else


 Keyword_while 
 while


 Keyword_print 
 print


 Keyword_putc 
 putc

Identifiers and literals
These differ from the the previous tokens, in that each occurrence of them has a value associated with it.



 Name

 Common name

 Format description

 Format regex

 Value


 Identifier

 identifier

 one or more letter/number/underscore characters, but not starting with a number

 [_a-zA-Z][_a-zA-Z0-9]*

 as is


 Integer

 integer literal

 one or more digits

 [0-9]+

 as is, interpreted as a number


 Integer

 char literal

 exactly one character (anything except newline or single quote) or one of the allowed escape sequences, enclosed by single quotes

 '([^'\n]|\\n|\\\\)'

 the ASCII code point number of the character, e.g. 65 for 'A' and 10 for '\n'


 String

 string literal

 zero or more characters (anything except newline or double quote), enclosed by double quotes

 "[^"\n]*"

 the characters without the double quotes and with escape sequences converted

 For char and string literals, the \n escape sequence is supported to represent a new-line character.
 For char and string literals, to represent a backslash, use \\.
 No other special sequences are supported. This means that:
 Char literals cannot represent a single quote character (value 39).
 String literals cannot represent strings containing double quote characters.
Zero-width tokens


 Name 
 Location


 End_of_input 
 when the end of the input stream is reached

White space
 Zero or more whitespace characters, or comments enclosed in /* ... */, are allowed between any two tokens, with the exceptions noted below.
 "Longest token matching" is used to resolve conflicts (e.g., in order to match <= as a single token rather than the two tokens < and =).
 Whitespace is required between two tokens that have an alphanumeric character or underscore at the edge.
 This means: keywords, identifiers, and integer literals.
 e.g. ifprint is recognized as an identifier, instead of the keywords if and print.
 e.g. 42fred is invalid, and neither recognized as a number nor an identifier.
 Whitespace is not allowed inside of tokens (except for chars and strings where they are part of the value).
 e.g. & & is invalid, and not interpreted as the && operator.
For example, the following two program fragments are equivalent, and should produce the same token stream except for the line and column positions:

 if ( p /* meaning n is prime */ ) {
    print ( n , " " ) ;
    count = count + 1 ; /* number of primes found so far */
}
 if(p){print(n," ");count=count+1;}
Complete list of token names
End_of_input  Op_multiply   Op_divide     Op_mod       Op_add     Op_subtract
Op_negate     Op_not        Op_less       Op_lessequal Op_greater Op_greaterequal
Op_equal      Op_notequal   Op_assign     Op_and       Op_or      Keyword_if
Keyword_else  Keyword_while Keyword_print Keyword_putc LeftParen  RightParen
LeftBrace     RightBrace    Semicolon     Comma        Identifier Integer
String

Output Format
The program output should be a sequence of lines, each consisting of the following whitespace-separated fields:

 the line number where the token starts
 the column number where the token starts
 the token name
 the token value (only for Identifier, Integer, and String tokens)
 the number of spaces between fields is up to you. Neatly aligned is nice, but not a requirement.


This task is intended to be used as part of a pipeline, with the other compiler tasks - for example:

lex < hello.t | parse | gen | vm

Or possibly:

lex hello.t lex.out
parse lex.out parse.out
gen parse.out gen.out
vm gen.out



This implies that the output of this task (the lexical analyzer) should be suitable as input to any of the Syntax Analyzer task programs.

Diagnostics
The following error conditions should be caught:



 Error

 Example


 Empty character constant

 ''


 Unknown escape sequence.

 \r


 Multi-character constant.

 'xx'


 End-of-file in comment. Closing comment characters not found.


 End-of-file while scanning string literal. Closing string character not found.


 End-of-line while scanning string literal. Closing string character not found before end-of-line.


 Unrecognized character.

 |


 Invalid number. Starts like a number, but ends in non-numeric characters.

 123abc

Test Cases


 Input

 Output



Test Case 1:

/*
  Hello world
 */
print("Hello, World!\n");


    4      1 Keyword_print
    4      6 LeftParen
    4      7 String         "Hello, World!\n"
    4     24 RightParen
    4     25 Semicolon
    5      1 End_of_input




Test Case 2:

/*
  Show Ident and Integers
 */
phoenix_number = 142857;
print(phoenix_number, "\n");


    4      1 Identifier     phoenix_number
    4     16 Op_assign
    4     18 Integer         142857
    4     24 Semicolon
    5      1 Keyword_print
    5      6 LeftParen
    5      7 Identifier     phoenix_number
    5     21 Comma
    5     23 String         "\n"
    5     27 RightParen
    5     28 Semicolon
    6      1 End_of_input




Test Case 3:

/*
  All lexical tokens - not syntactically correct, but that will
  have to wait until syntax analysis
 */
/* Print   */  print    /* Sub     */  -
/* Putc    */  putc     /* Lss     */  <
/* If      */  if       /* Gtr     */  >
/* Else    */  else     /* Leq     */  <=
/* While   */  while    /* Geq     */  >=
/* Lbrace  */  {        /* Eq      */  ==
/* Rbrace  */  }        /* Neq     */  !=
/* Lparen  */  (        /* And     */  &&
/* Rparen  */  )        /* Or      */  ||
/* Uminus  */  -        /* Semi    */  ;
/* Not     */  !        /* Comma   */  ,
/* Mul     */  *        /* Assign  */  =
/* Div     */  /        /* Integer */  42
/* Mod     */  %        /* String  */  "String literal"
/* Add     */  +        /* Ident   */  variable_name
/* character literal */  '\n'
/* character literal */  '\\'
/* character literal */  ' '


    5     16   Keyword_print
    5     40   Op_subtract
    6     16   Keyword_putc
    6     40   Op_less
    7     16   Keyword_if
    7     40   Op_greater
    8     16   Keyword_else
    8     40   Op_lessequal
    9     16   Keyword_while
    9     40   Op_greaterequal
   10     16   LeftBrace
   10     40   Op_equal
   11     16   RightBrace
   11     40   Op_notequal
   12     16   LeftParen
   12     40   Op_and
   13     16   RightParen
   13     40   Op_or
   14     16   Op_subtract
   14     40   Semicolon
   15     16   Op_not
   15     40   Comma
   16     16   Op_multiply
   16     40   Op_assign
   17     16   Op_divide
   17     40   Integer             42
   18     16   Op_mod
   18     40   String          "String literal"
   19     16   Op_add
   19     40   Identifier      variable_name
   20     26   Integer             10
   21     26   Integer             92
   22     26   Integer             32
   23      1   End_of_input




Test Case 4:

/*** test printing, embedded \n and comments with lots of '*' ***/
print(42);
print("\nHello World\nGood Bye\nok\n");
print("Print a slash n - \\n.\n");


    2      1 Keyword_print
    2      6 LeftParen
    2      7 Integer            42
    2      9 RightParen
    2     10 Semicolon
    3      1 Keyword_print
    3      6 LeftParen
    3      7 String          "\nHello World\nGood Bye\nok\n"
    3     38 RightParen
    3     39 Semicolon
    4      1 Keyword_print
    4      6 LeftParen
    4      7 String          "Print a slash n - \\n.\n"
    4     33 RightParen
    4     34 Semicolon
    5      1 End_of_input


Additional examples
Your solution should pass all the test cases above and the additional tests found Here.



Reference
The C and Python versions can be considered reference implementations.



Related Tasks
 Syntax Analyzer task
 Code Generator task
 Virtual Machine Interpreter task
 AST Interpreter task



(*------------------------------------------------------------------*)
(* 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: *)
(*------------------------------------------------------------------*)