/* class comment */!!

inherit(Analyzer, #CliTokenizer, #(aliasArray
  /* list of active aliases; for recursion check */
char         /* character value */
temp        /* temporary accumulated string */
tokenType /* token type */
tokenValue /* token value */
includeState  /* 0: not ready, 1: ready,
    2: include found, 3: filename found;
    4: mismatch */
includeQueue  /* buffered tokens */
inputStream /* current input stream */
inputStreamFlushed /* true if stream flushed */
inputType
   /* current input type; 0:file, 1:textcollection,        2:string */
inputSource
   /* current input source; file, textcollection,        string */
inputIndex
   /* index into current text collection, or        string used */
inputStack
  /* stack of nested input sources */
inputStackIndex
  /* index of next available spot in inputStack */
inputStackMax
   /* max number of entries in inputStack */
parserHandle
   /* ID of parser who's driving us */
queuedToken readaheadToken
   /*info to alter physical token stream */
tokensAvailable  /* true if more tokens avail */
eolFlag
   /* true when end of input line encountered */
startingToken
 /* first token in stmt? nil:no, 1:yes, 0:next */), 2, nil)!!

setClassVars(CliTokenizer, #(
$CharType  /* character classes */
$MethodName  /* method name to process characters */
$DoubleQuote /* double quote character string */))!!

now(class(CliTokenizer))!!

/* create, initialize tokenizer. */
Def open(self | temp)
{
  temp := new(CliTokenizer);
  initialize(temp);
  ^temp;
}
!!

now(CliTokenizer)!!

/* add an alias to the alias table; overwrite if already there. */
Def addAlias(self, key, value)
{
  ^setAlias(getCliServerObject(CliServer), key, value);
}
!!

/* add alias to list of those in-use */
Def aliasInUse(self, val | index maxIndex)
{
  aliasArray[inputStackIndex] := val;
}
!!

/* return true if alias already in use. */
Def aliasInUse?(self, val | index maxIndex)
{
  index := 0;
  maxIndex := inputStackIndex;
  loop
  while index < maxIndex
  begin
    if val = aliasArray[index]
      ^0;
    endif;
    index := index + 1;
  endLoop;
  ^nil;
}
!!

/* Return character types - used for testing */
Def charType(self, index)
{
  if (index < 0 or index > 127)
  then
    ^nil;
  endif;
  ^$CharType[index];
}
!!

/* display token for debug */
Def debugTokenDisplay(self, where, tokenType, tokenValue | temp)
{
}
!!

/* delete alias record from table. */
Def deleteAlias(self, key)
{
  ^deleteAlias(getCliServerObject(CliServer), key);
}
!!

/* return end of file status; reset status */
Def eolFoundGet(self | temp)
{
  temp := eolFlag;
  eolFlag := nil;
  ^temp;
}
!!

/* set eol flag to true */
Def eolFoundSet(self)
{
  eolFlag := 0;
}
!!

/* retrieve alias value from table. */
Def getAlias(self, key, system)
{
  ^getAlias(getCliServerObject(CliServer), key, system);
}
!!

/* Get the next character in the stream */
Def getChar(self | nextChar semicolon temp errorMessage)
{
  /* if at end of this stream, attempt to read the next line in the input
     structure.  If nil, the input structure has been exhausted; recommence
     input with previous input source.  Continue uncovering previous input
     sources until more input is found, or the original input is uncovered. */
  loop
  while(inputStream cand atEnd(inputStream) cand inputStackIndex > 0)
  begin
    if not(readNextLine(self))
      /* if end of a FILE, prepare to pass back an implied terminator */
      if inputType = 0
        semicolon := 0;
      else
        semicolon := nil;
      endif;
      /* uncover previous input source */
      popInputStream(self);
      /* pass back terminator if file; otherwise, continue */
      if semicolon
        ^CHAR_SEMICOLON;
      endif;
    endif;
  endLoop;
  
  /* either not eof, or level 0 */
  
  /* stay in this loop until end of input source, or valid character */
  loop
  while 1
  begin
    if not(inputStream) cor atEnd(inputStream)
    then
      /* must be at level 0; read new line if possible */
      if not(readNextLine(self))
        /* at end of file */
        ^CHAR_EOF;
      endif;
    endif;
    if (nextChar := next(inputStream))
      temp := asInt(nextChar);
      if (temp > 127) then
        /* if we see a non-ASCII character, stop (PPR 8202) */
        errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
           ER_CLI_SYNTAX, nil, nil, nil);
        syntaxError(self, nil, errorMessage);
      endif;
      temp := $CharType[temp];
      /* @@
      printLine("getChar: "+asString(asInt(nextChar))+", "+asString(temp));
      */
      ^temp;
    endif;    
  endLoop;
}!!

/* look up keyword in table; return token type if found, nil if not. */
Def getKeywordValue(self, keyword)
{
  ^keywordToTokenValue(CLIUtilities, asLowerCase(keyword));
}
!!

/* highest-level token driver. */
Def getToken(self | temp1 /* temp2 */)
{
  /* get next token */
  temp1 := getToken_Include(self);
  
  /* uncomment to display token number, value
  temp2 := val;
  printLine("token: "+asString(temp1)+", val: "+asString(temp2));
  */
  
  /* if this is a semicolon (statement terminator), the NEXT token is the
     first token in a statement */
  if temp1 = TSEMICOLON
    startingTokenNext(self);
  else
    /* if token was previously marked as a starting token, mark this time */
    if startingTokenNext?(self)
      startingTokenSet(self);
    endif;
  endif;
  ^temp1;
}
!!

/* Monitor the token stream looking for the sequence:
      - end of statement
      - TINCLUDE
      - TQUOTEDSTRING
      - statement terminator
   If this sequence is found, perform the include command by opening the 
   file, and pushing the input source.  Detect file opening errors.  If
   only a partial sequence is recognized, just pass the tokens through. */
