fpc/packages/fcl-passrc/examples/test_parser.pp

{   This is a test-program for the fcl-passrc package (except writer-class).

    Please notice that i have done this to find out how good the parser workes,
    it is not thought to be a good example to use the fcl-passrc package but
    may give you hints on using it.

    It is done to test the source of these units for usability, completeness and
    bugs. It is base on the fcl-passrc exampe.
    It workes like a pretty-printer to compare the output of this program with
    the original code, but is not thought to be a real pretty-printer as
    e.g. the semicolons can sometimes not be set at the place they sould be
    (this imformation is not available from the parsing-engine, as a parser
    should only give you a positiv result if the source is valid, otherwise
    you get a negative result).
    Also the output is not always in the same order as in input as this
    information is not available easily.
    
    !!!Do not expect this program to produce executeable output!!!

    Status: -workes with one Unit or Program
            -Some type declarations missing
            -string[n] the [n] part missing -> missing in parser
            -array of const -> missing in parser
            -Hints deprecated, etc. missing sometimes
            -the parser splits x,y:atype
              x:atype
              y:atype
             i tryed to put them together again
            - () missing in statements: () expression and typecast
            -missing forward class declaration like x=class
            -incomplete !

            parser: -ugly ''' quotation from scanner, why not #39 ?
                    -see comments in the program for hints
                    -incomplete !

    Usage: call with one complete filename of a Unit or Program
           defaults for the parser are 'linux' and 'i386'

    Output: is 'pretty-printed' to stdout or unformated
            The unformated output is thought to be diffed with the original
            source to see differences caused by the parser (a tool to unformat
            a souce file is in progress but not finished jet).

    Bugs: 1. In case of unimplemented statements (like up to now asm) the parser
             cause a excemtion to abort the program hard.
          2. Missing implementaion in this program should not print out anything
             or result in not pascal conform output.

    Hit: The parser uses directives given in the source file.

   Hints to read the code:
    There are comments in the code with hints and marks of possible bugs.
    During development some code was modified for true order output but the
    old code is still available as a comment as it is easier to understand.
    This is programmed using 'recursive' calls. Most options in functions are
    for printing the output.
    There is no writer-class used to keep it simple and see what is done.
    All output is produced by direct writing to stdout, this cause problems in
    furter development; a function result as string may be more usable.

    The parser was written to be used for unit interface and was expanded to
    work with program and implementation too. It does nearly no seperate
    things for programs, they are adapted to the unit scheme (see main).

    The order will change in following case:
     -function with forward declaration (also overloading etc.)


  Inheritance (only the important ones):

    TInterfaceSection, TImplementationSection, TProgramSection
     |
    TPasSection
     |
    TPasDeclarations
     |
    TPasElement
     |
    TPasElementBase
     |
    TObject

    TInitializationSection, TFinalizationSection
     |
    TPasImplBlock
     |
    TPasImplElement
     |
    TPasElement
     |
    TPasElementBase
     |
    TObject

    TPasProgram
     |
    TPasModule
     |
    TPasElement
     |
    TPasElementBase
     |
    TObject

  Dependance Structure :

    TPasPackage = class(TPasElement)
      |
    Modules: TFPList;

    TPasModule = class(TPasElement)
      |-InterfaceSection: TInterfaceSection;
      |  |-Declarations -> forward part, unit only
      |
      |-ImplementationSection: TImplementationSection;
      |  |-Declarations -> full declaration, unit and program
      |     |-Functions: TFPList;
      |        |-TPasFunction = class(TPasProcedureBase)
      |           |-Body: TProcedureBody;
      |              |-Declarations -> declaration and sub function
      |              |-Body: TPasImplBlock; -> procedure block
      |
      |-InitializationSection: TInitializationSection;
      |  |-TPasImplBlock.Elements: TFPList; -> main block
      |
      |-FinalizationSection: TFinalizationSection;
         |-TPasImplBlock.Elements: TFPList; -> unit only

    Declarations = class(TPasElement)
      |-Declarations: TFPList; -> the following are all in here
      |-ResStrings: TFPList;
      |-Types: TFPList;
      |-Consts: TFPList;
      |-Classes: TFPList;
      |-Functions: TFPList;
      |-Variables: TFPList;
      |-Properties: TFPList;
    }


program test_parser1;
{$mode objfpc}{$H+}

uses SysUtils, Classes, PParser, PasTree;

//# types the parser needs

type
  { We have to override abstract TPasTreeContainer methods.
    See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
    a "real" engine. }
  TSimpleEngine = class(TPasTreeContainer)
  public
    function CreateElement(AClass: TPTreeElement; const AName: String;
      AParent: TPasElement; AVisibility: TPasMemberVisibility;
      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
      override;
    function FindElement(const AName: String): TPasElement; override;
  end;

function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String;
  AParent: TPasElement; AVisibility: TPasMemberVisibility;
  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
begin
  Result := AClass.Create(AName, AParent);
  Result.Visibility := AVisibility;
  Result.SourceFilename := ASourceFilename;
  Result.SourceLinenumber := ASourceLinenumber;
end;

function TSimpleEngine.FindElement(const AName: String): TPasElement;
begin
  { dummy implementation, see TFPDocEngine.FindElement for a real example }
  Result := nil;
end;


//# main var
var
  M: TPasModule;
  E: TPasTreeContainer;
  I: Integer;
  cmdl, TargetOS, TargetCPU : string;
  isim, //is Impleamentation, only for GetTPasProcedureBody
  Unformated:boolean; // no Formating in output
  

//# tools

 function GetIndent(indent:integer):String;
   var i:integer;
  begin
   Result:='';
   if not Unformated then 
      for i:=1 to indent do Result:=Result+' ';
  end;

 //delete ugly quoting '''STRING'''
 function DelQuot(s:String):String;
    var i:integer;
    const s1=#39#39#39;
   begin
    Result:='';
    i:=pos(s1,s);
    while i > 0 do
     begin
      if i > 0 then delete(s,i,2);
      i:=pos(s1,s);
     end; 
    //if i > 0 then delete(s,i,2);
    Result:=s;
   end;

 //LeadingSpace only valid if Formated output (as this will be one line in output)
 //UnFormated: all is printed in a new line
 procedure WriteFmt(LeadingSpace:boolean; s:String; Semicolon:boolean);
  begin
   if Semicolon then s:=s+';';
   if Unformated then writeln(s)
    else if LeadingSpace then write(' ',s)
     else write(s);
  end;

//# parsing output

function GetTPasImplBlock(lb:TPasImplBlock; indent,declistby:integer;
                           LastNoSem,NoFirstIndent:boolean):boolean; forward;

function GetTPasImplElement(le:TPasImplElement; lindent:integer;
                             lLastNoSem,NoFirstIndent:boolean):boolean; forward;

procedure GetDecls(Decl:TPasDeclarations; indent:integer); forward;
//procedure PrintDecls(Decl:TPasDeclarations; indent:integer); forward;

//# most is for implementation or implblocks except the expr things

function ReturnTPasMemberHints(h:TPasMemberHints):String;
 begin
  Result:='';
  if hDeprecated    in h then Result:=' deprecated'; 
  if hLibrary       in h then Result:=Result+' library';
  if hPlatform      in h then Result:=Result+' platform';
  if hExperimental  in h then Result:=Result+' experimental';
  if hUnimplemented in h then Result:=Result+' unimplemented';
 end;      
   
function GetTPasMemberHints(h:TPasMemberHints):Boolean;
 begin
  Result:=false;
  if hDeprecated in h then begin write(' deprecated'); Result:=true; end;
  if hLibrary in h then begin write(' library'); Result:=true; end;
  if hPlatform in h then begin write(' platform'); Result:=true; end;
  if hExperimental in h then begin write(' experimental'); Result:=true; end;
  if hUnimplemented in h then begin write(' unimplemented'); Result:=true; end;
 end;   




function GetTPasExprKind(lpek:TPasExprKind):String;
 begin
  Result:='';
  case lpek of
    pekIdent:Result:='ID';
    pekNumber:Result:='NUMBER';
    pekString:Result:='STRING';
    pekSet:Result:='SET';
    pekNil:Result:='NIL';
    pekBoolConst:Result:='BOOL';
    pekRange:Result:='RANGE';
    pekUnary:Result:='UNARY';
    pekBinary:Result:='BINARY';
    pekFuncParams:Result:='FUNCPAR';
    pekArrayParams:Result:='ARRAYPAR';
    pekListOfExp:Result:='EXPLIST';
  end;
 end;

procedure GetTPasExpr(lex:TPasExpr);
 var lex1:TpasExpr;
     lpe:TParamsExpr;
     l:integer;
     lbk,rbk,sep:string;
     lav:TArrayValues;
     lrv:TRecordValues;
     rvi:TRecordValuesItem;


 function GetExpKind(ek:TPasExprKind; var lbrak,rbrak:string):string;
  begin
   lbrak:='';
   rbrak:='';
   Result:='';
   case ek of
    pekIdent:Result:='ID';
    pekNumber:Result:='NU';
    pekString:begin lbrak:=#39; rbrak:=#39; Result:=#39; end;
    pekSet:begin lbrak:='['; rbrak:=']'; Result:=','; end;
    pekNil:Result:='NIL';
    pekBoolConst:Result:='';
    pekRange:Result:='..';
    pekUnary:Result:='';
    pekBinary:Result:='';
    pekFuncParams:begin lbrak:='('; rbrak:=')'; Result:=','; end;
    pekArrayParams:begin lbrak:='['; rbrak:=']'; Result:=','; end;
    pekListOfExp:Result:=',';
    pekInherited:Result:=' InheriteD';
    pekSelf:Result:=' SelF';
   end;
  end;

 function GetOp(lop:TExprOpCode):string;
  begin
   Result:='';
   case lop of
    eopNone:Result:='';
    eopAdd:Result:='+';
    eopSubtract:Result:='-';
    eopMultiply:Result:='*';
    eopDivide:Result:='/';
    eopDiv:Result:=' div ';
    eopMod:Result:=' mod ';
    eopPower:Result:='^';
    eopShr:Result:=' shr ';
    eopSHl:Result:=' shl ';
    eopNot:Result:=' not ';
    eopAnd:Result:=' and ';
    eopOr:Result:=' or ';
    eopXor:Result:=' xor ';
    eopEqual:Result:='=';
    eopNotEqual:Result:='<>';
    eopLessThan:Result:='<';
    eopGreaterThan:Result:='>';
    eopLessthanEqual:Result:='<=';
    eopGreaterThanEqual:Result:='>=';
    eopIn:Result:=' in ';
    eopIs:Result:=' is ';
    eopAs:Result:=' as ';
    eopSymmetricaldifference:Result:='><';
    eopAddress:Result:='@';
    eopDeref:Result:='^';
    eopSubIdent:Result:='.';
   end;
  end;

 begin
  if lex is TBinaryExpr then //compined constants
   begin
    sep:=GetExpKind(lex.Kind,lbk,rbk);
    //write('|');
    write(lbk);
    GetTPasExpr(TBinaryExpr(lex).left);
    write(GetOp(TBinaryExpr(lex).OpCode));
    write(sep);
    GetTPasExpr(TBinaryExpr(lex).right);
    write(rbk);
    //write('|');
    //write(' [',lex.Name,' ',GetTPasExprKind(lex.Kind),']');
   end
    else
     begin
      //write('UNARY');
      if lex is TUnaryExpr then
       begin
        lex1:=TUnaryExpr(lex).Operand;
        if lex.OpCode = eopDeref then
         begin
          GetTPasExpr(lex1);
          write(GetOp(lex.OpCode)); //unary last, only: p^
         end
        else
         begin
          write(GetOp(lex.OpCode)); //unary first: -1
          GetTPasExpr(lex1);
         end;
       end;
      if lex is TPrimitiveExpr then write(TPrimitiveExpr(lex).Value) //simple constant
      else
      if lex is TBoolConstExpr then write(TBoolConstExpr(lex).Value)
      else
      if lex is TNilExpr then write('nil')
      else
      if lex is TInheritedExpr then write('Inherited ')
      else
      if lex is TSelfExpr then write('Self')
      else
      if lex is TParamsExpr then //writeln(param1,param2,..,paramn);
        begin
         //write(' PAREX ');
         lpe:=TParamsExpr(lex);
         GetTPasExpr(lpe.Value);
         if length(lpe.Params) >0 then
          begin
           sep:=GetExpKind(lpe.Kind,lbk,rbk);
           write(lbk); //write('(');
           for l:=0 to High(lpe.Params)-1 do
            begin
             GetTPasExpr(lpe.Params[l]);
             write(sep); //seperator
            end;
           GetTPasExpr(lpe.Params[High(lpe.Params)]);
           write(rbk);//write(')');
          end
         else
          begin //funcion()
           sep:=GetExpKind(lpe.Kind,lbk,rbk);
           write(lbk,rbk);
          end;
        end
      else if lex is TArrayValues then  //const AnArrayConst: Array[1..3] of Integer = (1,2,3);
        begin
         write('(');
         lav:=TArrayValues(lex);
         if length(lav.Values) > 0 then
          begin
           for l:=0 to high(lav.Values)-1 do
            begin
             GetTPasExpr(TPasExpr(lav.Values[l]));
             write(',');
            end;
           GetTPasExpr(TPasExpr(lav.Values[high(lav.Values)]));
          end;
         write(')');
        end
      else if lex is TRecordValues then
        begin
         write('(');
         lrv:=TRecordValues(lex);
         if length(lrv.Fields) > 0 then
          begin
           for l:=0 to high(lrv.Fields)-1 do
            begin
             rvi:=TRecordValuesItem(lrv.Fields[l]);
             write(rvi.Name,':');
             GetTPasExpr(rvi.ValueExp);
             write(';');
            end;
           rvi:=TRecordValuesItem(lrv.Fields[high(lrv.Fields)]);
           write(rvi.Name,':');
           GetTPasExpr(rvi.ValueExp);
          end;
         write(')');
        end
      else
       begin
        //?
        //writeln('{ Unknown Expression: ');
        //if assigned(lex) then GetTPasExprKind(lex.Kind);
        //writeln('}');
       end;
     end;
 end;


//NoFirstIndent only for block in case:
procedure GetTPasSmt(lsmt:TPasImplStatement; lindent:integer; DoNoSem,NoFirstIndent:boolean);
 var l:integer;
     lics:TPasImplCaseStatement;
     DoSem:boolean;
     liwd:TPasImplWithDo;
     liwhd:TPasImplWhileDo;
     lieo:TPasImplExceptOn;
     lifl:TPasImplForLoop;
     lir:TPasImplRaise;
      s,s1:String;//s1 only first line of block statement

begin
  DoSem:=true;
  s:=GetIndent(lindent);
  if NoFirstIndent then s1:=' ' else s1:=s;
  if lsmt is TPasImplSimple then
    begin
     write(s1); GetTPasExpr(TPasImplSimple(lsmt).expr);
     //DoSem:=true;
    end
   else if lsmt is TPasImplAssign then
    begin
     write(s1); GetTPasExpr(TPasImplAssign(lsmt).left);
     write(':= ');
     GetTPasExpr(TPasImplAssign(lsmt).right);
     //DoSem:=true;
    end
   else if lsmt is TPasImplCaseStatement then
    begin
     lics:=TPasImplCaseStatement(lsmt);
     if lics.Expressions.Count>0 then
      begin
       write(s);
       for l:=0 to lics.Expressions.Count-2 do
          write(DelQuot(lics.Expressions[l]),',');
       write(DelQuot(lics.Expressions[lics.Expressions.Count-1]),': '); // !!bug too much ' in expression
       //if not assigned(lics.Body) then writeln('TPasImplCaseStatement missing BODY');
       //if assigned(lics.Body) and (TPasImplBlock(lics.Body).Elements.Count >0) then
       //  GetTPasImplBlock(TPasImplBlock(lics.Body),lindent+1,0,false,true)
       //    else GetTPasImplBlock(TPasImplBlock(lics),lindent+1,0,false,true);  // !!bug missing body, assigned but empty
        if assigned(lics.Body) then
         begin
          if not GetTPasImplElement(lics.Body,lindent+1,false,true) then ;//writeln(';');
         end
          else writeln(';');
      end;
     DoSem:=false;
    end
   else if lsmt is TPasImplWithDo then
    begin
     liwd:=TPasImplWithDo(lsmt);   // !!Bug: missing with do at following with do !solved see Bug
     write(s1,'with ',liwd.Name);
     if liwd.Expressions.Count>0 then
      begin
       for l:=0 to liwd.Expressions.Count-2 do
         write(liwd.Expressions[l],',');
       write(liwd.Expressions[liwd.Expressions.Count-1]);
      end;
     writeln(' do');
     //if TPasImplBlock(liwd.Body).Elements.Count >0  then
       //GetTPasImplBlock(TPasImplBlock(liwd.Body),0); // !!Bug: BODY Not used
       //else
     GetTPasImplBlock(TPasImplBlock(liwd),lindent+1,0,false,false);
     DoSem:=false;
    end
   else if lsmt is TPasImplWhileDo then
    begin
     liwhd:=TPasImplWhileDo(lsmt);
     writeln(s1,'while ',DelQuot(liwhd.Condition),' do');
     //if not GetTPasImplBlock(TPasImplBlock(liwhd.Body),0) then // !!Bug: BODY Not used
     GetTPasImplBlock(TPasImplBlock(liwhd),lindent,0,DoNoSem,false); //OK for all constructs
     DoNoSem:=false; //?
     DoSem:=false;
    end
   else if lsmt is TPasImplExceptOn then
    begin
     lieo:=TPasImplExceptOn(lsmt);
     writeln(s,'on ',lieo.VariableName,': ',lieo.TypeName,' do');
     if TPasImplBlock(lieo.Body) is TPasImplRaise then
      begin
       write(s,'raise ');//raise is in TPasImplBlock in this case
       GetTPasImplBlock(TPasImplBlock(lieo.Body),lindent+1,0,false,true);
      end
       else GetTPasImplBlock(TPasImplBlock(lieo.Body),lindent+1,0,false,false);
     DoSem:=false;
    end
   else if lsmt is TPasImplForLoop then
    begin
     lifl:=TPasImplForLoop(lsmt);
     //TODO variable
     write(s1,'for ',lifl.VariableName,':= ',lifl.StartValue,' ');
     if lifl.Down then write('down');
     writeln('to ',lifl.EndValue,' do');
     GetTPasImplBlock(TPasImplBlock(lifl),lindent+1,0,false,false);
     DoSem:=false;
    end
   else if lsmt is TPasImplRaise then
    begin
     write(s1,'raise ');
     lir:=TPasImplRaise(lsmt);
     if not GetTPasImplBlock(TPasImplBlock(lir),lindent,0,DoNoSem,true) then
      writeln(';');
     DoNoSem:=false;
     DoSem:=false;
    end
   else
    begin
     if assigned(lsmt.Elements) then
      begin
       writeln('{ Unknown SMT(s): '); //,lsmt.Name,' ',lsmt.ElementTypeName);
       for l:=0 to lsmt.Elements.Count-1 do
         write(s,' SMT ',l,' ',TPasElement(lsmt.Elements[l]).Name);
       writeln('}');
      end;
     DoSem:=false;
    end;
  if not DoNoSem then
   begin
    if DoSem then writeln(';');
   end
    else writeln;
end;


 //result: result of TPasImplBlock or valid element
 //NoFirstIndent only for block in case:
 function GetTPasImplElement(le:TPasImplElement; lindent:integer;
                             lLastNoSem,NoFirstIndent:boolean):boolean;
  var liie:TPasImplIfElse;
      lico:TPasImplCaseOf;
      lice:TPasImplCaseElse;
      liru:TPasImplRepeatUntil;
      lit:TPasImplTry;
      //lic:TPasImplCommand;
      s,s1:String;//s1 only first line of block statement

begin
  Result:=true;
  s:=GetIndent(lindent);
  if NoFirstIndent then s1:=' ' else s1:=s;
    if le is TPasImplStatement then
      begin
       if NoFirstIndent then lindent:=0;
       GetTPasSmt(TPasImplStatement(le),lindent+1,lLastNoSem,NoFirstIndent);
      end
     else if le is TPasImplIfElse then
      begin
       liie:=TPasImplIfElse(le);
       write(s1,'if ',DelQuot(liie.Condition),' then ');
       if assigned(liie.ElseBranch) then
        begin
         writeln;
         GetTPasImplElement(liie.IfBranch,lindent+1,true,false);
         writeln(s,'else');// {if}');
         GetTPasImplElement(liie.ElseBranch,lindent+1,lLastNoSem,false);
        end
       else
        begin //no else part
         if assigned(liie.IfBranch) then
          begin
           writeln;
           if not GetTPasImplElement(liie.IfBranch,lindent+1,false,false) then
             writeln(';');
          end
           else writeln(';'); //empty if then;
        end;
      end
     else if le is TPasImplCaseOf then
      begin
       lico:=TPasImplCaseOf(le);
       writeln(s1,'case ',lico.Expression,' of ');
       if assigned(lico.ElseBranch) then //workaround duplicate bug
        begin                            //reduce count of CaseOf as CaseElse is in there
         lice:=lico.ElseBranch;
         GetTPasImplBlock(TPasImplBlock(lico),lindent+1,1,false,false);
        end
          else GetTPasImplBlock(TPasImplBlock(lico),lindent+1,0,false,false); // !! else duplicate in here
       if assigned(lico.ElseBranch) then
        begin
         writeln(s,'else');//' {case}');
         lice:=lico.ElseBranch;
         GetTPasImplBlock(TPasImplBlock(lice),lindent+1,0,false,false);
        end;
       if lLastNoSem then writeln(s,'end')//' {case}')
        else writeln(s,'end;');// {case}');
       //Result:=false; ??? GetTPasImplBlock
      end
     else if le is TPasImplRepeatUntil then
      begin
        liru:=TPasImplRepeatUntil(le);
        writeln(s1,'repeat');
        GetTPasImplBlock(TPasImplBlock(liru),lindent+1,0,false,false);
        write(s,'until ',DelQuot(liru.Condition));
        if lLastNoSem then writeln
         else writeln(';');
      end
     else if le is TPasImplTryFinally then
      begin
       writeln(s,'finally');
       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
      end
     else if le is TPasImplTryExcept then
      begin
       writeln(s,'except');
       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
      end
     else if le is TPasImplTryExceptElse then
      begin
       writeln(s,'else');// {try}');
       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
      end
     else if le is TPasImplTry then
      begin
       lit:=TPasImplTry(le);
       writeln(s1,'try');
       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
       if assigned(lit.FinallyExcept) then
          GetTPasImplElement(TPasImplElement(lit.FinallyExcept),lindent+1,false,false);
       if assigned(lit.ElseBranch) then
          GetTPasImplElement(TPasImplElement(lit.ElseBranch),lindent+1,false,false);
       if lLastNoSem then writeln(s,'end')// {try} ') //there is no ImplBeginBlock
        else writeln(s,'end;');// {try} ');
      end
     else if le is TPasImplCommand then
      begin
       //ignore because empty
       // lic:=TPasImplCommand(le);
       // writeln(' CMD ',lic.Command,' ',lic.Name,' ',lic.ElementTypeName);
      end
     else if le is TPasImplLabelMark then
      begin
       writeln(s1,'label ',TPasImplLabelMark(le).LabelId,';');
      end
     else if le is TPasImplBlock then
      begin
       //IfElse, case:
       Result:=GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,lLastNoSem,NoFirstIndent);
      end
     else
      begin
       Result:=false;
       //writeln(s,';');
       //writeln(' EL ',l);//,' ',le.Name)//,' ',le.ElementTypeName,' ',le.FullName);
      end;
 end;
     
// indent: indent from page left side
// DecListBy: dec(elements.count) because of case duplicate else bug
// LastNoSem: only true on last expr before else in a if clause
// NoFirstIndent: if line was started by other block like in case at -> 1:Noindent;
// Result: true if elements not empty
function GetTPasImplBlock(lb:TPasImplBlock; indent,declistby:integer;
                           LastNoSem,NoFirstIndent:boolean):boolean;
   var l,n:integer;
       lbe:TPasImplElement;
       NoSem:boolean;
       ls:String;     

begin
  Result:=false;
  NoSem:=false;
  ls:=GetIndent(indent);
  if not assigned(lb) then exit;
  //if lb is TPasImplRaise then writeln('RAISE');
  if assigned(lb.Elements) then
   begin
    if lb is TPasImplBeginBlock then
     begin
      NoSem:=LastNoSem;
      LastNoSem:=false;
      if NoFirstIndent then
       begin
        writeln('begin');////NFI');
        NoFirstIndent:=false;
       end
        else writeln(ls,'begin');
      inc(indent);
     end;

    if lb.Elements.Count >0 then
     begin
      Result:=true;
      n:=lb.Elements.Count-1;
      //workaround CaseOf duplicate bug
      if (declistby >0)and(lb.Elements.Count >declistby) then dec(n,declistby);
      for l:=0 to n do
       begin
        lbe:=TPasImplElement(lb.Elements[l]);
        //write(l:2,'/',n:2,' '); //No of curent element, max element
        if ((l = 0)and NoFirstIndent) then
         begin //index0
          if l=n then GetTPasImplElement(lbe,0,LastNoSem,false)
           else GetTPasImplElement(lbe,0,false,false)
         end
        else if l<>n then GetTPasImplElement(lbe,indent,false,false) //other index
        else GetTPasImplElement(lbe,indent,LastNoSem,false); //indexn
       end;
     end
    else
     begin //block is empty
      //write(ls,' {!EMPTY!}');
       {if not NoSem then
        begin
         if lb is TPasImplBeginBlock then writeln //empty compound need no ;
          else writeln(';')
        end
         else
          writeln;}
     end;
    if lb is TPasImplBeginBlock then
      if not NoSem then writeln(ls,'end;')// {Block}') 
        else writeln(ls,'end');// {Block}');
   end
    else
      writeln(';'); //writeln(' {!empty!};')
end;


//# Declarations (type,var,const,..)

procedure GetTPasArrayType(lpat:TPasArrayType);
 begin
  if lpat.IsPacked then write('packed ');
  write('Array');
  if lpat.IndexRange <> '' then write('[',lpat.IndexRange,']');
  if assigned(lpat.ElType) then write(' of ',lpat.ElType.Name);
   // BUG: of const missing in Procedure ConstArrayArgProc(A: Array of const); pparser: 643
 end;

//write out one variable or constant declaration, also used in types
//In spite of the use of GetPasVariables this is still used !
procedure GetTPasVar(lpv:TPasVariable; lindent:integer; NoLF:boolean);//BUG string[] pparser: 482
   var i,j:integer;
       //lppt:TPasProcedureType;
       //lpa:TPasArgument;
       //lpat:TPasArrayType;
       s,s1:string;
       prct:TPasRecordType;

  begin
   if not Assigned(lpv) then exit;
   s:=GetIndent(lindent);
   write(s,lpv.Name);//,'  ',lpv.value,' ',lpv.Modifiers,' ',lpv.AbsoluteLocation);
   if assigned(lpv.VarType) then
     begin
       //if TPasType(lpa.ArgType).ElementTypeName <>'unresolved type reference' then
       //,TPasType(lpa.ArgType).Name,' ');//,TPasType(lpa.ArgType).FullName,TPasType(lpa.ArgType).ElementTypeName)
       // PParser 2099: ArgType := nil; if IsUntyped then => Arg.ArgType := ArgType;
       //     else write(':? ');
       write(': ');
       if lpv.VarType is TPasArrayType then
        begin
         GetTPasArrayType(TPasArrayType(lpv.VarType));
        end
       else if lpv.VarType is TPasSetType then
        begin
         write('set of ',TPasSetType(lpv.VarType).EnumType.Name);
        end
       else
        begin
          if lpv.VarType is TPasPointerType then
                write('^',TPasPointerType(lpv.VarType).DestType.Name)
          else if lpv.VarType is TPasRecordType then //var record
           begin
            j:=lindent+Length(lpv.Name)+4;
            s1:=GetIndent(j);
            prct:=TPasRecordType(lpv.VarType);
            if prct.IsBitPacked then write('bitpacked ');
            if prct.IsPacked then write('packed ');
            writeln('Record');
            for i:=0 to prct.Members.Count-1 do
             begin
              GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
             end;
            write(s1,'end');
           end
          else
           begin
            write(TPasType(lpv.VarType).Name);
            //if TPasType(lpv.VarType) is TPasAliasType then write(TPasAliasType(lpv.VarType).Name);
           end;
        end;
     end;
   if lpv.Value <> '' then write('=',lpv.Value);
   if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
     begin
      write('=');
      GetTPasExpr(lpv.Expr);
     end;
     
   if lpv.Modifiers <>'' then //Modifiers starts with ;
    begin
     write(' ',lpv.Modifiers,';');
     if GetTPasMemberHints(lpv.Hints) then write(';');
    end
   else
    begin
     GetTPasMemberHints(lpv.Hints);
     write(';');
    end;
   if not NoLF then writeln;
  end;
  
//write out a list of variables only
//more compact than the output of seperate calls of GetTPasVar
procedure GetPasVariables(vl:TFPList; lindent:integer; NoLF,NoSEM:boolean);
   var v,i,j:integer;
       s,s1:string;
       prct:TPasRecordType;
       lpv:TPasVariable;
       
       same:boolean;
       samestr,tmpstr:Ansistring;
       samevar:array of integer;
       svi:integer;

  begin
   if vl.Count <= 0 then exit; 
   s:=GetIndent(lindent);
   //> compare all variable types as string to find the ones with same type
   samestr:='';
   svi:=0;
   SetLength(samevar,vl.count);
   for v:=0 to vl.count-1 do
    begin
     tmpstr:=''; 
     same:=true;   
     lpv:=TPasVariable(vl[v]);
     //write(s,lpv.Name);
     if assigned(lpv.VarType) then
      begin
       tmpstr:=tmpstr+': ';
       if lpv.VarType is TPasArrayType then
         begin
          //GetTPasArrayType(TPasArrayType(lpv.VarType));
          tmpstr:=tmpstr+'array'+TPasArrayType(lpv.VarType).IndexRange;
          if assigned(TPasArrayType(lpv.VarType).ElType) then
           tmpstr:=tmpstr+TPasArrayType(lpv.VarType).ElType.Name;
         end
       else if lpv.VarType is TPasSetType then
         begin
          tmpstr:=tmpstr+'set of '+TPasSetType(lpv.VarType).EnumType.Name;
         end
       else
        begin
         if lpv.VarType is TPasPointerType then
            tmpstr:=tmpstr+'^'+TPasPointerType(lpv.VarType).DestType.Name
         else if lpv.VarType is TPasRecordType then //var record
           begin
            prct:=TPasRecordType(lpv.VarType);
            if prct.IsBitPacked then tmpstr:=tmpstr+'bitpacked ';
            if prct.IsPacked then tmpstr:=tmpstr+'packed ';
            tmpstr:=tmpstr+'Record ';
            for i:=0 to prct.Members.Count-1 do
             begin
              //todo
              //GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
             end;
            tmpstr:=tmpstr+'end';
           end
         else
          begin
            tmpstr:=tmpstr+TPasType(lpv.VarType).Name;
          end;
        end;
      end
        else same:=false;
     if lpv.Value <> '' then same:=false;//=
     if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
      begin
       same:=false;//=
      end;
     if lpv.Modifiers <>'' then //Modifiers starts with ;
      begin
       tmpstr:=tmpstr+' '+lpv.Modifiers+';';
       tmpstr:=tmpstr+ReturnTPasMemberHints(lpv.Hints);
      end
     else
      begin
       tmpstr:=tmpstr+ReturnTPasMemberHints(lpv.Hints);
      end;
  //if v = 0 then begin samestr:=tmpstr; end;
     if (not same)or(samestr <> tmpstr) then
       begin
        samestr:=tmpstr;
        inc(svi);
       end;
     samevar[v]:=svi;
   end;
   //compare <
   //now print them
   svi:=-1; 
   for v:=0 to vl.count-1 do
    begin
     lpv:=TPasVariable(vl[v]);
     if not Assigned(lpv) then continue;
     if svi <> samevar[v] then
       begin
        svi:=samevar[v];
        if v>0 then writeln;
        write(s,lpv.Name);//variblenname
       end
        else write(lpv.Name);
     if (v < vl.Count-1)and(samevar[v+1]=svi) then write(',')
      else
       begin
        if assigned(lpv.VarType) then
         begin
           write(': ');
           if lpv.VarType is TPasArrayType then
            begin
             GetTPasArrayType(TPasArrayType(lpv.VarType));
            end
           else if lpv.VarType is TPasSetType then
            begin
             write('set of ',TPasSetType(lpv.VarType).EnumType.Name);
            end
           else
            begin
             if lpv.VarType is TPasPointerType then
                write('^',TPasPointerType(lpv.VarType).DestType.Name)
             else if lpv.VarType is TPasRecordType then //var record
              begin
               j:=lindent+Length(lpv.Name)+4;
               s1:=GetIndent(j);
               prct:=TPasRecordType(lpv.VarType);
               if prct.IsBitPacked then write('bitpacked ');
               if prct.IsPacked then write('packed ');
               writeln('Record');
               {for i:=0 to prct.Members.Count-1 do
                 begin
                  GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
                 end;}
               if prct.Members.Count > 0 then
                 GetPasVariables(prct.Members,j+1,false,false);
               write(s1,'end');
              end
             else
              begin
               write(TPasType(lpv.VarType).Name);
              end;
            end;
         end;
        if lpv.Value <> '' then write('=',lpv.Value);
        if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
         begin
          write('=');
          GetTPasExpr(lpv.Expr);
         end;

        if lpv.Modifiers <>'' then //Modifiers starts with ;
         begin
          write(' ',lpv.Modifiers,';');
          if GetTPasMemberHints(lpv.Hints) then write(';');
         end
        else
         begin
          GetTPasMemberHints(lpv.Hints);
          if (v < vl.Count-1) then write(';')
            else if (not NoSEM) then write(';');
         end;
	   //if not NoLF then writeln;
       end;
     end;
    if not NoLF then writeln;
  end;  
  
function GetTPasArgumentAccess(acc:TArgumentAccess):String;

begin
  Result:='';
  case acc of
    //argDefault:Result:='default'; //normal proccall is default
    argConst:Result:='const';
    argVar:Result:='var';
    argOut:Result:='out';
  end;
end;

procedure GetTPasProcedureType(lppt:TPasProcedureType; indent:integer);

Var
  l : integer;
  lpa:TPasArgument;
  samevar:array of integer;//same index same type
  aktaa:TArgumentAccess;
  svi:integer;
  same:boolean;
  aktname,tmpname:String;

begin
  if assigned(lppt.Args) and (lppt.Args.Count > 0) then
    begin
    write('(');
    if lppt.Args.Count > 0 then
     begin
      //produce more compact output than the commented block below
      //>find same declaration
      //look ahead what is the same
      SetLength(samevar,lppt.Args.Count);
      svi:=0;
      aktname:='';
      for l:=0 to lppt.Args.Count-1 do
       begin
        same:=true;
        tmpname:='';
        lpa:=TPasArgument(lppt.Args.Items[l]);
        if assigned(lpa.ArgType) then
         begin
          if lpa.ArgType is TPasArrayType then
           begin
             if assigned(TPasArrayType(lpa.ArgType).ElType) then tmpname:=TPasArrayType(lpa.ArgType).ElType.Name;
           end
            else tmpname:=TPasType(lpa.ArgType).Name;
         end;
        if l=0 then begin aktaa:=lpa.Access; aktname:=tmpname; end;
        if lpa.Access <> aktaa then begin same:=false; aktaa:=lpa.Access; end;//access type
        if (tmpname = '')or(tmpname <> aktname) then begin same:=false; aktname:=tmpname; end;//type name
        if lpa.Value <> '' then same:=false;//var=value
        if not same then inc(svi);
        samevar[l]:=svi;
       end;
     //find same declaration<
     svi:=-1;
     same:=false;
     for l:=0 to lppt.Args.Count-1 do
      begin
       lpa:=TPasArgument(lppt.Args.Items[l]);
       if svi <> samevar[l] then
        begin
         svi:=samevar[l];
         if lpa.Access <> argDefault then write(GetTPasArgumentAccess(lpa.Access),' ');
         write(lpa.Name);//variblenname
        end
          else write(lpa.Name);
       if (l < lppt.Args.Count-1)and(samevar[l+1]=svi) then write(',')
        else
         begin
          if assigned(lpa.ArgType) then
           begin
            write(': ');
            if lpa.ArgType is TPasArrayType then
             GetTPasArrayType(TPasArrayType(lpa.ArgType))
              else write(TPasType(lpa.ArgType).Name);
           end;
          if lpa.Value <> '' then write('=',lpa.Value);
          if l< lppt.Args.Count-1 then write('; ');
        end;
      end;
    write(')');
    end;
    end;
  if (lppt is TPasFunctionType) then
      write(': ',TPasFunctionType(lppt).ResultEl.ResultType.Name);
  if lppt.IsOfObject then
    write(' of Object');
end;

procedure GetTypes(pe:TPasElement; lindent:integer);
  var i,j,k:integer;
      s,s1,s2:string;
      pet:TPasEnumType;
      pev:TPasEnumValue;

      prt:TPasRangeType;
      prct:TPasRecordType;
      pv:TPasVariant;
      pst:TPasSetType;


  function GetVariantRecord(pe:TPasElement; lindent:integer):boolean;
    var i,j,k:integer;
        prct:TPasRecordType;
        pv:TPasVariant;
        s,s1:string;

   begin
    Result:=false;
    j:=lindent+Length(pe.Name)+2;
    s:=GetIndent(lindent);
    s1:=GetIndent(lindent+2);
    prct:=TPasRecordType(pe);
    {Now i use GetPasVariables for more compact output
     for i:=0 to prct.Members.Count-1 do
     begin
      GetTPasVar(TPasVariable(prct.Members[i]),1,true);
     end;}
    if prct.Members.Count > 0 then GetPasVariables(prct.Members,1,true,true);  
    if assigned(prct.Variants) then
     begin
      Result:=true;
      writeln(';');
      write(s,'case ');
      if prct.VariantName <>'' then write(prct.VariantName,'=');
      write(TPasType(prct.VariantType).Name);
      writeln(' of');
      if assigned(prct.Variants)then
       if prct.Variants.Count >0 then
        begin
         for i:=0 to prct.Variants.Count-1 do
          begin
           pv:=TPasVariant(prct.Variants[i]);
           write(s1,pv.Name);
           for k:=0 to pv.Values.Count-1 do write(pv.Values[k]);
           write(': (');
           if GetVariantRecord(TPasElement(pv.Members),j+1) then
             writeln(s1,');')
              else writeln(');');
          end;
        end;
     end;
   end;

 begin
  s:=GetIndent(lindent);
  write(s,pe.Name,'=');
  if pe is TPasArrayType then
   begin
     GetTPasArrayType(TPasArrayType(pe));
     writeln(';');
   end
  else if pe is TPasEnumType then
   begin
    pet:=TPasEnumType(pe);
    write('(');
    if pet.Values.Count > 0 then
     begin
      for j:=0 to pet.Values.Count-2 do
       begin
        pev:=TPasEnumValue(pet.Values[j]);
        write(pev.name,',');
        //pev.Value ?
        //pev.AssignedValue ?
        //pev.IsValueUsed ?
       end;
      pev:=TPasEnumValue(pet.Values[pet.Values.Count-1]);
      write(pev.name);
     end;
    writeln(');');
   end
  else if pe is TPasFileType then
   begin
    writeln('file of ',TPasFileType(pe).ElType.Name,';');
   end
  else if pe is TPasProcedureType then
   begin
   if pe is TPasFunctionType then
     Write('function ')
   else
     Write('procedure ');
   GetTPasProcedureType(TPasProcedureType(pe), lindent);
   Writeln(';');
   end
  else if pe is TPasPointerType then
   begin
    //writeln('pointer');
    writeln('^',TPasPointerType(pe).DestType.Name,';');
   end
  else if pe is TPasRangeType then
   begin
    prt:=TPasRangeType(pe);
    writeln(prt.RangeStart,'..',prt.RangeEnd,';');
   end
  else if pe is TPasRecordType then
   begin
    j:=lindent+Length(pe.Name)+2;
    s1:=GetIndent(j);
    s2:=GetIndent(j+1);
    prct:=TPasRecordType(pe);
    if prct.IsBitPacked then write('bitpacket ');
    if prct.IsPacked then write('packet');
    writeln('record');
    {Now i use GetPasVariables for more compact output
     for i:=0 to prct.Members.Count-1 do
     begin
      GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
     end;}
    GetPasVariables(prct.Members,j+2,false,false);
    if assigned(prct.Variants) then
     begin
      write(s1,'case ');
      if prct.VariantName <>'' then write(prct.VariantName,'=');
        write(TPasType(prct.VariantType).Name);
      writeln(' of');
      if assigned(prct.Variants)then
       if prct.Variants.Count >0 then
        begin
         for i:=0 to prct.Variants.Count-1 do
          begin
           pv:=TPasVariant(prct.Variants[i]);
           write(s2,pv.Name);
           for k:=0 to pv.Values.Count-1 do write(pv.Values[k]);
           write(': (');
           if GetVariantRecord(TPasElement(pv.Members),j+2) then
             writeln(s2,');')
              else writeln(');');
          end;
        end;
     end;
    writeln(s1,'end;');
   end
  else if pe is TPasSetType then
   begin
    pst:=TPasSetType(pe);
    writeln('set of ',pst.EnumType.Name,';');
   end
  else if pe is TPasClassOfType then writeln('Class of ',TPasClassOfType(pe).DestType.Name,';')
  else if pe is tPasAliasType then
    begin
    pe:=tPasAliasType(PE).DestType;
    write(PE.name);
    if pe is tPasStringType then
      begin
      if (TPasStringType(PE).LengthExpr<>'') then
        Write('[',TPasStringType(PE).LengthExpr,']');
      end;
    Writeln(';');
    end
  else if pe is tPasUnresolvedTypeRef then writeln(TPasUnresolvedTypeRef(PE).name,';')
  else
   begin
    
    writeln('{ Unknown TYPE(s): ');
    writeln(s,pe.Name,' ',pe.classname);
    writeln('}');
    writeln;
   end;
 end;



 procedure GetTCallingConvention(cc:TCallingConvention);  //TODO: test it
  begin
   case cc of
     //ccDefault:write(' default;'); //normal proccall is default
     ccRegister:WriteFmt(true,'Register;',false);
     ccPascal  :WriteFmt(true,'Pascal;',false);
     ccCDecl   :WriteFmt(true,'CDecl;',false);
     ccStdCall :WriteFmt(true,'StdCall;',false);
     ccOldFPCCall:WriteFmt(true,'OldFPCall;',false);
     ccSafeCall:WriteFmt(true,'SaveCall;',false);
   end;
  end;
  
 procedure GetHiddenModifiers(Mfs:TProcedureModifiers);
  begin
   if pmInline in Mfs then WriteFmt(true,'inline;',false);
   if pmAssembler in Mfs then WriteFmt(true,'assembler;',false);
   if pmVarargs in Mfs then WriteFmt(true,'varargs;',false);
   if pmCompilerProc in Mfs then WriteFmt(true,'compilerproc;',false);
   if pmExtdecl in Mfs then WriteFmt(true,'extdecl;',false);
  end; 

  procedure GetTPasProcedure(lpp:TPasProcedure; indent:integer);
   var l:integer;
       lppt:TPasProcedureType;
       s:String;
       

  begin
   if not Assigned(lpp) then exit;
   s:=GetIndent(indent);
   if lpp is TPasConstructor then write(s,'Constructor ')
    else if TPasElement(lpp) is TPasConstructorImpl then write(s,'Constructor ')
    else if lpp is TPasDestructor then write(s,'Destructor ')
    else if TPasElement(lpp) is TPasDestructorImpl then write(s,'Destructor ')
    else if lpp is TPasClassProcedure then write(s,'Class Procedure ') //pparser.pp: 3221
    else if lpp is TPasClassFunction then write(s,'Class Function ')
    else if lpp is TPasFunction then write(s,'Function ')
      else write(s,'Procedure ');
   write(lpp.Name);//,' ',lpp.TypeName);
   if assigned(lpp.ProcType) then
    begin
     lppt:=lpp.ProcType;
     GetTPasProcedureType(lppt,Indent);
    end;
   //writeln(';');
   WriteFmt(false,'',true);
   if lpp.IsVirtual then WriteFmt(true,'virtual;',false);
   if lpp.IsOverload then WriteFmt(true,'overload;',false);
   if lpp.IsAbstract then WriteFmt(true,'abstract;',false);
   if lpp.IsDynamic then WriteFmt(true,'dynamic;',false);
   if lpp.IsOverride then WriteFmt(true,'override;',false);
   if lpp.IsExported then WriteFmt(true,'exported;',false);
   if lpp.IsExternal then WriteFmt(true,'external;',false);
   //pparser 2360: everyting behind external is ignored !!!
   if lpp.IsMessage then
    begin
      write('message ');
      if lpp.MessageType = pmtString then writeln(false,lpp.MessageName,true)
       else WriteFmt(false,lpp.MessageName,true);//pmtInteger
    end;
   if lpp.IsReintroduced then WriteFmt(true,'reintroduce;',false);
   if lpp.IsStatic then WriteFmt(true,'static;',false);
   if lpp.IsForward then WriteFmt(true,'forward;',false);
   GetHiddenModifiers(lpp.Modifiers);
   GetTCallingConvention(lpp.CallingConvention);
   if GetTPasMemberHints(TPasElement(lpp).Hints) then WriteFmt(false,'',true); //BUG ? missing hints
   if not Unformated then writeln;
  end;

 procedure GetTPasProcedureBody(pb:TProcedureBody; indent:integer);
   var j:integer;
       pd:TPasDeclarations;
       pib:TPasImplBlock;
  begin
   if assigned(pb) then
    begin
     if assigned(pb.Body)then
      begin
       if assigned(TPasDeclarations(pb).Functions)then
        begin
         pd:=TPasDeclarations(pb);
         if isim then
          begin
           //writeln;
           GetDecls(pd,indent+1);     //~recursion
           //PrintDecls(pd,indent+1); //~recursion
          end
         else
          if pd.Functions.Count >0 then //sub-functions
           begin
            for j:=0 to pd.Functions.Count-1 do
              GetTPasProcedure(TPasProcedure(pd.Functions[j]),indent+1);
           end;
        end;
       pib:=TPasImplBlock(pb.Body);
       if assigned(pib) then
        begin
          GetTPasImplBlock(pib,indent,0,false,false); //indent depend on sub function level
          if not Unformated then writeln; //('//block');
        end;
      end;
    end;
  end;

 procedure GetTpasOverloadedProc(pop:TPasOverloadedProc; indent:integer);
   var pp:TPasProcedure;
       j:integer;
  begin
   if assigned(pop) then
    begin
     if pop.Overloads.Count >0 then
      begin
       for j:=0  to pop.Overloads.Count-1 do
        begin
         pp:=TPasProcedure(pop.Overloads[j]);
         GetTPasProcedure(pp,indent);
         GetTPasProcedureBody(pp.Body,indent);
        end;
      end;
    end;
  end;

 function GetVisibility(v:TPasMemberVisibility):String;
  begin
   Result:='';
   case v of
    //visDefault:Result:='default';
    visPrivate:Result:='private';
    visProtected:Result:='protected';
    visPublic:Result:='public';
    visPublished:Result:='published';
    visAutomated:Result:='automated';
    visStrictPrivate:Result:='strictprivate';
    visStrictProtected:Result:='strictprotected';
   end;
  end;

 procedure GetTPasClass(pc:TPasClassType; indent:integer);
   var j,l:integer;
       s,s1,s2:String;
       lpe:TPasElement;
       lpp:TPasProperty;
       lpa:TPasArgument;
       vis:TPasMemberVisibility;
       vars:TFPList;
       IsVar:boolean;

  procedure PrintVars;
   begin
    if vars.Count > 0 then GetPasVariables(vars,indent+1,false,false);
    IsVar:=False;
    vars.Clear;
   end;

  begin
   if assigned(pc) then
    begin
     s:=GetIndent(indent);
     if (pc.ObjKind=okGeneric) then
       begin
       write(s,'generic ',pc.Name);
       for l:=0 to pc.GenericTemplateTypes.Count-1 do
          begin
          if l=0 then
           Write('<')
          else
           Write(',');
          Write(TPasGenericTemplateType(pc.GenericTemplateTypes[l]).Name);
          end;
       Write('> = ');
       end
     else
       write(s,pc.Name,' = ');
     if pc.IsPacked then write('packed ');
     case pc.ObjKind of
      okObject:write('Object');
      okClass:write('Class');
      okInterface:write('Interface');
      okGeneric:write('class');
      okspecialize : write('specialize');
     end;
     if assigned(pc.AncestorType) and (pc.AncestorType.ElementTypeName <> '') then
        begin
        if pc.ObjKind<>okspecialize then
          write('(',pc.AncestorType.Name,')')
        else
          begin
          write(' ',pc.AncestorType.Name);
          for l:=0 to pc.GenericTemplateTypes.Count-1 do
           begin
           if l=0 then
            Write('<')
           else
            Write(',');
           Write(TPasGenericTemplateType(pc.GenericTemplateTypes[l]).Name);
           end;
          Write('>');
          end;
        end;
     if pc.IsForward or pc.IsShortDefinition then //pparser.pp: 3417 :class(anchestor); is allowed !
      begin
       writeln(';');
       exit;
      end;  
    //Members: TFPList;
    //InterfaceGUID: String;
    //ClassVars: TFPList; //is this always empty ?
    //Modifiers: TStringList;
    //Interfaces: TFPList;
      s1:=GetIndent(indent+1);
      s2:=GetIndent(indent+2);
      if pc.Members.Count > 0 then
       begin
        writeln;
        vars:=TFPList.Create;
        IsVar:=false;
        for j:=0 to pc.Members.Count-1 do
         begin
           lpe:=TPasElement(pc.Members[j]);

           //Class visibility, written on change
           if j=0 then
            begin
             vis:=lpe.Visibility;
             if GetVisibility(vis) <> '' then writeln(s1,GetVisibility(vis));
            end
           else
            if vis <> lpe.Visibility then
             begin
              if IsVar then PrintVars;
              if lpe.Visibility <> visDefault then //Class Function = visDefault
               begin
                vis:=lpe.Visibility;
                if GetVisibility(vis) <> '' then writeln(s1,GetVisibility(vis));
               end;
             end;

           if lpe is TPasOverloadedProc then
            begin
             if IsVar then PrintVars;
             GetTPasOverloadedProc(TPasOverloadedProc(lpe),indent+2);
            end
           else if lpe is TPasProcedure then //TPasClassProcedure and
            begin         //TPasClassFunction are both child of TPasProcedure
             if IsVar then PrintVars;
             GetTPasProcedure(TPasProcedure(lpe),indent+2);
            end
           else if lpe is TPasProperty then
            begin
             if IsVar then PrintVars;
             lpp:=TPasProperty(lpe);
             write(s2,'property ',lpp.Name);
             if lpp.Args.Count >0 then
              begin
               for l:=0 to lpp.Args.Count-1 do
                begin
                 lpa:=TPasArgument(lpp.Args.Items[l]);
                 if GetTPasArgumentAccess(lpa.Access) <> '' then
                   write('[',GetTPasArgumentAccess(lpa.Access),' ',lpa.Name)
                    else write('[',lpa.Name); //variblename
                 if assigned(lpa.ArgType) then
                  begin
                   //if TPasType(lpa.ArgType).ElementTypeName <>'unresolved type reference' then
                   //,TPasType(lpa.ArgType).Name,' ');
                   //,TPasType(lpa.ArgType).FullName,TPasType(lpa.ArgType).ElementTypeName)
                   // PParser 2099: ArgType := nil; if IsUntyped then => Arg.ArgType := ArgType;
                   //     else write(':? ');
                   write(': ');
                   if lpa.ArgType is TPasArrayType then
                    begin
                     GetTPasArrayType(TPasArrayType(lpa.ArgType));
                    end
                     else  write(TPasType(lpa.ArgType).Name);
                  end;
                 if lpa.Value <> '' then write('=',lpa.Value);
                 write(']');
                end;
              end;//args
             if assigned(lpp.VarType) then
              begin
               write(': ',TPasType(lpp.VarType).Name);
              end;
             if lpp.IndexValue <> '' then write(' Index ',lpp.IndexValue);
             if lpp.ReadAccessorName <> '' then write(' Read ',lpp.ReadAccessorName);
             if lpp.WriteAccessorName <> '' then write(' Write ',lpp.WriteAccessorName);
             if lpp.ImplementsName <> '' then write(' Implements ',lpp.ImplementsName);
             if lpp.IsDefault then write(' Default ',lpp.DefaultValue);
             if lpp.IsNodefault then write(' NoDefault');
             if lpp.StoredAccessorName <> '' then write(' Stored ',lpp.StoredAccessorName);
             GetTPasMemberHints(lpp.Hints);
             writeln(';');
            end
           else if lpe is TPasVariable then
            begin
             //this is done with printvars
             //GetTPasVar(TPasVariable(lpe),indent+1,false);
             IsVar:=true;
             vars.add(lpe);
            end
           else
            begin
             if IsVar then PrintVars;
             writeln('{ Unknown Declaration(s) in Class/Object/Interface: ');
             writeln(s,lpe.Name);
             writeln('}');
            end;
         end;
        //writeln(s,'end;');//'//class');
         if IsVar then PrintVars;
         vars.free;
       end
        else  writeln;//(';'); //x=class(y);

     writeln(s,'end;');
    end;
  end;


procedure GetDecls(Decl:TPasDeclarations; indent:integer);
 var i,j:integer;
     pe:TPasElement;
     pp:TPasProcedure;
     ps:TPasSection;
     s:string;
     x:(None,ResStrings,Types,Consts,Classes,Functions,Variables,Properties);
     l:TFPList;

  procedure PrintVars;
   begin
    if l.Count > 0 then GetPasVariables(l,indent+1,false,false);
   end;

begin
 s:=GetIndent(indent);
 x:=None;
 if assigned(Decl)then
  begin
   l:=TFPList.Create;
   pe:=TPasElement(Decl);
   if pe is TPasSection then
    begin
     {(Decl is TInterfaceSection)or(Decl is TImplementationSection) or
     (Decl is TProgramSection}
     ps:=TPasSection(pe);
     if ps.UsesList.Count >0 then
      begin
       write(s,'uses ');
       ps:=TPasSection(Decl);
       if not Unformated then begin writeln; write(s,'  '); end;
       for i:=0 to ps.UsesList.Count-2 do
        if UpCase(TPasElement(ps.UsesList[i]).Name) = 'SYSTEM' then continue //do not print system
         else write(TPasElement(ps.UsesList[i]).Name,',');                   //as it is added by parser
       writeln(TPasElement(ps.UsesList[ps.UsesList.Count-1]).Name,';');
       if not Unformated then writeln;
      end;
    end;
   if assigned(Decl.Declarations)and(Decl.Declarations.Count > 0) then
   for j:=0 to Decl.Declarations.Count-1 do
    begin
     pe:=TPasElement(Decl.Declarations[j]);
     if pe is TPasResString then
       begin
        if x = Variables then PrintVars;
        if x <> ResStrings then
         begin
          if not Unformated then writeln;
          writeln(s,'ResourceString');
          x:=ResStrings;
         end;
        writeln(s,pe.Name,'=',DelQuot(TPasResString(pe).Value),';'); //too much '''
       end
     else if pe is TPasConst then
       begin
        if x = Variables then PrintVars;
        if x <> Consts then
         begin
          if not Unformated then writeln;
          writeln(s,'const');
          x:=Consts;
         end;
        GetTPasVar(TPasVariable(pe),indent+1,false);
       end
     else if pe is TPasVariable then
       begin
        if x <> Variables then
         begin
          if not Unformated then writeln;
          writeln(s,'var');
          x:=Variables;
          l.Clear;
         end;
        l.Add(pe);
        //this is done with printvars
        //GetTPasVar(TPasVariable(pe),indent+1,false);
       end
     else if pe is TPasClassType then
       begin
        if x = Variables then PrintVars;
        if x <> Types then
         begin
          if not Unformated then writeln;
          writeln(s,'Type');
          x:=Types;
         end;
        GetTPasClass(TPasClassType(pe),indent+1);
       end
     else if pe is TPasType then
       begin
        if x = Variables then PrintVars;
        if x <> Types then
         begin
          if not Unformated then writeln;
          writeln(s,'Type');
          x:=Types;
         end;
        GetTypes(TPasElement(pe),indent+1);
       end
     else if pe is TPasProcedureBase then
       begin
        if x = Variables then PrintVars;
        if (x <> Functions)and not Unformated then writeln;
        x:=Functions;
        if pe is TPasOverloadedProc then
          begin
           GetTpasOverloadedProc(TPasOverloadedProc(pe),indent);
          end
         else
          begin
           pp:=TPasProcedure(pe);
           GetTPasProcedure(pp,indent);
           GetTPasProcedureBody(pp.Body,indent);
          end;
       end
      else
       begin
        if x = Variables then PrintVars;
        x:=None;
        writeln('{ Unknown Declaration: ',pe.Name,' }');
       end;
    end;
   if x = Variables then PrintVars;
   l.Free;
  end;
end;

{replaced by GetDecls
 this does the same but not in true order

procedure PrintDecls(Decl:TPasDeclarations; indent:integer);
 var i:integer;
     pe:TPasElement;
     pp:TPasProcedure;
     ps:TPasSection;
     s:string;
     istype:boolean;

begin
 istype:=false;
 s:=GetIndent(indent);
 if (Decl is TInterfaceSection)or(Decl is TImplementationSection) or
     (Decl is TProgramSection) then
  if TPasSection(Decl).UsesList.Count >0 then
    begin
     write(s,'uses ');
     ps:=TPasSection(Decl);
     if not Unformated then begin writeln; write(s,'  '); end;
     for i:=0 to ps.UsesList.Count-2 do
      if UpCase(TPasElement(ps.UsesList[i]).Name) = 'SYSTEM' then continue //do not print system
       else write(TPasElement(ps.UsesList[i]).Name,',');                   //as it is added by parser
     writeln(TPasElement(ps.UsesList[ps.UsesList.Count-1]).Name,';');
     if not Unformated then writeln;
    end;

  if assigned(Decl.ResStrings) then
    if Decl.ResStrings.Count >0 then
     begin
      writeln('ResourceString');
      for i := 0 to Decl.ResStrings.Count - 1 do
       begin
        pe:=TPasElement(Decl.ResStrings[i]);
        writeln(s,pe.Name,'=',DelQuot(TPasResString(pe).Value),';'); //too much '''
       end;
      if not Unformated then writeln;
     end;

  if assigned(Decl.Consts)then
    if Decl.Consts.Count >0 then
     begin
      writeln(s,'const');
      for i:=0 to Decl.Consts.Count-1 do GetTPasVar(TPasVariable(Decl.Consts[i]),indent+1,false);
      if not Unformated then writeln;
     end;

  if assigned(Decl.Types) then
    if Decl.Types.Count >0 then
     begin
      writeln(s,'Type');
      for i := 0 to Decl.Types.Count - 1 do
       begin
        GetTypes(TPasElement(Decl.Types[i]),indent+1);
       end;
      if not Unformated then writeln;
      istype:=true; 
     end;

  if assigned(Decl.Classes) then
    if Decl.Classes.Count >0 then
     begin
      if not istype then writeln('Type');
      for i := 0 to Decl.Classes.Count - 1 do
       begin
        pe:=TPasElement(Decl.Classes[i]);
        GetTPasClass(TPasClassType(pe),indent+1);
        if not Unformated then writeln;
       end;
     end;

  if assigned(Decl.Variables)then
    if Decl.Variables.Count >0 then
     begin
       writeln(s,'var');
       //Now i use GetPasVariables for more compact output
       //for i:=0 to Decl.Variables.Count-1 do GetTPasVar(TPasVariable(Decl.Variables[i]),indent+1,false);
       GetPasVariables(Decl.Variables,indent+1,false,false);
       if not Unformated then writeln;
     end;

  if assigned(Decl.Functions) then
   begin
    for i := 0 to Decl.Functions.Count - 1 do
     begin
       pe:=TPasElement(Decl.Functions[i]);
       if pe is TPasOverloadedProc then
        begin
         GetTpasOverloadedProc(TPasOverloadedProc(pe),indent);
        end
       else
        begin
         pp:=TPasProcedure(pe);
         GetTPasProcedure(pp,indent);
         GetTPasProcedureBody(pp.Body,indent);
        end;
     end;
   end;
end;   }

//# parameter

 procedure PrintUsage;
  begin
   writeln('usage: test_parser1 <Options> <Commandline> File');
   writeln;
   writeln(' <Options> : Options for test_parser1');
   writeln('  -u  : Unformated output');
   writeln('  -OS <os>   : <os>  = WINDOWS, LINUX (default), FREEBSD, NETBSD,');
   writeln('                        SUNOS, BEOS, QNX, GO32V2');
   writeln('  -CPU <cpu> : <cpu> = i386 (default), x86_64');
   writeln(' <Commandline> : is the commandline for the parser');
   writeln('  -d<define>        : <define> = Directive');
   writeln('  -Fi<include_path> : <include_path> = ?');
   writeln('  -I<include_path>  : <include_path> = ?');
   writeln('  -Sd               : mode delphi');
   writeln(' File : a pascal source file (Program or Unit)');
  end;

 procedure GetParam;
  begin
    if paramcount>0 then
     begin
      cmdl:='';
      i:=1;
      repeat
        if paramstr(i) = '-h' then
         begin
          PrintUsage;
          halt(0);
         end
        else if paramstr(i) = '-u' then Unformated:= true
        else if paramstr(i) = '-OS' then
         begin
          if i < paramcount then
           begin
            inc(i);
            TargetOS:=paramstr(i);
            if (TargetOS = '')or(TargetOS[1] = '-') then halt(1);
           end
            else halt(1);
         end
        else if paramstr(i) = '-CPU' then
         begin
          if i < paramcount then
           begin
            inc(i);
            TargetCPU:=paramstr(i);
            if (TargetCPU = '')or(TargetCPU[1] = '-') then halt(1);
           end
            else halt(1);
         end
        else
          cmdl:=cmdl+' '+paramstr(i);
       inc(i);
      until i > paramcount;
     end;
    if (Paramcount < 1)or(cmdl = '') then
     begin
      // remember to put the whole cmdline in quotes, and
      // to always add some path options. Even if only -Fu. -Fi.
       writeln('Error: No file for input given !');
       PrintUsage;
       halt(1);
     end;
  end;

//# ***    main    ***

begin
  isim:=false;
  Unformated:=false;//false to format output to be human readable
  TargetOS:='linux';
  TargetCPU:='i386';
  GetParam;
  //writeln(TargetOS,' ',TargetCPU,' ',cmdl);halt;
  E := TSimpleEngine.Create;
  try
    try
      M := ParseSource(E, cmdl ,TargetOS ,TargetCPU);
    except
      on excep:EParserError do
        begin
          writeln(excep.message,' line:',excep.row,' column:',excep.column,' file:',excep.filename);
          raise;
       end;
    end;
   if M is TPasProgram then
    begin
     writeln('Program ',M.Name,';');
     if not Unformated then writeln;
     if assigned(M.ImplementationSection) then
       begin
        isim:=true;
        if not Unformated then writeln;
        GetDecls(M.ImplementationSection as TPasDeclarations,0);
        //PrintDecls(M.ImplementationSection as TPasDeclarations,0);
       end;
     if assigned(M.InitializationSection) then // MAIN BLOCK
       begin
        isim:=false;
        if not Unformated then writeln;
        writeln('begin');//writeln('begin {Begin MAIN Program}')
        GetTPasImplBlock(M.InitializationSection as TPasImplBlock,1,0,false,false);
       end;  
    end
   else
    begin
      { Cool, we successfully parsed the unit.
        Now output some info about it. }
      writeln('Unit ',M.Name,';');
      if not Unformated then writeln;
      Writeln('Interface');
      if not Unformated then writeln;
      GetDecls(M.InterfaceSection as TPasDeclarations,0);
      //PrintDecls(M.InterfaceSection as TPasDeclarations,0);

      if assigned(M.ImplementationSection) then
       begin
        isim:=true;
        if not Unformated then writeln;
        Writeln('Implementation');
        if not Unformated then writeln;
        GetDecls(M.ImplementationSection as TPasDeclarations,0);
        //PrintDecls(M.ImplementationSection as TPasDeclarations,0);
        if TPasElement(M.ImplementationSection) is TPasImplElement then writeln('{MAIN}');
       end;
      if assigned(M.InitializationSection) then //is this begin .. end. of a unit too ?
       begin
        isim:=true;
        if not Unformated then writeln;
        Writeln('Initialization');
        if not Unformated then writeln;
        GetTPasImplBlock(M.InitializationSection as TPasImplBlock,1,0,false,false);
        if assigned(M.FinalizationSection) then
         begin
          isim:=true;
          if not Unformated then writeln;
          Writeln('Finalization');
          if not Unformated then writeln;
          GetTPasImplBlock(M.FinalizationSection as TPasImplBlock,1,0,false,false);
         end;
       end;
    end;
    if not Unformated then writeln('end.')
     else
      begin
       writeln('end');
       writeln('.');
      end;
    FreeAndNil(M);
  finally
    FreeAndNil(E);
  end;
end.