unit uengShaderFileHelper; {$mode objfpc}{$H+} {$I uengShaderFile.inc} interface uses uengShaderPart, uengShaderFileParser, uengShaderPartClass; type TInfoFlag = ( ifWarning, ifRaiseEx ); TInfoFlags = set of TInfoFlag; function IsValidIdentifier(const aIdent: String): Boolean; function CheckEndToken(const aToken: String; const aArgs: TengParseArgs; const aShaderPart: TengShaderPart): String; function CheckType(const aShaderPart: TengShaderPart; const aTypes: array of CengShaderPart): Boolean; function ExtractSearchResult( const aSender: TengShaderPart; const aIdent: String; const aList: TengShaderPartList; const aFlags: TInfoFlags = [ifWarning, ifRaiseEx]; aLine: Integer = -1; aCol: Integer = -1; aFilename: String = ''): TengShaderPart; type TengSearchFlag = ( sfSearchChildren, // search in children sfEvaluateIf, // evaluate if and search in suitable subtree sfIgnoreIf, // do not search in if items sfSearchChildrenLazy, // set sfSearchChildren in next recursion level sfSearchParents, // search in Parents sfSearchInherited, // search in inherited classes sfIgnoreOwner // ignore owner of search walker ); TengSearchFlags = set of TengSearchFlag; TengSearchResults = class(TengShaderPartList) public function Add(const aItem: TengShaderPart): Integer; reintroduce; constructor Create; end; TengSearchWalker = class(TengShaderPartWalker) private type TArgs = packed record Flags: TengSearchFlags; end; PArgs = ^TArgs; private fOwner: TengShaderPart; fResults: TengSearchResults; fSearchFlags: TengSearchFlags; fResultTypes: CengShaderPartArr; fChildrenDoNotLeave: CengShaderPartArr; fParentsDoNotLeave: CengShaderPartArr; fChildrenForceLeave: CengShaderPartArr; fParentsForceLeave: CengShaderPartArr; protected procedure Visit(const aPart, aSender: TengShaderPart; const aArgs: Pointer); override; function Check(const aPart: TengShaderPart): Boolean; virtual; public property Owner: TengShaderPart read fOwner write fOwner; property SearchFlags: TengSearchFlags read fSearchFlags write fSearchFlags; property ResultTypes: CengShaderPartArr read fResultTypes write fResultTypes; property ChildrenDoNotLeave: CengShaderPartArr read fChildrenDoNotLeave write fChildrenDoNotLeave; property ParentsDoNotLeave: CengShaderPartArr read fParentsDoNotLeave write fParentsDoNotLeave; property ChildrenForceLeave: CengShaderPartArr read fChildrenForceLeave write fChildrenForceLeave; property ParentsForceLeave: CengShaderPartArr read fParentsForceLeave write fParentsForceLeave; constructor Create(const aResults: TengSearchResults); end; TengKeyValuePairSearchWalker = class(TengSearchWalker) private fName: String; protected function Check(const aPart: TengShaderPart): Boolean; override; public property Name: String read fName write fName; end; TengInheritedSearchWalker = class(TengSearchWalker) private fName: String; protected function Check(const aPart: TengShaderPart): Boolean; override; public property Name: String read fName write fName; constructor Create(const aClass: TengShaderPartClass; const aResults: TengSearchResults); end; TengProcSearchWalker = class(TengSearchWalker) private fName: String; protected function Check(const aPart: TengShaderPart): Boolean; override; public property Name: String read fName write fName; constructor Create(const aResults: TengSearchResults); end; implementation uses sysutils, uengShaderFileConstants, uengShaderFileTypes, uengShaderPartKeyValuePair, uengShaderPartProc, uengShaderPartIf; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function IsValidIdentifier(const aIdent: String): Boolean; var i, len: Integer; begin len := Length(aIdent); result := false; for i := 1 to len do if not (aIdent[i] in VALID_IDENT_CHARS) then exit; result := true; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function CheckEndToken(const aToken: String; const aArgs: TengParseArgs; const aShaderPart: TengShaderPart): String; var oldLine, oldCol: Integer; param: TengTokenParameterList; begin oldLine := aArgs.Line; oldCol := aArgs.Col; if (aToken <> TOKEN_END) then raise EengUnexpectedToken.Create(aToken, TOKEN_END, oldLine, oldCol, aShaderPart.Filename, aShaderPart); param := TengTokenParameterList.Create(''); try if not aArgs.ExtractToken(aShaderPart, param) then EengUnexpectedToken.Create(TOKEN_NONE, TOKEN_END, oldLine, oldCol, aShaderPart.Filename, aShaderPart); if (param[0].Name <> TOKEN_END) then EengUnexpectedToken.Create(param[0].Name, TOKEN_END, oldLine, oldCol, aShaderPart.Filename, aShaderPart); if (param.Count <> 1) then EengInvalidParamterCount.Create(TOKEN_END, 1, oldLine, oldCol, aShaderPart.Filename, aShaderPart); result := ''; finally FreeAndNil(param); end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function CheckType(const aShaderPart: TengShaderPart; const aTypes: array of CengShaderPart): Boolean; var t: CengShaderPart; begin result := true; for t in aTypes do if (aShaderPart is t) then exit; result := (Length(aTypes) = 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ExtractSearchResult(const aSender: TengShaderPart; const aIdent: String; const aList: TengShaderPartList; const aFlags: TInfoFlags; aLine: Integer; aCol: Integer; aFilename: String): TengShaderPart; var s: String; i: Integer; begin result := nil; if Assigned(aSender) then begin if (aLine < 0) then aLine := aSender.Line; if (aCol < 0) then aCol := aSender.Col; if (aFilename = '') then aFilename := aSender.Filename; end; if (aList.Count <= 0) then begin if (ifRaiseEx in aFlags) then raise EengUnknownIdentifier.Create(aIdent, aLine, aCol, aFilename, aSender); exit; end; result := aList[aList.Count-1]; if (aList.Count > 1) and Assigned(aSender) and (ifWarning in aFlags) then begin s := Format('use of duplicate identifier: %s (%s %d:%d)', [aIdent, result.Filename, result.Line + 1, result.Col]) + sLineBreak + 'previously declared here:' + sLineBreak; i := aList.Count - 2; while (i >= 0) do begin s := s + Format(' %s %d:%d', [aList[i].Filename, aList[i].Line + 1, aList[i].Col]) + sLineBreak; dec(i); end; aSender.LogMsg(llWarning, s); end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TengSearchResults.Add(const aItem: TengShaderPart): Integer; var i: Integer; begin result := -1; for i := 0 to Count-1 do if (Items[i] = aItem) then exit; result := inherited Add(aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TengSearchResults///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TengSearchResults.Create; begin inherited Create(false); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TengSearchWalker////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TengSearchWalker.Visit(const aPart, aSender: TengShaderPart; const aArgs: Pointer); function VisitChild(const aItem: TengShaderPart): Boolean; var c: CengShaderPart; begin result := Assigned(aItem) and (aItem <> aSender); if not result then exit; for c in fChildrenDoNotLeave do if (aItem is c) then result := false; for c in fChildrenForceLeave do if (aItem is c) then result := true; end; function VisitParent: Boolean; var c: CengShaderPart; begin result := Assigned(aPart.Parent) and (aPart.Parent <> aSender); if not result then exit; for c in fParentsDoNotLeave do if (aPart is c) then result := false; for c in fParentsForceLeave do if (aPart is c) then result := true; end; var p: TengShaderPart; c: TengShaderPartClass; args: TArgs; nextArgs: TArgs; begin if not Assigned(aPart) then exit; if Assigned(aArgs) then args := PArgs(aArgs)^ else args.Flags := fSearchFlags; // calculate args for next iteration nextArgs := args; if (sfSearchChildrenLazy in nextArgs.Flags) then nextArgs.Flags := nextArgs.Flags + [sfSearchChildren] - [sfSearchChildrenLazy]; // sfSearchParents if (sfSearchParents in args.Flags) then begin if Check(aPart.Parent) then fResults.Add(aPart.Parent); if VisitParent then Visit(aPart.Parent, aPart, @nextArgs); end; // sfSearchInherited if (sfSearchInherited in args.Flags) and (aPart is TengShaderPartClass) then begin for c in (aPart as TengShaderPartClass).InheritedClasses do begin if Check(c) then fResults.Add(c); Visit(c, aPart, @nextArgs); end; end; // sfSearchChildren if (sfSearchChildren in args.Flags) then begin // sfEvaluateIf, sfIgnoreIf if (aPart is TengShaderPartIf) then with (aPart as TengShaderPartIf) do begin if (sfEvaluateIf in args.Flags) then begin if Expression.GetValue then p := IfPart else p := ElsePart; if Assigned(p) then Visit(p, aPart, @nextArgs); exit; end else if (sfIgnoreIf in args.Flags) then exit; end; // normal children for p in aPart do begin if Check(p) then fResults.Add(p); if VisitChild(p) then Visit(p, aPart, @nextArgs); end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TengSearchWalker.Check(const aPart: TengShaderPart): Boolean; var c: CengShaderPart; begin result := (aPart <> fOwner) or not (sfIgnoreOwner in fSearchFlags); if result then for c in fResultTypes do if (aPart is c) then exit; result := false; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TengSearchWalker.Create(const aResults: TengSearchResults); begin inherited Create; fResults := aResults; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TengKeyValuePairSearchWalker////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TengKeyValuePairSearchWalker.Check(const aPart: TengShaderPart): Boolean; begin result := inherited Check(aPart) and (aPart is TengShaderPartKeyValuePair) and ((aPart as TengShaderPartKeyValuePair).Name = fName); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TengInheritedSearchWalker///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TengInheritedSearchWalker.Check(const aPart: TengShaderPart): Boolean; begin result := inherited Check(aPart) and (aPart is TengShaderPartClass) and ((aPart as TengShaderPartClass).Name = fName); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TengInheritedSearchWalker.Create(const aClass: TengShaderPartClass; const aResults: TengSearchResults); begin inherited Create(aResults); ResultTypes := CengShaderPartArr.Create(TengShaderPartClass); SearchFlags := [sfSearchInherited, sfIgnoreOwner]; Owner := aClass; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TengProcSearchWalker////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TengProcSearchWalker.Check(const aPart: TengShaderPart): Boolean; begin result := inherited Check(aPart) and (aPart is TengShaderPartProc) and ((aPart as TengShaderPartProc).Name = fName); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TengProcSearchWalker.Create(const aResults: TengSearchResults); begin inherited Create(aResults); ResultTypes := CengShaderPartArr.Create(TengShaderPartProc); end; end.