Def getToken_Include(self | token errorMessage)
{
  
  loop
  while 0  /* loop forever */
  begin
    /* get the next token if no tokens in queue */
    if includeState <> 4
    then
      token := getToken_Semicolon(self);
    endif;
    
    /* perform state-specific search */
    select
      /* go to state 1 if end of statement found */
      case includeState = 0 is
        if token = TSEMICOLON
        then
          includeState := 1;
        endif;
        /*
        debugTokenDisplay(self, "getToken_Include: state 0", token, val);
        */
        ^token;
      endCase
      /* go to state 2 if TINCLUDE found */
      case includeState = 1 is
        if token = TINCLUDE
        then
          includeState := 2;
          add(includeQueue, tuple(token, val));
        else
          /* includeState stays 1 if TSEMICOLON */
          if token <> TSEMICOLON
          then
            includeState := 0;
          endif;
          /*
          debugTokenDisplay(self, "getToken_Include: state 1", token, val);
          */
          ^token;
        endif;
      endCase
      /* go to state 3 if TQUOTEDSTRING found */
      case includeState = 2 is
        if token = TQUOTEDSTRING
        then
          includeState := 3;
          add(includeQueue, tuple(token, val));
        else
          if token = TSEMICOLON
          then
            includeState := 1;
          else
            includeState := 0;
          endif;
          token := removeFirst(includeQueue);
          val := token[1];
          /*
          debugTokenDisplay(self, "getToken_Include: state 2", token[0], val);
          */
          ^token[0];
        endif;
      endCase
      /* if statement terminator found in state 3, process include command */
      case includeState = 3 is
        if token = TSEMICOLON cor token = TEOF
        then
          removeFirst(includeQueue); /* remove and ignore TINCLUDE */
          token := removeFirst(includeQueue); /* remove filename token */
          includeState := 1;
          includeFile(self, unquote(CLIUtilities, token[1]));
            /* pass filename; call won't return if fails */
        else
          /* mismatch */
          add(includeQueue, tuple(token, val));
          token := removeFirst(includeQueue);
          includeState := 4;
          val := token[1];
          debugTokenDisplay(self, "getToken_Include: state 3", token[0], val);
          ^token[0];
        endif;
      endCase
      /* empty out mismatched tokens */
      case includeState = 4 is
        if size(includeQueue) > 0
        then
          token := removeFirst(includeQueue);
          val := token[1];
          debugTokenDisplay(self, "getToken_Include: state 4", token[0], val);
          ^token[0];
        else
          includeState := 0;
        endif;
      endCase
      default
         errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
           ER_CLI_INTERNAL_ERROR, "CliTokenizer:getToken_Include",
           nil, nil);
        syntaxError(self, nil, errorMessage); 
    endSelect;
  endLoop;
}
!!

Def getToken_Physical(self |
    nextChar localTemp callee aliasFlag aliasValue nextToken temp)
{ 
  val := 0;
  
  /* see if this token marked as a starting token the last time through */
  if startingTokenNext?(self)
    startingTokenSet(self);
  endif;
  
  loop
    aliasFlag := nil;
    nextChar := skipDelimiter(self); /* skip delims & get next character */
    callee := $MethodName[nextChar];  /* determine appropriate method */
    nextToken := perform(self, callee); /* retrieve next token */
    select
      case nextToken = TSEMICOLON is
        /* mark the next token as a starting token */
        startingTokenNext(self);
      endCase
      case nextToken = TEOF is
        /* mark the next token as a starting token */
        startingTokenNext(self);
      endCase
      case nextToken = TLEFT_CURLY is
        /* mark the next token as a starting token */
        startingTokenNext(self);
      endCase
      case nextToken = TLEFT_PAREN is
        /* mark the next token as a starting token */
        startingTokenNext(self);
      endCase
      case nextToken = TEQUALS is
        /* mark the next token as a starting token */
        startingTokenNext(self);
      endCase
      case nextToken = TCOMMENT is
        /* do nothing; just avoid disturbing starting token info */
      endCase
      case nextToken = TIDENT is
        /* check to see if this is a keyword */
        if localTemp := getKeywordValue(self, val)
          val := localTemp;
          nextToken := localTemp;
          startingTokenClear(self);
        else
          /* See if this is an alias */
          if (aliasValue := getAlias(self, val, startingToken?(self)))
            /* only expand the alias if it is not already in use;
               this prevents recursive alias definitions */
            if not(aliasInUse?(self, val))
              pushInputStream(self, 2, aliasValue, val);  /* expand alias */
              aliasFlag := 1;  /* don't have token yet; stay in loop */
            else
              startingTokenClear(self);
            endif;
          else
            startingTokenClear(self);
          endif;
        endif;
      endCase
      default
        /* otherwise, next token is not a starting token */
        startingTokenClear(self);
    endSelect;
  while (aliasFlag cor nextToken = TCOMMENT)
  endLoop;
  
  temp := startingToken;
  if not(temp)
    temp := "nil";
  endif;
  /*
  printLine("ptoken: "+asString(nextToken)+", val: "+asString(temp) +
    " (" + asString(startingToken) + ")");
  */
  ^nextToken;
}
!!

/* Alter the token stream by inserting a TSEMICOLON immediately after
          a TRIGHT_CURLY token EXCEPT when the next token is a TELSE. */
