qexpryacc.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

         else if CompareText(FIdentifier,'POWER')=0 then
         IDF:= AddExpression(TMathExpression.Create(FTempParams, mfPower))
         else if CompareText(FIdentifier,'UPPER')=0 then
         IDF:= AddExpression(TStringExpression.Create(FTempParams, sfUpper))
         else if CompareText(FIdentifier,'LOWER')=0 then
         IDF:= AddExpression(TStringExpression.Create(FTempParams, sfLower))
         else if CompareText(FIdentifier,'COPY')=0 then
         IDF:= AddExpression(TStringExpression.Create(FTempParams, sfCopy))
         else if CompareText(FIdentifier,'SUBSTRING')=0 then
         IDF:= AddExpression(TStringExpression.Create(FTempParams, sfCopy))
         else if CompareText(FIdentifier,'POS')=0 then
         IDF:= AddExpression(TStringExpression.Create(FTempParams, sfPos))
         else if CompareText(FIdentifier,'CHARINDEX')=0 then
         IDF:= AddExpression(TStringExpression.Create(FTempParams, sfPos))
         else if CompareText(FIdentifier,'LENGTH')=0 then
         IDF:= AddExpression(TStringExpression.Create(FTempParams, sfLength))
         else if CompareText(FIdentifier,'LEFT')=0 then
         IDF:= AddExpression(TLeftExpr.Create(FTempParams))
         else if CompareText(FIdentifier,'RIGHT')=0 then
         IDF:= AddExpression(TRightExpr.Create(FTempParams))
         else if CompareText(FIdentifier,'YEAR')=0 then
         IDF:= AddExpression(TDecodeDateTimeExpr.Create(FTempParams, dkYear))
         else if CompareText(FIdentifier,'MONTH')=0 then
         IDF:= AddExpression(TDecodeDateTimeExpr.Create(FTempParams, dkMonth))
         else if CompareText(FIdentifier,'DAY')=0 then
         IDF:= AddExpression(TDecodeDateTimeExpr.Create(FTempParams, dkDay))
         else if CompareText(FIdentifier,'HOUR')=0 then
         IDF:= AddExpression(TDecodeDateTimeExpr.Create(FTempParams, dkHour))
         else if CompareText(FIdentifier,'MIN')=0 then
         IDF:= AddExpression(TDecodeDateTimeExpr.Create(FTempParams, dkMin))
         else if CompareText(FIdentifier,'SEC')=0 then
         IDF:= AddExpression(TDecodeDateTimeExpr.Create(FTempParams, dkSec))
         else if CompareText(FIdentifier,'MSEC')=0 then
         IDF:= AddExpression(TDecodeDateTimeExpr.Create(FTempParams, dkMSec))
         else if CompareText(FIdentifier,'FORMATDATETIME')=0 then
         IDF:= AddExpression(TFormatDateTimeExpr.Create(FTempParams))
         else if CompareText(FIdentifier,'FORMATFLOAT')=0 then
         IDF:= AddExpression(TFormatFloatExpr.Create(FTempParams))
         else if CompareText(FIdentifier,'FORMAT')=0 then
         IDF:= AddExpression(TFormatExpr.Create(FTempParams))
         else if CompareText(FIdentifier,'DECODE')=0 then
         IDF:= AddExpression(TDecodeExpr.Create(FTempParams))
         else if CompareText(FIdentifier,'MINOF')=0 then
         IDF:= AddExpression(TMinMaxOfExpr.Create(FTempParams, True))
         else if CompareText(FIdentifier,'MAXOF')=0 then
         IDF:= AddExpression(TMinMaxOfExpr.Create(FTempParams, False))
         else if CompareText(FIdentifier,'SQLLIKE')=0 then
         IDF:= AddExpression(TSQLLikeExpr.Create(FTempParams, False))
         else if CompareText(FIdentifier,'SQLNOTLIKE')=0 then
         IDF:= AddExpression(TSQLLikeExpr.Create(FTempParams, True))
         else if CompareText(FIdentifier,'ASCII')=0 then
         IDF:= AddExpression(TASCIIExpr.Create(FTempParams));
         end;
         if IDF= nil then
         begin
         FTempParams.Free;
         yyerror(Format('Unknown Identifier %s', [yyv[yysp-1].yystring]));
         yyabort;
         Exit;
         end;

       end;
   3 : begin
         AddExpression(TTypeCast.Create(ForceParamList(1), ttString));
       end;
   4 : begin
         AddExpression(TTypeCast.Create(GetParamList, ttFloat));
       end;
   5 : begin
         AddExpression(TTypeCast.Create(ForceParamList(1), ttFloat));
       end;
   6 : begin
         AddExpression(TTypeCast.Create(GetParamList, ttInteger));
       end;
   7 : begin
         AddExpression(TTypeCast.Create(ForceParamList(1), ttInteger));
       end;
   8 : begin
         AddExpression(TTypeCast.Create(GetParamList, ttBoolean));
       end;
   9 : begin
         AddExpression(TTypeCast.Create(ForceParamList(1), ttBoolean));
       end;
  10 : begin
         AddExpression(TConditional.Create(GetParamList));
       end;
  11 : begin
         AddExpression(TCaseWhenElseExpr.Create(FWhenParamList, FThenParamList, FElseExpr));
         FWhenParamList:= nil;
         FThenParamList:= nil;
         FElseExpr:= nil;

       end;
  12 : begin
         AddExpression( TBetweenExpr.Create(ForceParamList(3), FALSE) );
       end;
  13 : begin
         AddExpression( TBetweenExpr.Create(ForceParamList(3), TRUE) );
       end;
  14 : begin
         AddExpression( TSQLInPredicateExpr.Create(ForceParamList(FParamCount + 1), FALSE) );
       end;
  15 : begin
         AddExpression( TSQLInPredicateExpr.Create(ForceParamList(FParamCount + 1), TRUE) );
       end;
  16 : begin
         AddExpression(TSQLLikeExpr.Create(ForceParamList(3), FALSE));
       end;
  17 : begin
         AddExpression(TSQLLikeExpr.Create(ForceParamList(3), TRUE));
       end;
  18 : begin
         GetOneOperator;
         AddExpression(TUnaryOp.Create(opMinus, Op1));
         FIsComplex:= True;
       end;
  19 : begin
         GetOneOperator;
         AddExpression(TUnaryOp.Create(opPlus, Op1));
         FIsComplex:= True;
       end;
  20 : begin
         GetOneOperator;
         AddExpression(TUnaryOp.Create(opNot, Op1));
         FIsComplex:= True;
       end;
  21 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opPlus, Op1, Op2));
         FIsComplex:= True;
       end;
  22 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opMinus, Op1, Op2));
         FIsComplex:= True;
       end;
  23 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opMult, Op1, Op2));
         FIsComplex:= True;
       end;
  24 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opDivide, Op1, Op2));
         FIsComplex:= True;
       end;
  25 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opDiv, Op1, Op2));
         FIsComplex:= True;
       end;
  26 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opExp, Op1, Op2));
         FIsComplex:= True;
       end;
  27 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opMod, Op1, Op2));
         FIsComplex:= True;
       end;
  28 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opShl, Op1, Op2));
         FIsComplex:= True;
       end;
  29 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opShr, Op1, Op2));
         FIsComplex:= True;
       end;
  30 : begin
         GetTwoOperators;
         AddExpression(TRelationalOp.Create(opGTE, Op1, Op2));
         FIsComplex:= True;
       end;
  31 : begin
         GetTwoOperators;
         AddExpression(TRelationalOp.Create(opLTE, Op1, Op2));
         FIsComplex:= True;
       end;
  32 : begin
         GetTwoOperators;
         AddExpression(TRelationalOp.Create(opGT, Op1, Op2));
         FIsComplex:= True;
       end;
  33 : begin
         GetTwoOperators;
         AddExpression(TRelationalOp.Create(opLT, Op1, Op2));
         FIsComplex:= True;
       end;
  34 : begin
         GetTwoOperators;
         AddExpression(TRelationalOp.Create(opEQ, Op1, Op2));
         FIsComplex:= True;
       end;
  35 : begin
         GetTwoOperators;
         AddExpression(TRelationalOp.Create(opNEQ, Op1, Op2));
         FIsComplex:= True;
       end;
  36 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opAnd, Op1, Op2));
         FIsComplex:= True;
       end;
  37 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opOr, Op1, Op2));
         FIsComplex:= True;
       end;
  38 : begin
         GetTwoOperators;
         AddExpression(TBinaryOp.Create(opXor, Op1, Op2));
         FIsComplex:= True;
       end;
  39 : begin
         FIsComplex:= True;
       end;
  40 : begin
         FStackedParamCount.Add(Pointer(0));
       end;
  41 : begin
         yyval := yyv[yysp-1];
       end;
  42 : begin
         yyval := yyv[yysp-2];
       end;
  43 : begin
         FStackedParamCount.Add(Pointer(0));
       end;
  44 : begin
         AddParam;
       end;
  45 : begin
         AddParam;
       end;
  46 : begin
         yyval := yyv[yysp-3];
       end;
  47 : begin
         yyval := yyv[yysp-0];
       end;
  48 : begin
         yyval := yyv[yysp-1];
       end;
  49 : begin
         if FWhenParamList=nil then
         FWhenParamList:= TParameterList.Create;
         if FThenParamList=nil then
         FThenParamList:= TParameterList.Create;
         FWhenParamList.Add(FExprList[FExprList.Count-2]);
         FThenParamList.Add(FExprList[FExprList.Count-1]);
         FExprList.Delete(FExprList.Count-1);
         FExprList.Delete(FExprList.Count-1);

       end;
  50 : begin
       end;
  51 : begin
         FElseExpr:= TExpression(FExprList[FExprList.Count-1]);
         FExprList.Delete(FExprList.Count-1);

       end;
  52 : begin
         FGroupIdentList.Add('');
         FIdentifierList.Add(UpperCase(yyv[yysp-0].yystring));

       end;
  53 : begin
         FGroupIdentList.Add(UpperCase(yyv[yysp-2].yystring));
         FIdentifierList.Add(UpperCase(yyv[yysp-0].yystring));

       end;
  54 : begin
         Val(yyv[yysp-0].yystring, IntVal, Code);
         if Code=0 then
         FExprList.Add(TIntegerLiteral.Create(StrToInt(yyv[yysp-0].yystring)))
         else
         FExprList.Add(TFloatLiteral.Create(StrToFloat(yyv[yysp-0].yystring)));

       end;
  55 : begin
         Val(yyv[yysp-0].yystring, IntVal, Code);
         if Code=0 then
         FExprList.Add(TIntegerLiteral.Create(StrToInt(yyv[yysp-0].yystring)))
         else
         FExprList.Add(TFloatLiteral.Create(StrToFloat(yyv[yysp-0].yystring)));

       end;
  56 : begin
         FExprList.Add(TFloatLiteral.Create(StrToFloat(yyv[yysp-0].yystring)));
       end;
  57 : begin
         FExprList.Add(TStringLiteral.Create( GetString( yyv[yysp-0].yystring ) ));
       end;
  58 : begin
         FExprList.Add(TBooleanLiteral.Create(True));
       end;
  59 : begin
         FExprList.Add(TBooleanLiteral.Create(False));
       end;
  60 : begin
         yyval.yystring := GetExplicitParam( yyv[yysp-0].yystring );
       end;
  61 : begin
         FExprList.Add(TStringLiteral.Create(''));
       end;
  62 : begin
         FExprList.Add(TStringLiteral.Create(GetString( yyv[yysp-0].yystring )));
       end;
  end;
