extended codetools parser for generic and specialize keywords

git-svn-id: trunk@8367 -

components/codetools/codetoolsstrconsts.pas

@@ -71,7 +71,7 @@ ResourceString
   ctsUnexpectedKeyword = 'unexpected keyword "%s"';
   ctsNoPascalCodeFound = 'no pascal code found (first token is %s)';
   ctsStringConstant = 'string constant';
-  ctsAnoymDefinitionsAreNotAllowed = 'Anonym %s definitions are not allowed';
+  ctsAnoymDefinitionsAreNotAllowed = 'Anonymous %s definitions are not allowed';
   ctsEndForRecordNotFound = 'end for record not found';
   ctsMissingEnumList = 'missing enum list';
   ctsMissingTypeIdentifier = 'missing type identifier';

components/codetools/codetree.pas

@@ -110,15 +110,19 @@ const
   ctnPointerType     = 75;
   ctnClassOfType     = 76;
   ctnVariantType     = 77;
+  ctnSpecialize      = 78;
+  ctnSpecializeType  = 79;
+  ctnSpecializeParams= 80;
+  ctnGenericType     = 81;
 
-  ctnBeginBlock      = 80;
-  ctnAsmBlock        = 81;
+  ctnBeginBlock      = 90;
+  ctnAsmBlock        = 91;
 
-  ctnWithVariable    = 90;
-  ctnWithStatement   = 91;
-  ctnOnBlock         = 92;
-  ctnOnIdentifier    = 93;
-  ctnOnStatement     = 94;
+  ctnWithVariable    =100;
+  ctnWithStatement   =101;
+  ctnOnBlock         =102;
+  ctnOnIdentifier    =103;
+  ctnOnStatement     =104;
 
 
   // combined values
@@ -349,6 +353,11 @@ begin
   ctnFileType: Result:='File Type';
   ctnPointerType: Result:='Pointer ^ Type';
   ctnClassOfType: Result:='Class Of Type';
+  ctnVariantType: Result:='Variant Type';
+  ctnSpecialize: Result:='Specialize Type';
+  ctnSpecializeType: Result:='Specialize Typename';
+  ctnSpecializeParams: Result:='Specialize Parameterlist';
+  ctnGenericType: Result:='Generic Type';
 
   ctnWithVariable: Result:='With Variable';
   ctnWithStatement: Result:='With Statement';

components/codetools/examples/methodjumping.pas

@@ -24,7 +24,7 @@ program MethodJumping;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, SysUtils, CodeToolManager, CodeCache;
+  Classes, SysUtils, CodeToolManager, CodeCache, CustomCodeTool;
   
 var
   ExpandedFilename: String;
@@ -32,11 +32,17 @@ var
   NewCode: TCodeBuffer;
   NewX, NewY, NewTopLine: integer;
   RevertableJump: boolean;
+  Tool: TCustomCodeTool;
 begin
   ExpandedFilename:=ExpandFileName('tgeneric2.pp');
   CodeBuf:=CodeToolBoss.LoadFile(ExpandedFilename,true,false);
-  CodeToolBoss.JumpToMethod(CodeBuf,10,8,NewCode,NewX,NewY,NewTopLine,
-                            RevertableJump);
-  writeln(NewCode.Filename,' ',NewX,',',NewY,' TopLine=',NewTopLine,' RevertableJump=',RevertableJump);
+  if CodeToolBoss.JumpToMethod(CodeBuf,10,8,NewCode,NewX,NewY,NewTopLine,
+                            RevertableJump)
+  then
+    writeln(NewCode.Filename,' ',NewX,',',NewY,' TopLine=',NewTopLine,' RevertableJump=',RevertableJump)
+  else
+    writeln('Method body not found.');
+  Tool:=CodeToolBoss.FindCodeToolForSource(CodeBuf);
+  Tool.WriteDebugTreeReport;
 end.
 

components/codetools/examples/tgeneric2.pp

@@ -3,12 +3,12 @@ program TGeneric2;
 {$mode objfpc}
 
 type
-   TList=generic(_T) class(TObject)
-     data : _T;
-     procedure Add(item: _T);
+   TList = generic(T) class(TObject)
+     data : T;
+     procedure Add(item: T);
    end;
 