Def getToken_Semicolon(self | tok nextToken rat)
{
  /* return queued token if there is one */
  if queuedToken
    tok := queuedToken[0];
    val := queuedToken[1];
    queuedToken := nil;
    /*
    debugTokenDisplay(self, "getToken_Semicolon", tok, val);
    */
    ^tok;
  endif;
  /* get next token */
  if readaheadToken
    nextToken := readaheadToken;
    readaheadToken := nil;
  else
    nextToken := getToken_Physical(self);
    nextToken := tuple(nextToken, val);
  endif;
  /* if right curly token, read ahead one token to see if semicolon should
     be returned next */
  if nextToken[0] = TRIGHT_CURLY
    /* get readahead token */
    startingTokenNext(self);
    rat := getToken_Physical(self);
    readaheadToken := tuple(rat, val);
    if readaheadToken[0] <> TELSE
      queuedToken := tuple(TSEMICOLON, TSEMICOLON);
    endif;
  endif;
  /* return next token */
  val := nextToken[1];
  if nextToken[0] = TEOF
    tokensAvailable := nil;
  endif;
  /*
  debugTokenDisplay(self, "getToken_Semicolon", nextToken[0], val);
  */
  ^nextToken[0];
}
!!

/* process include command. */
Def includeFile(self, filename | fileHandle newFile errorMessage)
{
  showWaitCurs();
  cleanup();
  showOldCurs();

  newFile := applyWorkDir(getExecutionEngine(CLIExecEngine), filename);
  if not (fileHandle := exists(TextFile, newFile, 0))
    errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
       ER_CLI_FILE_OPEN_ERR, newFile,
       nil, nil);
    syntaxError(self, nil, errorMessage);
    /* syntaxError unravels call stack, and does not return */
  endif;
  open(fileHandle, 0);
  if (getError(fileHandle) <> 0)
    errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
       ER_CLI_FILE_OPEN_ERR, newFile,
       nil, nil);
    syntaxError(self, nil, errorMessage);
    /* syntaxError unravels call stack, and does not return */
  endif;
  pushInputStream(self, 0, fileHandle, nil);
}
!!

/* initialize */
Def initialize(self)
{
  queuedToken := nil;
  readaheadToken := nil;
  inputStackMax := 20;
  inputStack := new(Array, inputStackMax);
  inputStackIndex := 0;
  aliasArray := new(Array, inputStackMax);
  tokensAvailable := nil;  /* nothing to read yet */
  includeState := 1;
  includeQueue := new(OrderedCollection, 4);
  inputStreamFlushed := 0;
}
!!

/* initialize lowest-level stream. */
Def initStream(self, type, source)
{
  reInit(self);
  pushInputStream(self, type, source, nil);
}
!!

/* return parser ID. */
Def parserHandle(self)
{
  ^parserHandle;
}
!!

/* Remove an input stream from the stack (either due to end of stream or
   error recovery).  Don't remove the lowest-level stream. */
Def popInputStream(self | stackEntry)
{
  /* check for streams to be popped */
  if (inputStackIndex  <= 0)
  then
    inputStackIndex := 0;
    ^nil;
  endif;

  /* close file if it is still open */
  if inputType = 0 cand inputSource
  then
    close(inputSource);
  endif;
  
  /* restore info from stack */
  inputStackIndex := inputStackIndex - 1;
  stackEntry := inputStack[inputStackIndex];
  inputType := stackEntry[0];
  inputSource := stackEntry[1];
  inputIndex := stackEntry[2];
  inputStream := stackEntry[3];
  ^0;
}
!!

/* process poundsign
 */
Def processPoundsign(self)
{
  ^processAlphaUnknown(self, 0, 0);
}!!

/* process alpha
 */
Def processAlpha(self)
{
  ^processAlphaUnknown(self, nil, nil);
}!!

/* process alpha or unknown:
     identifier: [alpha|underscore][alpha|digit|underscore]*
     unknown: [alpha|underscore|unknown][alpha|digit|underscore|unknown]*
 */
Def processAlphaUnknown(self unknown poundsign | start next t1)
{
  start := position(inputStream) - 1;
  
  /* loop while reading characters until the token is terminated */
  loop
    next := getChar(self);
    if (next = CHAR_UNRECOGNIZED) cor (next = CHAR_POUNDSIGN)
      unknown := 0;
    endif;
  while (next = CHAR_ALPHAS_A_TO_F cor
         next = CHAR_ALPHA_X cor
         next = CHAR_ALPHAS_OTHER cor
         next = CHAR_UNDERSCORE cor
         next = CHAR_DIGIT_0 cor
         next = CHAR_DIGITS_1_TO_7 cor
         next = CHAR_DIGITS_8_TO_9 cor
         next = CHAR_UNRECOGNIZED cor
         next = CHAR_POUNDSIGN cor
         /* allow a symbol of the form "#~..." to pass through */
         ((next = CHAR_TILDE) cand (poundsign)))
             poundsign := nil;  /* ~ immediatly after # only */
  endLoop;
  putBack(inputStream);
  if (start >= position(inputStream))
    displayFormattedError(ErrorTextLibClass$Inst, 
       ER_CLI_INTERNAL, FORCE_POPUP, "Start or position corrupted.",
       "CLITokenizer:processAlphaUnknown", nil);
  endif;
  val := copyFrom(inputStream, start, position(inputStream));
  if unknown
    ^TUNKNOWN;
  else
    ^TIDENT;
  endif;
}!!

/* ampersand:
     bitwise and: &
     logical and: &&
*/
Def processAmpersand(self | next)
{
  next := getChar(self);
  if (next = CHAR_AMPERSAND)
  then
    val := TLOG_AND;
    ^TLOG_AND;
  else
    putBack(inputStream);
    val := TAMPER;
    ^TAMPER;
  endif;
}!!

/* asterisk: *
*/
Def processAsterisk(self)
{
  val := TSTAR;
  ^TSTAR;
}!!

/* process decimal:
     decimal: [1-9][0-9]*
 */
