structure Tokens = Tokens
type pos = int
type svalue = Tokens.svalue
type ('a,'b) token = ('a,'b) Tokens.token
type lexresult = (svalue,pos) token

open Tokens

val lineNum = ref 0
val eof = fn () => EOF(!lineNum,!lineNum)


structure KeyWord : sig
                        val find : string ->
                                 (int * int -> (svalue,int) token) option
                    end =
  struct

        val TableSize = 211
        val HashFactor = 5

        val hash = fn s =>
           foldl (fn (c,v)=>(v*HashFactor+(ord c)) mod TableSize) 0 (explode s)


        val HashTable = Array.array(TableSize,nil) :
                 (string * (int * int -> (svalue,int) token)) list Array.array


        val add = fn (s,v) =>
         let val i = hash s
         in Array.update(HashTable,i,(s,v) :: (Array.sub(HashTable, i)))
         end

        val find = fn s =>
          let val i = hash s
              fun f ((key,v)::r) = if s=key then SOME v else f r
                | f nil = NONE
          in  f (Array.sub(HashTable, i))
          end

        val _ =
            (List.app add
        [("and",YAND),
         ("array",YARRAY),
         ("begin",YBEGIN),
         ("case",YCASE),
         ("const",YCONST),
         ("div",YDIV),
         ("do",YDO),
         ("downto",YDOWNTO),
         ("else",YELSE),
         ("end",YEND),
         ("extern",YEXTERN),
         ("file",YFILE),
         ("for",YFOR),
         ("forward",YFORWARD),
         ("function",YFUNCTION),
         ("goto",YGOTO),
         ("hex",YHEX),
         ("if",YIF),
         ("in",YIN),
         ("label",YLABEL),
         ("mod",YMOD),
         ("nil",YNIL),
         ("not",YNOT),
         ("oct",YOCT),
         ("of",YOF),
         ("or",YOR),
         ("packed",YPACKED),
         ("procedure",YPROCEDURE),
         ("program",YPROG),
         ("record",YRECORD),
         ("repeat",YREPEAT),
         ("set",YSET),
         ("then",YTHEN),
         ("to",YTO),
         ("type",YTYPE),
         ("until",YUNTIL),
         ("var",YVAR),
         ("while",YWHILE),
         ("with",YWITH)
        ])
   end
   open KeyWord

%%

%header (functor PascalLexFun(structure Tokens : Pascal_TOKENS));
%s C B;
alpha=[A-Za-z];
digit=[0-9];
optsign=("+"|"-")?;
integer={digit}+;
frac="."{digit}+;
exp=(e|E){optsign}{digit}+;
octdigit=[0-7];
ws = [\ \t];
%%
<INITIAL>{ws}+  => (lex());
<INITIAL>\n+    => (lineNum := (!lineNum) + (String.size yytext); lex());
<INITIAL>{alpha}+ => (case find yytext of SOME v => v(!lineNum,!lineNum)
                                                  | _ => YID(!lineNum,!lineNum));
<INITIAL>{alpha}({alpha}|{digit})*  => (YID(!lineNum,!lineNum));
<INITIAL>{optsign}{integer}({frac}{exp}?|{frac}?{exp}) => (YNUMB(!lineNum,!lineNum));
<INITIAL>{optsign}{integer} => (YINT(!lineNum,!lineNum));
<INITIAL>{octdigit}+(b|B) => (YBINT(!lineNum,!lineNum));
<INITIAL>"'"([^']|"''")*"'" => (YSTRING(!lineNum,!lineNum));
<INITIAL>"(*" =>   (YYBEGIN C; lex());
<INITIAL>".."   => (YDOTDOT(!lineNum,!lineNum));
<INITIAL>"."    => (YDOT(!lineNum,!lineNum));
<INITIAL>"("    => (YLPAR(!lineNum,!lineNum));
<INITIAL>")"    => (YRPAR(!lineNum,!lineNum));
<INITIAL>";"    => (YSEMI(!lineNum,!lineNum));
<INITIAL>","    => (YCOMMA(!lineNum,!lineNum));
<INITIAL>":"    => (YCOLON(!lineNum,!lineNum));
<INITIAL>"^"    => (YCARET(!lineNum,!lineNum));
<INITIAL>"["    => (YLBRA(!lineNum,!lineNum));
<INITIAL>"]"    => (YRBRA(!lineNum,!lineNum));
<INITIAL>"~"    => (YTILDE(!lineNum,!lineNum));
<INITIAL>"<"    => (YLESS(!lineNum,!lineNum));
<INITIAL>"="    => (YEQUAL(!lineNum,!lineNum));
<INITIAL>">"    => (YGREATER(!lineNum,!lineNum));
<INITIAL>"+"    => (YPLUS(!lineNum,!lineNum));
<INITIAL>"-"    => (YMINUS(!lineNum,!lineNum));
<INITIAL>"|"    => (YBAR(!lineNum,!lineNum));
<INITIAL>"*"    => (YSTAR(!lineNum,!lineNum));
<INITIAL>"/"    => (YSLASH(!lineNum,!lineNum));
<INITIAL>"{"    => (YYBEGIN B; lex());
<INITIAL>.      => (YILLCH(!lineNum,!lineNum));
<C>\n+          => (lineNum := (!lineNum) + (String.size yytext); lex());
<C>[^()*\n]+    => (lex());
<C>"(*"         => (lex());
<C>"*)"         => (YYBEGIN INITIAL; lex());
<C>[*()]        => (lex());
<B>\n+          => (lineNum := (!lineNum) + (String.size yytext); lex());
<B>[^{}\n]+     => (lex());
<B>"{"          => (lex());
<B>"}"          => (YYBEGIN INITIAL; lex());