-procedure TList.Add(item: _T);
+procedure TList.Add(item: T);
 var
   i : integer;
 begin

components/codetools/keywordfunclists.pas

@@ -106,6 +106,7 @@ var
   WordIsBlockKeyWord,
   EndKeyWordFuncList,
   PackedTypesKeyWordFuncList,
+  GenericTypesKeyWordFuncList,
   BlockStatementStartKeyWordFuncList,
   WordIsLogicalBlockStart,
   WordIsLogicalBlockEnd,
@@ -982,6 +983,16 @@ begin
     Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   
+  GenericTypesKeyWordFuncList:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(GenericTypesKeyWordFuncList);
+  with GenericTypesKeyWordFuncList do begin
+    Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('DISPINTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
+  end;
+
   BlockStatementStartKeyWordFuncList:=TKeyWordFunctionList.Create;
   KeyWordLists.Add(BlockStatementStartKeyWordFuncList);
   with BlockStatementStartKeyWordFuncList do begin

components/codetools/pascalparsertool.pas

@@ -138,6 +138,8 @@ type
     function KeyWordFuncClass: boolean;
     function KeyWordFuncClassInterface: boolean;
     function KeyWordFuncTypePacked: boolean;
+    function KeyWordFuncGeneric: boolean;
+    function KeyWordFuncSpecialize: boolean;
     function KeyWordFuncTypeArray: boolean;
     function KeyWordFuncTypeProc: boolean;
     function KeyWordFuncTypeSet: boolean;
@@ -363,6 +365,8 @@ begin
     Add('INTERFACE',@KeyWordFuncClassInterface);
     Add('DISPINTERFACE',@KeyWordFuncClassInterface);
     Add('PACKED',@KeyWordFuncTypePacked);
+    Add('GENERIC',@KeyWordFuncGeneric);
+    Add('SPECIALIZE',@KeyWordFuncSpecialize);
     Add('ARRAY',@KeyWordFuncTypeArray);
     Add('PROCEDURE',@KeyWordFuncTypeProc);
     Add('FUNCTION',@KeyWordFuncTypeProc);
@@ -2436,6 +2440,7 @@ function TPascalParserTool.KeyWordFuncBeginEnd: boolean;
 var
   ChildNodeCreated: boolean;
 begin
+  //DebugLn('TPascalParserTool.KeyWordFuncBeginEnd CurNode=',CurNode.DescAsString);
   if (CurNode<>nil)
   and (not (CurNode.Desc in
     [ctnProcedure,ctnProgram,ctnLibrary,ctnImplementation]))
@@ -2809,6 +2814,108 @@ begin
         CurPos.EndPos-CurPos.StartPos);
 end;
 