Def processDecimal(self | start next unknown errorMessage)
{
  unknown := nil;
  start := position(inputStream) - 1;
  
  /* loop while reading characters until the token is terminated */
  loop
    next := getChar(self);
    if next = CHAR_UNRECOGNIZED cor
       next = CHAR_POUNDSIGN cor
       next = CHAR_ALPHAS_A_TO_F cor
       next = CHAR_ALPHA_X cor
       next = CHAR_ALPHAS_OTHER cor
       next = CHAR_UNDERSCORE
      unknown := 0;
    endif;
  while  next = CHAR_DIGIT_0 cor
         next = CHAR_DIGITS_1_TO_7 cor
         next = CHAR_DIGITS_8_TO_9 cor
         next = CHAR_UNRECOGNIZED cor
         next = CHAR_POUNDSIGN cor
         next = CHAR_ALPHAS_A_TO_F cor
         next = CHAR_ALPHA_X cor
         next = CHAR_ALPHAS_OTHER cor
         next = CHAR_UNDERSCORE
  endLoop;
  
  putBack(inputStream);
  val := copyFrom(inputStream, start, position(inputStream));
  if (unknown)
    ^TUNKNOWN;
  else
    ^TNUMBER;
  endif;
}!!

/* process dollar sign:
     variable: $[alpha][alpha|digit]*
 */
Def processDollarSign(self | start next errorMessage)
{
  start := position(inputStream);  /* CLI token recognized; drop dollar sign */
  next := getChar(self);
  if (next ~= CHAR_ALPHAS_A_TO_F cand
      next ~= CHAR_ALPHA_X cand
      next ~= CHAR_ALPHAS_OTHER)
  then
    errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
       ER_CLI_MALFORMED_VARIABLE, 
       copyFrom(inputStream, start, position(inputStream)-1),
       nil, nil);
    syntaxError(self, nil, errorMessage);
  endif;
  loop
    next := getChar(self);
  while (next = CHAR_ALPHAS_A_TO_F cor
         next = CHAR_ALPHA_X cor
         next = CHAR_ALPHAS_OTHER cor
         next = CHAR_UNDERSCORE cor
         next = CHAR_DIGIT_0 cor
         next = CHAR_DIGIT_0 cor
         next = CHAR_DIGITS_1_TO_7 cor
         next = CHAR_DIGITS_8_TO_9)
  endLoop;
  putBack(inputStream);
  val := copyFrom(inputStream, start, position(inputStream));
  ^TVAR;
}!!

/* double quote:
     string: "anything"  note: can't cross end of line
*/
Def processDQuote(self | start next endOfLineInString errorMessage)
{
  start := position(inputStream) - 1;
  
  /* get(discard) eol flag so we don't think eol inside quotes */
  eolFoundGet(self);
  
  /* loop while reading characters until the token is terminated */
  loop
    next := getChar(self);
    
    /* error if string not properly terminated. */
    if (eolFoundGet(self))
      endOfLineInString := 0;
    endif;
  while (next ~= CHAR_DOUBLE_QUOTE cand
         next ~= CHAR_EOF cand
         not(endOfLineInString))
  endLoop;
  
  /* flag error; syntaxError does not return */
  if (endOfLineInString) cor (next = CHAR_EOF)
    errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
       ER_CLI_UNTERM_STRING, nil, nil, nil);
    syntaxError(self, nil, errorMessage);
  endif;
  
  val := copyFrom(inputStream, start, position(inputStream));
  ^TQUOTEDSTRING;
}!!

/* process EOF */
Def processEOF(self)
{
  ^TEOF;
}!!

/* equals:
     equals: =
     equal to: ==
*/
Def processEqual(self | next)
{
  next := getChar(self);
  if (next = CHAR_EQUAL)
  then
    val := TEQUAL_TO;
    ^TEQUAL_TO;
  else
    putBack(inputStream);
    val := TEQUALS;
    ^TEQUALS;
  endif;
}!!

/* exclamation:
     exclaim: !
     not equal: !=
*/
Def processExclamation(self | next)
{
  next := getChar(self);
  if (next = CHAR_EQUAL)
  then
    val := TNOT_EQUAL;
    ^TNOT_EQUAL;
  else
    putBack(inputStream);
    val := TEXCLAM;
    ^TEXCLAM;
  endif;
}!!

/* greater than:
     greater than: >
     greater than or equal to: >=
     right shift: >>
*/
Def processGreaterThan(self | next)
{
  next := getChar(self);
  if (next = CHAR_EQUAL)
  then
    val := TGREATER_EQ;
    ^TGREATER_EQ;
  endif;
  if (next = CHAR_GREATER_THAN)
  then
    val := TRSHIFT;
    ^TRSHIFT;
  else
    putBack(inputStream);
    val := TR_ANGLE;
    ^TR_ANGLE;
  endif;
}!!

/* process hex; see processZero.
 */
Def processHex(self start | next unknown errorMessage)
{  
  /* loop while reading characters until the token is terminated */
  loop
    next := getChar(self);
    if (next = CHAR_UNRECOGNIZED cor
        next = CHAR_POUNDSIGN cor
        next = CHAR_ALPHA_X cor
        next = CHAR_ALPHAS_OTHER cor
        next = CHAR_UNDERSCORE)
      unknown := 0;
    endif;
  while (next = CHAR_DIGIT_0 cor
         next = CHAR_DIGITS_1_TO_7 cor
         next = CHAR_DIGITS_8_TO_9 cor
         next = CHAR_ALPHAS_A_TO_F cor
         next = CHAR_UNRECOGNIZED cor
         next = CHAR_POUNDSIGN cor
         next = CHAR_ALPHA_X cor
         next = CHAR_ALPHAS_OTHER cor
         next = CHAR_UNDERSCORE)
  endLoop;
  
  putBack(inputStream);
  val := copyFrom(inputStream, start, position(inputStream));
  if (unknown)
    ^TUNKNOWN;
  else
    ^TNUMBER;
  endif;
}!!

