[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