[fpc-pascal] Codetools generic constants
Ryan Joseph
genericptr at gmail.com
Fri Jun 26 06:36:18 CEST 2020
I got the Lazarus sources on svn and I'm not sure how to make a diff! Here are changes I propose to allow generic constants (I believe this is Mattias's code so he'll understand). It's just a few lines in a single function. Not sure about the error message but I think this is more or less the right idea. Let me know how we can get this integrated. Thanks.
procedure TPascalParserTool.ReadGenericParamList(Must, AllowConstraints: boolean);
{ At start cursor is on <
At end cursor is on atom after >
Examples:
<> = type; // fpc style
<name>=type; // this is the only case where >= are two operators
<name,name> = type; // delphi style
<T1: record; T2,T3: class; T4: constructor; T5: name> = type
}
var
RequiresConstraint: boolean = false;
HasConstraint: boolean = false;
begin
if not AtomIsChar('<') then begin
if Must then
SaveRaiseCharExpectedButAtomFound(20171106143341,'<');
exit;
end else if not (Scanner.CompilerMode in cmAllModesWithGeneric) then
exit;
CreateChildNode;
CurNode.Desc:=ctnGenericParams;
ReadNextAtom;
// param is a constant which requires constraints
if UpAtomIs('CONST') then
begin
RequiresConstraint:=true;
ReadNextAtom;
end;
//debugln(['TPascalParserTool.ReadGenericParamList START ctnGenericParams ',GetAtom]);
if AtomIsIdentifier then begin
CreateChildNode;
CurNode.Desc:=ctnGenericParameter;
CurNode.EndPos:=CurPos.EndPos;
ReadNextAtom;
repeat
// read name
//debugln(['TPascalParserTool.ReadGenericParamList AFTER NAMESTART ctnGenericParams ',GetAtom]);
if AtomIs('>=') then begin
// this is the rare case where >= are two separate atoms
dec(CurPos.EndPos);
end;
if CurPos.Flag in [cafComma,cafSemicolon] then begin
// read next name
EndChildNode;
ReadNextAtom;
AtomIsIdentifierSaveE(20180411194201);
CreateChildNode;
CurNode.Desc:=ctnGenericParameter;
CurNode.EndPos:=CurPos.EndPos;
ReadNextAtom;
end else if AtomIsChar('>') then begin
break;
end else if AllowConstraints and (CurPos.Flag=cafColon) then begin
// read constraints
HasConstraint:=true;
ReadNextAtom;
if CurPos.Flag<>cafNone then begin
CreateChildNode;
CurNode.Desc:=ctnGenericConstraint;
end;
repeat
CurNode.EndPos:=CurPos.EndPos;
CurNode.Parent.EndPos:=CurPos.EndPos;
if UpAtomIs('RECORD') or UpAtomIs('CLASS') or UpAtomIs('CONSTRUCTOR')
then begin
// keyword
ReadNextAtom;
end else begin
// a type
AtomIsIdentifierSaveE(20180411194204);
ReadNextAtom;
end;
if AtomIs('>=') then begin
// this is the rare case where >= are two separate atoms
dec(CurPos.EndPos);
end;
if (CurPos.Flag=cafSemicolon) or AtomIsChar('>') then begin
break;
end else if CurPos.Flag<>cafComma then
SaveRaiseCharExpectedButAtomFound(20170421195740,'>');
ReadNextAtom;
until false;
// close ctnGenericConstraint
EndChildNode;
if AtomIsChar('>') then break;
// cursor is now on ;
end else
SaveRaiseCharExpectedButAtomFound(20170421195742,'>');
until false;
// give an error if no constraint was found
// note(ryan): what error should be given, any error at all??
if RequiresConstraint and not HasConstraint then
SaveRaiseUnexpectedKeyWord(20170421195742);
RequiresConstraint:=false;
HasConstraint:=false;
// close ctnGenericParameter
EndChildNode;
end else begin
if AtomIs('>=') then begin
// this is the rare case where >= are two separate atoms
dec(CurPos.EndPos);
LastAtoms.SetCurrent(CurPos);
end;
if not AtomIsChar('>') then
SaveRaiseCharExpectedButAtomFound(20170421195745,'>');
end;
// close ctnGenericParams
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
ReadNextAtom;
end;
Regards,
Ryan Joseph
More information about the fpc-pascal
mailing list