/* left brace: {
*/
Def processLBrace(self)
{
  val := TLEFT_CURLY;
  ^TLEFT_CURLY;
}!!

/* less than:
     less than: <
     less than or equal to: <=
     left shift: <<
*/
Def processLessThan(self | next)
{
  next := getChar(self);
  if (next = CHAR_EQUAL)
  then
    val := TLESS_EQ;
    ^TLESS_EQ;
  endif;
  if (next = CHAR_LESS_THAN)
  then
    val := TLSHIFT;
    ^TLSHIFT;
  else
    putBack(inputStream);
    val := TL_ANGLE;
    ^TL_ANGLE;
  endif;
}!!

/* left paren: (
*/
Def processLParen(self)
{
  val := TLEFT_PAREN;
  ^TLEFT_PAREN;
}!!

/* minus: -
*/
Def processMinus(self)
{
  val := TMINUS;
  ^TMINUS;
}!!

/* process octal; see processZero.
 */
Def processOctal(self start | next temp unknown errorMessage)
{
  /* octal no longer recognized */
  ^processDecimal(self);
  
  unknown := nil;
  /* loop while reading characters until the token is terminated */
  loop
    next := getChar(self);
    if (next = CHAR_UNRECOGNIZED) cor (next = CHAR_POUNDSIGN)
      unknown := 0;
    endif;
  while (next = CHAR_DIGIT_0 cor
         next = CHAR_DIGITS_1_TO_7 cor
         next = CHAR_UNRECOGNIZED cor
         next = CHAR_POUNDSIGN)
  endLoop;
  
  /* check for bad token */
  if (next = CHAR_DIGITS_8_TO_9 cor
      next = CHAR_ALPHA_X cor
      next = CHAR_ALPHAS_A_TO_F cor
      next = CHAR_ALPHAS_OTHER cor
      next = CHAR_UNDERSCORE)
    errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
       ER_CLI_BAD_OCT, nil, nil, nil);
    syntaxError(self, nil, errorMessage);
  endif;
  
  putBack(inputStream);
  temp := copyFrom(inputStream, start, position(inputStream));
  if (unknown)
    val := temp;
    ^TUNKNOWN;
  else
    /* must convert to decimal; Actor doesn't understand octal */
    val := asUnsignedStringRadix(asLong(asInt(temp, 8)), 10);
    ^TNUMBER;
  endif;
}!!

/* percent: %
*/
Def processPercent(self)
{
  val := TPERCENT;
  ^TPERCENT;
}!!

/* plus: +
*/
Def processPlus(self)
{
  val := TPLUS;
  ^TPLUS;
}!!

/* right brace: }
*/
Def processRBrace(self)
{
  val := TRIGHT_CURLY;
  ^TRIGHT_CURLY;
}!!

/* right paren: )
*/
Def processRParen(self)
{
  val := TRIGHT_PAREN;
  ^TRIGHT_PAREN;
}!!

/* semicolon: ;
*/
Def processSemicolon(self)
{
  val := TSEMICOLON;
  ^TSEMICOLON;
}!!

/* slash:
     slash: /
     comment: / *  ...anything... * /
     comment: / /  ...anything...  <endOfLine>
*/
Def processSlash(self | next t1 t2 t3 errorMessage)
{
  next := getChar(self);
  select
    case next = CHAR_ASTERISK
    is  /* slash-star style comment */
      loop
      while 0
        loop
          next := getChar(self);
        while (next ~= CHAR_ASTERISK cand
               next ~= CHAR_EOF)
        endLoop;
        if next = CHAR_ASTERISK
        then
          if (next := (getChar(self) = CHAR_SLASH))
          then
            ^TCOMMENT;
          endif;
          putBack(inputStream);
        endif;
        if next = CHAR_EOF
        then
          errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
             ER_CLI_UNTERM_COMMENT, nil, nil, nil);
          syntaxError(self, nil, errorMessage);
        endif;
      endLoop;
    endCase
    case next = CHAR_SLASH
    is  /* double-slash style comment */
      eolFoundGet(self);  /* make sure we don't get fooled by old eol */
      loop
      while(not(eolFoundGet(self)))
      begin
        t1 := getChar(self);
        t2 := val;
      endLoop;
      putBack(inputStream);
      ^TCOMMENT;
    endCase
    default
      /* slash token */
      putBack(inputStream);
      val := TSLASH;
      ^TSLASH;
  endSelect;
  
}!!

/* single quote:
     string: 'anything'
*/
Def processSQuote(self | start next endOfLineInString errorMessage)
{
  start := position(inputStream) - 1;
  
  /* loop while reading characters until the token is terminated */
  loop
    next := getChar(self);
    
    /* error if string not properly terminated. */
    if (eolFoundGet(self))
      endOfLineInString := 0;
    endif;
  while (next ~= CHAR_SINGLE_QUOTE cand
         next ~= CHAR_EOF cand
         not(endOfLineInString))
  endLoop;
  
  /* flag error; syntaxError does not return */
  if (endOfLineInString) cor (next = CHAR_EOF) then
    errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
       ER_CLI_UNTERM_STRING, nil, nil, nil);
    syntaxError(self, nil, errorMessage);
  endif;
  
  /* carve out string contents; put on double quote marks */
  val := doubleQuoteString(CLIUtilities) + 
         copyFrom(inputStream, start + 1, position(inputStream) - 1) +
         doubleQuoteString(CLIUtilities);
  ^TQUOTEDSTRING;
}!!

/* tilde: ~
*/
Def processTilde(self)
{
  val := TTILDE;
  ^TTILDE;
}!!

/* process underscore
 */
Def processUnderscore(self)
{
  ^processAlphaUnknown(self, nil, nil);
}!!

/* process unrecognized
 */