+function TPascalParserTool.KeyWordFuncGeneric: boolean;
+// generic type
+// examples:
+//   type TGenericList = generic(A,B) class end;
+begin
+  if (CurNode.Desc<>ctnTypeDefinition) then
+    SaveRaiseExceptionFmt(ctsAnoymDefinitionsAreNotAllowed,['generic']);
+  CreateChildNode;
+  CurNode.Desc:=ctnGenericType;
+  // read parameter list
+  ReadNextAtom;
+  if CurPos.Flag<>cafRoundBracketOpen then
+    RaiseCharExpectedButAtomFound('(');
+  repeat
+    ReadNextAtom;
+    AtomIsIdentifier(true);
+    ReadNextAtom;
+    if Curpos.Flag=cafPoint then begin
+      // first identifier was unitname, now read the type
+      ReadNextAtom;
+      AtomIsIdentifier(true);
+      CurNode.EndPos:=CurPos.EndPos;
+      ReadNextAtom;
+    end;
+    if CurPos.Flag=cafRoundBracketClose then
+      break
+    else if CurPos.Flag=cafComma then begin
+      // read next identifier
+    end else
+      RaiseCharExpectedButAtomFound(')');
+  until false;
+  ReadNextAtom;
+  // read class, record, object, interface
+  if not GenericTypesKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
+    CurPos.EndPos-CurPos.StartPos) then
+    RaiseStringExpectedButAtomFound('"class"');
+  Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
+        CurPos.EndPos-CurPos.StartPos);
+  // close generic type
+  CurNode.EndPos:=CurPos.StartPos;
+  EndChildNode;
+end;
+
+function TPascalParserTool.KeyWordFuncSpecialize: boolean;
+// specialize template
+// examples:
+//   type TListOfInteger = specialize TGenericList(integer,string);
+//   type TListOfChar = specialize Classes.TGenericList(integer,objpas.integer);
+begin
+  if (CurNode.Desc<>ctnTypeDefinition) then
+    SaveRaiseExceptionFmt(ctsAnoymDefinitionsAreNotAllowed,['specialize']);
+  CreateChildNode;
+  CurNode.Desc:=ctnSpecialize;
+  // read identifier (the name of the generic)
+  ReadNextAtom;
+  AtomIsIdentifier(true);
+  CreateChildNode;
+  CurNode.Desc:=ctnSpecializeType;
+  CurNode.EndPos:=CurPos.EndPos;
+  ReadNextAtom;
+  if Curpos.Flag=cafPoint then begin
+    // first identifier was unitname, now read the type
+    ReadNextAtom;
+    AtomIsIdentifier(true);
+    CurNode.EndPos:=CurPos.EndPos;
+    ReadNextAtom;
+  end;
+  EndChildNode;
+  // read type list
+  if CurPos.Flag<>cafRoundBracketOpen then
+    RaiseCharExpectedButAtomFound('(');
+  CreateChildNode;
+  CurNode.Desc:=ctnSpecializeParams;
+  // read list of types
+  repeat
+    // read identifier (a parameter of the generic type)
+    ReadNextAtom;
+    AtomIsIdentifier(true);
+    ReadNextAtom;
+    if Curpos.Flag=cafPoint then begin
+      // first identifier was unitname, now read the type
+      ReadNextAtom;
+      AtomIsIdentifier(true);
+      ReadNextAtom;
+    end;
+    if CurPos.Flag=cafRoundBracketClose then
+      break
+    else if CurPos.Flag=cafComma then begin
+      // read next parameter
+    end else
+      RaiseCharExpectedButAtomFound(')');
+  until false;
+  // close list
+  CurNode.EndPos:=CurPos.EndPos;
+  EndChildNode;
+  // close specialize
+  CurNode.EndPos:=CurPos.EndPos;
+  EndChildNode;
+  ReadNextAtom;
+  Result:=true;
+end;
+
 function TPascalParserTool.KeyWordFuncClass: boolean;
 // class, object
 //   this is a quick parser, which will only create one node for each class
@@ -2819,15 +2926,11 @@ var
   ClassAtomPos: TAtomPosition;
   Level: integer;
 begin
-  if CurNode.Desc<>ctnTypeDefinition then
+  if not (CurNode.Desc in [ctnTypeDefinition,ctnGenericType]) then
     SaveRaiseExceptionFmt(ctsAnoymDefinitionsAreNotAllowed,['class']);
   if (LastUpAtomIs(0,'PACKED')) then begin
-    if not LastAtomIs(1,'=') then
-      SaveRaiseExceptionFmt(ctsAnoymDefinitionsAreNotAllowed,['class']);
     ClassAtomPos:=LastAtoms.GetValueAt(1);
   end else begin
-    if not LastAtomIs(0,'=') then
-      SaveRaiseExceptionFmt(ctsAnoymDefinitionsAreNotAllowed,['class']);
     ClassAtomPos:=CurPos;
   end;
   // class or 'class of' start found
@@ -2896,9 +2999,7 @@ var
   ChildCreated: boolean;
   IntfAtomPos: TAtomPosition;
 begin
-  if CurNode.Desc<>ctnTypeDefinition then
-    SaveRaiseExceptionFmt(ctsAnoymDefinitionsAreNotAllowed,['interface']);
-  if not LastAtomIs(0,'=') then
+  if not (CurNode.Desc in [ctnTypeDefinition,ctnGenericType]) then
     SaveRaiseExceptionFmt(ctsAnoymDefinitionsAreNotAllowed,['interface']);
   IntfAtomPos:=CurPos;
   // class interface start found