end(*yyaction*);

(* parse table: *)

type YYARec = record
                sym, act : SmallInt;
              end;
     YYRRec = record
                len, sym : SmallInt;
              end;

const

yynacts   = 1688;
yyngotos  = 143;
yynstates = 123;
yynrules  = 62;

var

yya : array [1..yynacts    ] of YYARec;
yyg : array [1..yyngotos   ] of YYARec;
yyd : array [0..yynstates-1] of SmallInt;
yyal: array [0..yynstates-1] of SmallInt;
yyah: array [0..yynstates-1] of SmallInt;
yygl: array [0..yynstates-1] of SmallInt;
yygh: array [0..yynstates-1] of SmallInt;
yyr : array [1..yynrules   ] of YYRRec;

procedure LoadResArrays;

  procedure ResLoad(const resname: string; ResourceBuffer: Pointer);
  var
    ResourceSize: Integer;
    ResourcePtr: PChar;
    BinResource: THandle;
    ResInstance: Longint;
    H: THandle;
    Buf: array[0..255] of Char;
  begin
    H := System.FindResourceHInstance(HInstance);
    StrPLCopy(Buf, resname, SizeOf(Buf)-1);
    ResInstance := FindResource(H, Buf, RT_RCDATA);
    if ResInstance = 0 then begin
      H := HInstance;
      {try to find in main binary}
      ResInstance := FindResource(H, Buf, RT_RCDATA);
    end;
    ResourceSize := SizeofResource(H,ResInstance);
    BinResource := LoadResource(H,ResInstance);
    ResourcePtr := LockResource(BinResource);
    Move(ResourcePtr^, ResourceBuffer^, ResourceSize);
    UnlockResource(BinResource);
    FreeResource(BinResource);

  end;