Def processUnrecognized(self)
{
  ^processAlphaUnknown(self, 0, nil);
}!!

/* up arrow: ^
*/
Def processUpArrow(self)
{
  val := TUPARROW;
  ^TUPARROW;
}!!

/* vertical bar:
     bitwise or: |
     logical or: ||
*/
Def processVBar(self | next)
{
  next := getChar(self);
  if (next = CHAR_VBAR)
  then
    val := TLOG_OR;
    ^TLOG_OR;
  else
    putBack(inputStream);
    val := TBAR;
    ^TBAR;
  endif;
}!!

/* process zero:
     octal: 0[0-7]*
     hex:   0[xX][0-9a-fA-F]*
 */
Def processZero(self | start next)
{
  start := position(inputStream) - 1;
  /* look at next char; determine the radix or error */
  next := getChar(self);
  if (next = CHAR_ALPHA_X)
    ^processHex(self, start);
  else
    putBack(inputStream);
    ^processOctal(self, start);
  endif;
}!!

/* Add another input stream to the stack (alias expansion) */
Def pushInputStream(self, type, source, aliasKey | errorMessage)
{
  /* check for stack full */
  if ((inputStackIndex +1) >= inputStackMax)
    errorMessage := getFormattedError(ErrorTextLibClass$Inst, 
       ER_CLI_INPUT_STACK_OVERFLOW, nil, nil, nil);
    syntaxError(self, nil, errorMessage);
    /* syntaxError unravels call stack, and does not return */
  endif;
  
  /* save current info if relevant */
  if inputStreamFlushed
    inputStreamFlushed := nil;
  else
    inputStack[inputStackIndex] :=
      tuple(inputType, inputSource, inputIndex, inputStream);
    inputStackIndex := inputStackIndex + 1;
  endif;
  
  /* save alias key for recursive alias detection */
  aliasInUse(self, aliasKey);
  
  /* insert new input settings */
  inputType := type;
  inputSource := source;
  if inputType = 1 /* if text collection, inputIndex is 0; otherwise, nil */
    inputIndex := 0;
  else
    inputIndex := nil;
  endif;
  readNextLine(self); /* initialize inputStream with next source line */
  eolFoundGet(self);  /* not really end of line */
  tokensAvailable := 0;
  ^0;
}
!!

/* read/process next line of input.  Return nil if eof, 0 otherwise. */
Def readNextLine(self | text t1 t2)
{
  /*Hera 12/6/96*/
  if LFlag = 1
  then
     inputSource := FPos;
     LFlag := 0;
  endif;
  FPos := inputSource;
  /*Hera*/

  select
    case inputType = 0 is   /* file */
      eolFoundSet(self);  /* indicate we're at end of line */
      if (inputSource = nil)
        ^nil;
      endif;
      /* source is a text file; "" indicates eof */
      if (text := readLine(inputSource)) = "" cand atEnd(inputSource)
      then
        /* return nil for eof */
        close(inputSource);
        inputSource := nil;
        ^nil;
      endif;
      text := text + " ";  /* insert blank so tokens don't cross lines */
    endCase
    case inputType = 1 is   /* text collection */
      eolFoundSet(self);  /* indicate we're at end of line */
      if inputIndex >= size(inputSource)
      then
        /* return nil for eof */
        ^nil;
      else
        text := inputSource[inputIndex] + " ";
           /* insert blank so tokens don't cross lines */
        inputIndex := inputIndex + 1;
      endif;
    endCase
    case inputType = 2 is   /* string */
      /* CAN'T be at end of line; alias expansion only */
      if not(inputIndex)  /* indicates first time */
      then
        text := inputSource + " ";  /* put in end-of-string delimiter */
        inputIndex := 0;  /* mark string as used */
      else
        /* we've already seen the string */
        ^nil;
      endif;
    endCase
  endSelect;
  /* initialize input stream */
  inputStream := streamOver(text);
  /* send next line to cli presenter for transcription; but not if alias */
  if inputType = 0 cor inputType = 1
  then
    outputCommand(presenter(getCliServerObject(CliServer)), text);
  endif;
  ^0;
}
!!

/* register the parser; lexer occasionally needs access to parser methods. */
Def registerParserHandle(self, p)
{
  parserHandle := p;
}
!!

/* perform reinitialization after command processing resulted in an error. */
Def reInit(self)
{
  /* throw away pending input */
  loop
  while popInputStream(self)
  begin
  endLoop;
  
  tokensAvailable := nil;
  readaheadToken := nil;
  queuedToken := nil;
  inputStackIndex := 0;
  /* - leave input stream non-nil; allow push-back
  inputStream := nil;
  */
  inputStreamFlushed := 0;
  includeState := 1;
  includeQueue := new(OrderedCollection, 4);
  startingTokenSet(self);
}!!

/* skip delimiters; return first non-delimiter type. */
Def skipDelimiter(self | charType)
{
  loop
  while (0)
    charType := getChar(self);
    if (charType ~= CHAR_DELIMITER)
    then
      ^charType;
    endif
  endLoop;
}
!!

/* return true if token is the first token in a statement */
Def startingToken?(self)
{
  ^startingToken = 1;
}
!!

/* set to false */
Def startingTokenClear(self)
{
  startingToken := nil;
  ^0;
}
!!

/* set to next token */
Def startingTokenNext(self)
{
  startingToken := 0;
  ^0;
}
!!

/* return true if next token is the first token in a statement */
Def startingTokenNext?(self)
{
  ^startingToken = 0;
}
!!

/* set to true */
Def startingTokenSet(self)
{
  startingToken := 1;
  ^0;
}
!!

Def syntaxError(self, bp, str)
{
  ^syntaxError(getCliServerObject(CliServer), bp, str)
}!!

Def tokensAvailable(self)
{
  ^tokensAvailable;
}
!!

