excelparser.pas

来自「该程序把Excel公式分解为Token序列。」· PAS 代码 · 共 670 行 · 第 1/2 页

      continue;
    end;

    // error values
    // end marks a token, determined from absolute list of values
    if (inError) then begin
      token := token + currentChar(offset);
      offset := offset + 1;
      if pos(',' + token + ',', ',#NULL!,#DIV/0!,#VALUE!,#REF!,#NAME?,#NUM!,#N/A,') <> 0 then begin
        inError := false;
        tokens.addToken(token, TOK_TYPE_OPERAND, TOK_SUBTYPE_ERROR);
        token := '';
      end;
      continue;
    end;

    // scientific notation check

    if pos(currentChar(offset), '+-') <> 0 then begin
      if (length(token) > 1) then begin
        if ExecRegExpr('^[1-9]{1}(\.[0-9]+)?E{1}$', token) then begin
          token := token + currentChar(offset);
          offset := offset + 1;
          continue;
        end;
      end;
    end;

    // independent character evaulation (order not important)

    // establish state-dependent character evaluations

    if (currentChar(Offset) = '"') then begin
      if (length(token) > 0) then begin
        // not expected
        tokens.addToken(token, TOK_TYPE_UNKNOWN, '');
        token := '';
      end;
      inString := true;
      offset := offset + 1;
      continue;
    end;

    if (currentChar(Offset) = '''') then begin
      if (length(token) > 0) then begin
        // not expected
        tokens.addToken(token, TOK_TYPE_UNKNOWN, '');
        token := '';
      end;
      inPath := true;
      offset := offset + 1;
      continue;
    end;

    if (currentChar(Offset) = '[') then begin
      inRange := true;
      token := token + currentChar(Offset);
      offset := offset + 1;
      continue;
    end;

    if (currentChar(Offset) = '#') then begin
      if (length(token) > 0) then begin
        // not expected
        tokens.addToken(token, TOK_TYPE_UNKNOWN, '');
        token := '';
      end;
      inError := true;
      token := token + currentChar(Offset);
      offset := offset + 1;
      continue;
    end;

    // mark start and end of arrays and array rows

    if (currentChar(Offset) = '{') then begin
      if (length(token) > 0) then begin
        // not expected
        tokens.addToken(token, TOK_TYPE_UNKNOWN, '');
        token := '';
      end;
      tokenStack.push(tokens.addToken('ARRAY', TOK_TYPE_FUNCTION, TOK_SUBTYPE_START));
      tokenStack.push(tokens.addToken('ARRAYROW', TOK_TYPE_FUNCTION, TOK_SUBTYPE_START));
      offset := offset + 1;
      continue;
    end;

    if (currentChar(Offset) = ';') then begin
      if (length(token) > 0) then begin
        tokens.addToken(token, TOK_TYPE_OPERAND, '');
        token := '';
      end;
      tokens.addref(tokenStack.pop);
      tokens.addToken(',', TOK_TYPE_ARGUMENT, '');
      tokenStack.push(tokens.addToken('ARRAYROW', TOK_TYPE_FUNCTION, TOK_SUBTYPE_START));
      offset := offset + 1;
      continue;
    end;

    if (currentChar(Offset) = '}') then begin
      if (length(token) > 0) then begin
        tokens.addToken(token, TOK_TYPE_OPERAND, '');
        token := '';
      end;
      tokens.addRef(tokenStack.pop);
      tokens.addRef(tokenStack.pop);
      offset := offset + 1;
      continue;
    end;

    // trim white-space

    if (currentChar(offset) = ' ') then begin
      if (length(token) > 0) then begin
        tokens.addToken(token, TOK_TYPE_OPERAND, '');
        token := '';
      end;
      tokens.addToken('', TOK_TYPE_WSPACE, '');
      offset := offset + 1;
      while ((currentChar(offset) = ' ') and (not EOF(offset))) do begin
        offset := offset + 1;
      end;
      continue;
    end;

    // multi-character comparators
    if pos(',' + doubleChar(Offset) + ',', ',>=,<=,<>,') <> 0 then begin
      if (length(token) > 0) then begin
        tokens.addToken(token, TOK_TYPE_OPERAND, '');
        token := '';
      end;
      tokens.addToken(doubleChar(Offset), TOK_TYPE_OP_IN, TOK_SUBTYPE_LOGICAL);
      offset := offset + 2;
      continue;
    end;

    // standard infix operators
    if pos(currentChar(offset), '+-*/^&=><') <> 0 then begin
      if (length(token) > 0) then begin
        tokens.addToken(token, TOK_TYPE_OPERAND, '');
        token := '';
      end;
      tokens.addToken(currentChar(offset), TOK_TYPE_OP_IN, '');
      offset := offset + 1;
      continue;
    end;

    // standard postfix operators
    if pos(currentChar(offset), '%') <> 0 then begin
      if (length(token) > 0) then begin
        tokens.addtoken(token, TOK_TYPE_OPERAND, '');
        token := '';
      end;
      tokens.addtoken(currentChar(offset), TOK_TYPE_OP_POST, '');
      offset := offset + 1;
      continue;
    end;

    // start subexpression or function

    if (currentChar(offset) = '(') then begin
      if (length(token) > 0) then begin
        tokenStack.push(tokens.addtoken(token, TOK_TYPE_FUNCTION, TOK_SUBTYPE_START));
        token := '';
      end else begin
        tokenStack.push(tokens.addtoken('', TOK_TYPE_SUBEXPR, TOK_SUBTYPE_START));
      end;
      offset := offset + 1;
      continue;
    end;

    // function, subexpression, array parameters

    if (currentChar(offset) = ',') then begin
      if (length(token) > 0) then begin
        tokens.addtoken(token, TOK_TYPE_OPERAND, '');
        token := '';
      end;
      //ShowMessage(inttostr(tokenstack.count));
      if (not (tokenStack.TokenType = TOK_TYPE_FUNCTION)) then begin
        tokens.addToken(currentChar(offset), TOK_TYPE_OP_IN, TOK_SUBTYPE_UNION);
      end else begin
        tokens.addToken(currentChar(offset), TOK_TYPE_ARGUMENT, '');
      end;
      offset := offset + 1;
      continue;
    end;

    // stop subexpression

    if (currentChar(offset) = ')') then begin
      if (length(token) > 0) then begin
        tokens.addtoken(token, TOK_TYPE_OPERAND, '');
        token := '';
      end;
      if tokenStack.Count > 0 then begin
        tokens.addRef(tokenStack.pop);
        offset := offset + 1;
        continue;
      end else
      begin
        ShowMessage('"' + currentChar(offset) + '" Error');
        break;
      end;
    end;

    // token accumulation

    token := token + currentChar(offset);
    offset := offset + 1;

  end; {while}

  // dump remaining accumulation

  if (length(token) > 0) then tokens.addtoken(token, TOK_TYPE_OPERAND, '');
  if tokenStack.Count > 0 then ShowMessage('Error tokenStack.Count>0');

  // move all tokens to a new collection, excluding all unnecessary white-space tokens

  tokens2 := TTokens.Create;

  while (tokens.moveNext) do begin

    Atoken := tokens.current;

    if (Atoken.TokenType = TOK_TYPE_WSPACE) then begin
      if ((tokens.BOF()) or (tokens.EOF())) then begin end
      else if (not (
        ((tokens.previous.TokenType = TOK_TYPE_FUNCTION) and (tokens.previous.subtype = TOK_SUBTYPE_STOP)) or
        ((tokens.previous.TokenType = TOK_TYPE_SUBEXPR) and (tokens.previous.subtype = TOK_SUBTYPE_STOP)) or
        (tokens.previous.TokenType = TOK_TYPE_OPERAND)
        )
        ) then begin end
      else if (not (
        ((tokens.next.TokenType = TOK_TYPE_FUNCTION) and (tokens.next.subtype = TOK_SUBTYPE_START)) or
        ((tokens.next.TokenType = TOK_TYPE_SUBEXPR) and (tokens.next.subtype = TOK_SUBTYPE_START)) or
        (tokens.next.TokenType = TOK_TYPE_OPERAND)
        )
        ) then begin end
      else
        tokens2.addtoken(Atoken.value, TOK_TYPE_OP_IN, TOK_SUBTYPE_INTERSECT);
      continue;
    end;

    tokens2.addRef(Atoken);

  end;

  // switch infix "-" operator to prefix when appropriate, switch infix "+" operator to noop when appropriate, identify operand
  // and infix-operator subtypes, pull "@" from in front of function names

  while (tokens2.moveNext) do begin

    Atoken := tokens2.current;

    if ((Atoken.tokentype = TOK_TYPE_OP_IN) and (atoken.value = '-')) then begin
      if (tokens2.BOF) then
        atoken.tokentype := TOK_TYPE_OP_PRE
      else if (
        ((tokens2.previous.tokentype = TOK_TYPE_FUNCTION) and (tokens2.previous.subtype = TOK_SUBTYPE_STOP)) or
        ((tokens2.previous.tokentype = TOK_TYPE_SUBEXPR) and (tokens2.previous.subtype = TOK_SUBTYPE_STOP)) or
        (tokens2.previous.tokentype = TOK_TYPE_OP_POST) or
        (tokens2.previous.tokentype = TOK_TYPE_OPERAND)
        ) then
        atoken.subtype := TOK_SUBTYPE_MATH
      else
        atoken.Tokentype := TOK_TYPE_OP_PRE;
      continue;
    end;

    if ((atoken.Tokentype = TOK_TYPE_OP_IN) and (atoken.value = '+')) then begin
      if (tokens2.BOF) then
        atoken.Tokentype := TOK_TYPE_NOOP
      else if (
        ((tokens2.previous.Tokentype = TOK_TYPE_FUNCTION) and (tokens2.previous.subtype = TOK_SUBTYPE_STOP)) or
        ((tokens2.previous.Tokentype = TOK_TYPE_SUBEXPR) and (tokens2.previous.subtype = TOK_SUBTYPE_STOP)) or
        (tokens2.previous.Tokentype = TOK_TYPE_OP_POST) or
        (tokens2.previous.Tokentype = TOK_TYPE_OPERAND)
        ) then
        atoken.subtype := TOK_SUBTYPE_MATH
      else
        atoken.Tokentype := TOK_TYPE_NOOP;
      continue;
    end;

    if ((atoken.Tokentype = TOK_TYPE_OP_IN) and (length(atoken.subtype) = 0)) then begin
      if pos(leftstr(AToken.Value, 1), '<>=') <> 0 then
        atoken.subtype := TOK_SUBTYPE_LOGICAL
      else if (atoken.value = '&') then
        atoken.subtype := TOK_SUBTYPE_CONCAT
      else
        atoken.subtype := TOK_SUBTYPE_MATH;
      continue;
    end;

    if ((atoken.Tokentype = TOK_TYPE_OPERAND) and (length(atoken.subtype) = 0)) then begin
      if not TextToFloat(PChar(atoken.value), tempf, fvExtended) then
        if ((atoken.value = 'TRUE') or (atoken.value = 'FALSE')) then
          atoken.subtype := TOK_SUBTYPE_LOGICAL
        else
          atoken.subtype := TOK_SUBTYPE_RANGE
      else
        atoken.subtype := TOK_SUBTYPE_NUMBER;
      continue;
    end;

    if (atoken.tokentype = TOK_TYPE_FUNCTION) then begin
      if (leftstr(atoken.value, 1) = '@') then
        atoken.value := RightStr(atoken.value, length(atoken.Value) - 1);
      continue;
    end;

  end;

  tokens2.reset;

  // move all tokens to a new collection, excluding all noops

  tokens.Clear;
  tokens.Reset;

  while (tokens2.moveNext) do begin
    if (tokens2.current.tokentype <> TOK_TYPE_NOOP) then
      tokens.addRef(tokens2.current);
  end;

  tokens.reset;
  result := tokens;
  tokenStack.Free;
end;

end.