begin

  ResLoad('QExprYacc_YYA', @yya[1]);
  ResLoad('QExprYacc_YYG', @yyg[1]);

  ResLoad('QExprYacc_YYD', @yyd[0]);

  ResLoad('QExprYacc_YYAL', @yyal[0]);

  ResLoad('QExprYacc_YYAH', @yyah[0]);

  ResLoad('QExprYacc_YYGL', @yygl[0]);

  ResLoad('QExprYacc_YYGH', @yygh[0]);

  ResLoad('QExprYacc_YYR', @yyr[1]);


end;


const _error = 256; (* error token *)

function yyact(state, sym : Integer; var act : SmallInt) : Boolean;
  (* search action table *)
  var k : Integer;
  begin
    k := yyal[state];
    while (k<=yyah[state]) and (yya[k].sym<>sym) do inc(k);
    if k>yyah[state] then
      yyact := false
    else
      begin
        act := yya[k].act;
        yyact := true;
      end;
  end(*yyact*);

function yygoto(state, sym : Integer; var nstate : SmallInt) : Boolean;
  (* search goto table *)
  var k : Integer;
  begin
    k := yygl[state];
    while (k<=yygh[state]) and (yyg[k].sym<>sym) do inc(k);
    if k>yygh[state] then
      yygoto := false
    else
      begin
        nstate := yyg[k].act;
        yygoto := true;
      end;
  end(*yygoto*);

label parse, next, error, errlab, shift, reduce, accept, abort;

begin(*yyparse*)

  (* load arrays from resource *)
  LoadResArrays;

  yystate := 0; yychar := -1; yynerrs := 0; yyerrflag := 0; yysp := 0;

{$ifdef yydebug}
  yydebug := true;
{$else}
  yydebug := false;
{$endif}

parse:

  (* push state and value: *)

  inc(yysp);
  if yysp>yymaxdepth then
    begin
      yyerror('yyparse stack overflow');
      goto abort;
    end;
  yys[yysp] := yystate; yyv[yysp] := yyval;

next:

  if (yyd[yystate]=0) and (yychar=-1) then
    (* get next symbol *)
    begin
      repeat
         yychar := yyLexer.yylex; if yychar<0 then yychar := 0;
         // ignore comments and blanks [ \n\t]
         if not( (yychar=_COMMENT) or (yychar=_BLANK) or
                 (yychar=_TAB) or (yychar=_NEWLINE) ) then break;
      until false;
      if yychar= _ILLEGAL then goto error;
    end;

  (*
  if yydebug then
    writeln( yyLexer.yyOutput, 'state '+intToStr( yystate)+ ', char '+
                               intToStr( yychar) + ' at line n