/*Hera 12/6/96*/
Def SearchLabel(self,str|aString,label,spos,epos)
{
  LFlag := 0;
  moveTo(FPos,0);
  loop
  while not(atEnd(FPos))
  begin
    aString := readLine(FPos);
    spos := find(asUpperCase(aString),"LABEL ",0);
    if spos
    then
       spos := spos + 6;
       epos := indexOf(aString,';',spos);
       label := subString(aString,spos,epos);
       if label = str
       then      
          LFlag := 1;
          ^0;
       endif;
    endif;
   endLoop;       
}!!
/*Hera*/

/* CliTokenizer Class Initialization Code */
$DoubleQuote := asString(asChar(34)); !!

/* Initialize character types */
$CharType := new(Array, 128); !!
$CharType[0] := CHAR_EOF; !!
$CharType[1] := CHAR_DELIMITER; !!
$CharType[2] := CHAR_DELIMITER; !!
$CharType[3] := CHAR_DELIMITER; !!
$CharType[4] := CHAR_DELIMITER; !!
$CharType[5] := CHAR_DELIMITER; !!
$CharType[6] := CHAR_DELIMITER; !!
$CharType[7] := CHAR_DELIMITER; !!
$CharType[8] := CHAR_DELIMITER; !!
$CharType[9] := CHAR_DELIMITER; !!
$CharType[10] := CHAR_DELIMITER; !!
$CharType[11] := CHAR_DELIMITER; !!
$CharType[12] := CHAR_DELIMITER; !!
$CharType[13] := CHAR_DELIMITER; !!
$CharType[14] := CHAR_DELIMITER; !!
$CharType[15] := CHAR_DELIMITER; !!
$CharType[16] := CHAR_DELIMITER; !!
$CharType[17] := CHAR_DELIMITER; !!
$CharType[18] := CHAR_DELIMITER; !!
$CharType[19] := CHAR_DELIMITER; !!
$CharType[20] := CHAR_DELIMITER; !!
$CharType[21] := CHAR_DELIMITER; !!
$CharType[22] := CHAR_DELIMITER; !!
$CharType[23] := CHAR_DELIMITER; !!
$CharType[24] := CHAR_DELIMITER; !!
$CharType[25] := CHAR_DELIMITER; !!
$CharType[26] := CHAR_DELIMITER; !!
$CharType[27] := CHAR_DELIMITER; !!
$CharType[28] := CHAR_DELIMITER; !!
$CharType[29] := CHAR_DELIMITER; !!
$CharType[30] := CHAR_DELIMITER; !!
$CharType[31] := CHAR_DELIMITER; !!
$CharType[32] := CHAR_DELIMITER; !!
$CharType[33] := CHAR_EXCLAMATION; !!
$CharType[34] := CHAR_DOUBLE_QUOTE; !!
$CharType[35] := CHAR_POUNDSIGN; !!
$CharType[36] := CHAR_DOLLAR; !!
$CharType[37] := CHAR_PERCENT; !!
$CharType[38] := CHAR_AMPERSAND; !!
$CharType[39] := CHAR_SINGLE_QUOTE; !!
$CharType[40] := CHAR_LEFT_PAREN; !!
$CharType[41] := CHAR_RIGHT_PAREN; !!
$CharType[42] := CHAR_ASTERISK; !!
$CharType[43] := CHAR_PLUS; !!
$CharType[44] := CHAR_UNRECOGNIZED; !!
$CharType[45] := CHAR_MINUS; !!
$CharType[46] := CHAR_UNRECOGNIZED; !!
$CharType[47] := CHAR_SLASH; !!
$CharType[48] := CHAR_DIGIT_0; !!
$CharType[49] := CHAR_DIGITS_1_TO_7; !!
$CharType[50] := CHAR_DIGITS_1_TO_7; !!
$CharType[51] := CHAR_DIGITS_1_TO_7; !!
$CharType[52] := CHAR_DIGITS_1_TO_7; !!
$CharType[53] := CHAR_DIGITS_1_TO_7; !!
$CharType[54] := CHAR_DIGITS_1_TO_7; !!
$CharType[55] := CHAR_DIGITS_1_TO_7; !!
$CharType[56] := CHAR_DIGITS_8_TO_9; !!
$CharType[57] := CHAR_DIGITS_8_TO_9; !!
$CharType[58] := CHAR_UNRECOGNIZED; !!
$CharType[59] := CHAR_SEMICOLON; !!
$CharType[60] := CHAR_LESS_THAN; !!
$CharType[61] := CHAR_EQUAL; !!
$CharType[62] := CHAR_GREATER_THAN; !!
$CharType[63] := CHAR_UNRECOGNIZED; !!
$CharType[64] := CHAR_UNRECOGNIZED; !!
$CharType[65] := CHAR_ALPHAS_A_TO_F; !!
$CharType[66] := CHAR_ALPHAS_A_TO_F; !!
$CharType[67] := CHAR_ALPHAS_A_TO_F; !!
$CharType[68] := CHAR_ALPHAS_A_TO_F; !!
$CharType[69] := CHAR_ALPHAS_A_TO_F; !!
$CharType[70] := CHAR_ALPHAS_A_TO_F; !!
$CharType[71] := CHAR_ALPHAS_OTHER; !!
$CharType[72] := CHAR_ALPHAS_OTHER; !!
$CharType[73] := CHAR_ALPHAS_OTHER; !!
$CharType[74] := CHAR_ALPHAS_OTHER; !!
$CharType[75] := CHAR_ALPHAS_OTHER; !!
$CharType[76] := CHAR_ALPHAS_OTHER; !!
$CharType[77] := CHAR_ALPHAS_OTHER; !!
$CharType[78] := CHAR_ALPHAS_OTHER; !!
$CharType[79] := CHAR_ALPHAS_OTHER; !!
$CharType[80] := CHAR_ALPHAS_OTHER; !!
$CharType[81] := CHAR_ALPHAS_OTHER; !!
$CharType[82] := CHAR_ALPHAS_OTHER; !!
$CharType[83] := CHAR_ALPHAS_OTHER; !!
$CharType[84] := CHAR_ALPHAS_OTHER; !!
$CharType[85] := CHAR_ALPHAS_OTHER; !!
$CharType[86] := CHAR_ALPHAS_OTHER; !!
$CharType[87] := CHAR_ALPHAS_OTHER; !!
$CharType[88] := CHAR_ALPHA_X; !!
$CharType[89] := CHAR_ALPHAS_OTHER; !!
$CharType[90] := CHAR_ALPHAS_OTHER; !!
$CharType[91] := CHAR_UNRECOGNIZED; !!
$CharType[92] := CHAR_UNRECOGNIZED; !!
$CharType[93] := CHAR_UNRECOGNIZED; !!
$CharType[94] := CHAR_UPARROW; !!
$CharType[95] := CHAR_UNDERSCORE; !!
$CharType[96] := CHAR_UNRECOGNIZED; !!
$CharType[97] := CHAR_ALPHAS_A_TO_F; !!
$CharType[98] := CHAR_ALPHAS_A_TO_F; !!
$CharType[99] := CHAR_ALPHAS_A_TO_F; !!
$CharType[100] := CHAR_ALPHAS_A_TO_F; !!
$CharType[101] := CHAR_ALPHAS_A_TO_F; !!
$CharType[102] := CHAR_ALPHAS_A_TO_F; !!
$CharType[103] := CHAR_ALPHAS_OTHER; !!
$CharType[104] := CHAR_ALPHAS_OTHER; !!
$CharType[105] := CHAR_ALPHAS_OTHER; !!
$CharType[106] := CHAR_ALPHAS_OTHER; !!
$CharType[107] := CHAR_ALPHAS_OTHER; !!
$CharType[108] := CHAR_ALPHAS_OTHER; !!
$CharType[109] := CHAR_ALPHAS_OTHER; !!
$CharType[110] := CHAR_ALPHAS_OTHER; !!
$CharType[111] := CHAR_ALPHAS_OTHER; !!
$CharType[112] := CHAR_ALPHAS_OTHER; !!
$CharType[113] := CHAR_ALPHAS_OTHER; !!
$CharType[114] := CHAR_ALPHAS_OTHER; !!
$CharType[115] := CHAR_ALPHAS_OTHER; !!
$CharType[116] := CHAR_ALPHAS_OTHER; !!
$CharType[117] := CHAR_ALPHAS_OTHER; !!
$CharType[118] := CHAR_ALPHAS_OTHER; !!
$CharType[119] := CHAR_ALPHAS_OTHER; !!
$CharType[120] := CHAR_ALPHA_X; !!
$CharType[121] := CHAR_ALPHAS_OTHER; !!
$CharType[122] := CHAR_ALPHAS_OTHER; !!
$CharType[123] := CHAR_LEFT_BRACE; !!
$CharType[124] := CHAR_VBAR; !!
$CharType[125] := CHAR_RIGHT_BRACE; !!
$CharType[126] := CHAR_TILDE; !!
$CharType[127] := CHAR_DELIMITER; !!

