{
  
open Deppars Config;

(* For nesting comments *)

val comment_depth = ref 0;

(* The table of keywords *)

val keyword_table = (Hasht.new 53 : (string,token) Hasht.t);

val () =
List.app (fn (str,tok) => Hasht.insert keyword_table str tok)
[
  ("abstype",    NULL),
  ("and",        NULL),
  ("andalso",    NULL),
  ("as",         NULL),
  ("case",       NULL),
  ("datatype",   NULL),
  ("do",         NULL),
  ("else",       NULL),
  ("eqtype",     NULL),
  ("end",        NULL),
  ("exception",  NULL),
  ("fn",         NULL),
  ("fun",        NULL),
  ("handle",     NULL),
  ("if",         NULL),
  ("in",         NULL),
  ("infix",      NULL),
  ("infixr",     NULL),
  ("let",        NULL),
  ("local",      NULL),
  ("nonfix",     NULL),
  ("of",         NULL),
  ("op",         NULL),
  ("open",       OPEN),
  ("orelse",     NULL),
  ("prim_eqtype",  NULL),
  ("prim_EQtype",  NULL),
  ("prim_type",    NULL),
  ("prim_val",     NULL),
  ("raise",      NULL),
  ("rec",        NULL),
  ("then",       NULL),
  ("type",       NULL),
  ("val",        NULL),
  ("while",      NULL),
  ("with",       NULL),
  ("withtype",   NULL),
  ("#",          NULL),
  ("->",         NULL),
  ("|",          NULL),
  (":",          NULL),
  ("=>",         NULL),
  ("=",          NULL),
  ("*",          NULL)
];

fun mkKeyword lexbuf =
  let val s = getLexeme lexbuf in
    Hasht.find keyword_table s
    handle Subscript => ID s
  end
;

val savedLexemeStart = ref 0;

fun getQual s =
  let val len' = size s - 1
      fun parse n =
        if n >= len' then
	    ""				(* This can't happen *)
        else if CharVector.sub(s, n) = #"." then
	    CharVectorSlice.vector(CharVectorSlice.slice(s, 0, SOME n))
        else
	    parse (n+1)
  in parse 0 end;

fun mkQualId lexbuf =
  QUAL_ID (getQual(getLexeme lexbuf));

fun lexError msg lexbuf = NULL;

fun incr r = (r := !r + 1);
fun decr r = (r := !r - 1);

}

rule Token = parse
    [^ `\000`-`\255`]
      { lexError "this will be never called!" lexbuf }
  | ""
      {TokenN lexbuf}
and TokenN = parse
    [` ` `\n` `\r` `\t`]  { TokenN lexbuf }
  | "(*"
      { savedLexemeStart := getLexemeStart lexbuf;
        comment_depth := 1; Comment lexbuf; TokenN lexbuf
      }
  | "*)"
      { lexError "unmatched comment bracket" lexbuf }
  | "'" [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]+
                { NULL }
  | "~"? [`0`-`9`]+ (`.` [`0`-`9`]+)? (`E` `~`? [`0`-`9`]+)?
                { NULL }
  | "\""
      { String lexbuf }
  | "#\""
      { String lexbuf }
  | "_"         { NULL }
  | ","         { NULL }
  | "..."       { NULL }
  | "{"         { NULL }
  | "}"         { NULL }
  | "["         { NULL }
  | "#["        { NULL }
  | "]"         { NULL }
  | "("		{ NULL }
  | ")"		{ NULL }
  | ";"         { NULL }
  | (eof | `\^Z`) { EOF }
  | ""          { TokenId lexbuf }

and TokenId = parse
    ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
    | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
       `~` `\`` `^` `|` `*`]+ )
      { mkKeyword lexbuf }
  | ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
    | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
       `~` `\`` `^` `|` `*`]+ )
    "."
    ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
    | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
       `~` `\`` `^` `|` `*`]+ )
      { mkQualId lexbuf }
  | _
      { lexError "ill-formed token" lexbuf }

and Comment = parse
    "(*"
      { (incr comment_depth; Comment lexbuf) }
  | "*)"
      { (decr comment_depth;
         if !comment_depth > 0 then Comment lexbuf else NULL) }
  | (eof | `\^Z`)
      { EOF }
  | _
      { Comment lexbuf }

and String = parse
    `"`
      { NULL }
  | `\\` [`\\` `"` `n` `t`]
      { String lexbuf }
  | `\\` [` ` `\t` `\n` `\r`]+ `\\`
      { String lexbuf }
  | `\\` `^` [`@`-`_`]
      { String lexbuf }
  | `\\` [`0`-`9`] [`0`-`9`] [`0`-`9`]
      { String lexbuf }
  | `\\`
      { SkipString lexbuf }
  | (eof | `\^Z`)
      { EOF }
  | [`\^A`-`\^Z` `\127` `\255`]
      { SkipString lexbuf }
  | _
      { String lexbuf }

and SkipString = parse
    `"`
      { NULL }
  | `\\` [`\\` `"` `n` `t`]
      { SkipString lexbuf }
  | `\\` [` ` `\t` `\n` `\r`]+ `\\`
      { SkipString lexbuf }
  | (eof | `\^Z`)
      { EOF }
  | _
      { SkipString lexbuf }

;