$MethodName := new(Array, 40); !!
$MethodName[CHAR_EOF] := #processEOF; !!
$MethodName[CHAR_DELIMITER] := #processError; !!
$MethodName[CHAR_EXCLAMATION] := #processExclamation; !!
$MethodName[CHAR_DOUBLE_QUOTE] := #processDQuote; !!
$MethodName[CHAR_SINGLE_QUOTE] := #processSQuote; !!
$MethodName[CHAR_UNRECOGNIZED] := #processUnrecognized; !!
$MethodName[CHAR_LEFT_PAREN] := #processLParen; !!
$MethodName[CHAR_RIGHT_PAREN] := #processRParen; !!
$MethodName[CHAR_ASTERISK] := #processAsterisk; !!
$MethodName[CHAR_PLUS] := #processPlus; !!
$MethodName[CHAR_MINUS] := #processMinus; !!
$MethodName[CHAR_SLASH] := #processSlash; !!
$MethodName[CHAR_DIGIT_0] := #processZero; !!
$MethodName[CHAR_DIGITS_1_TO_7] := #processDecimal; !!
$MethodName[CHAR_DIGITS_8_TO_9] := #processDecimal; !!
$MethodName[CHAR_SEMICOLON] := #processSemicolon; !!
$MethodName[CHAR_LESS_THAN] := #processLessThan; !!
$MethodName[CHAR_EQUAL] := #processEqual; !!
$MethodName[CHAR_GREATER_THAN] := #processGreaterThan; !!
$MethodName[CHAR_ALPHAS_A_TO_F] := #processAlpha; !!
$MethodName[CHAR_ALPHA_X] := #processAlpha; !!
$MethodName[CHAR_ALPHAS_OTHER] := #processAlpha; !!
$MethodName[CHAR_LEFT_BRACE] := #processLBrace; !!
$MethodName[CHAR_RIGHT_BRACE] := #processRBrace; !!
$MethodName[CHAR_AMPERSAND] := #processAmpersand; !!
$MethodName[CHAR_VBAR] := #processVBar; !!
$MethodName[CHAR_UPARROW] := #processUpArrow; !!
$MethodName[CHAR_TILDE] := #processTilde; !!
$MethodName[CHAR_PERCENT] := #processPercent; !!
$MethodName[CHAR_DOLLAR] := #processDollarSign; !!
$MethodName[CHAR_UNDERSCORE] := #processUnderscore; !!
$MethodName[CHAR_POUNDSIGN] := #processPoundsign; !!
