path: root/src/fortranscanner.l

/* -*- mode: fundamental; indent-tabs-mode: 1; -*- */
/*****************************************************************************
 * Parser for Fortran90 F subset
 *
 * Copyright (C) by Anke Visser
 * based on the work of Dimitri van Heesch.
 *
 * Permission to use, copy, modify, and distribute this software and its
 * documentation under the terms of the GNU General Public License is hereby 
 * granted. No representations are made about the suitability of this software 
 * for any purpose. It is provided "as is" without express or implied warranty.
 * See the GNU General Public License for more details.
 *
 * Documents produced by Doxygen are derivative works derived from the
 * input used in their production; they are not affected by this license.
 *
 */ 

/* Developer notes.
 *
 * - Consider using startScope(), endScope() functions with  module, program, 
 * subroutine or any other scope in fortran program.
 *
 * - Symbol modifiers (attributes) are collected using SymbolModifiers |= operator during
 * substructure parsing. When substructure ends all modifiers are applied to actual
 * entries in applyModifiers() functions.
 * 
 * - How case insensitiveness should be handled in code?
 * On one side we have arg->name and entry->name, on another side modifierMap[name].
 * In entries and arguments case is the same as in code, in modifier map case is lowered and
 * then it is compared to lowered entry/argument names.
 *
 * - Do not like constructs like aa{BS} or {BS}bb. Should try to handle blank space
 * with separate rule?: It seems it is often necessary, because we may parse something like 
 * "functionA" or "MyInterface". So constructs like `(^|[ \t])interface({BS_}{ID})?/[ \t\n]'
 * are desired.
 */

%{

#include <stdio.h> 
#include <stdlib.h>
#include <assert.h>
#include <ctype.h>

#include "qtbc.h"
#include <qarray.h>
#include <qstack.h>
#include <qregexp.h>
#include <unistd.h> 
#include <qfile.h>
#include <qmap.h>
  
#include "fortranscanner.h"
#include "entry.h"
#include "message.h"
#include "config.h"
#include "doxygen.h"
#include "util.h"
#include "defargs.h"
#include "language.h"
#include "commentscan.h" 
#include "fortrancode.h"
#include "pre.h"

#define YY_NEVER_INTERACTIVE 1

enum ScanVar { V_IGNORE, V_VARIABLE, V_PARAMETER};

// {{{ ----- Helper structs -----
//! Holds modifiers (ie attributes) for one symbol (variable, function, etc)
struct SymbolModifiers {
  enum Protection {NONE_P, PUBLIC, PRIVATE};
  enum Direction {NONE_D, IN, OUT, INOUT};

  //!< This is only used with function return value.
  QCString type, returnName;
  Protection protection;
  Direction direction;
  bool optional;
  QCString dimension;
  bool allocatable;
  bool external;
  bool intrinsic;
  bool parameter;
  bool pointer;
  bool target;
  bool save;

  SymbolModifiers() : type(), returnName(), protection(NONE_P), direction(NONE_D),
    optional(FALSE), dimension(), allocatable(FALSE),
    external(FALSE), intrinsic(FALSE), parameter(FALSE),
    pointer(FALSE), target(FALSE), save(FALSE) {}

  SymbolModifiers& operator|=(const SymbolModifiers &mdfs);
  SymbolModifiers& operator|=(QCString mdfrString);
};

//ostream& operator<<(ostream& out, const SymbolModifiers& mdfs);

static const char *directionStrs[] = 
{
   "", "intent(in)", "intent(out)", "intent(inout)"
};

// }}}

/* -----------------------------------------------------------------
 *
 *	statics
 */
static ParserInterface *g_thisParser; 
static const char *     inputString;
static int		inputPosition;
static QFile            inputFile;
static QCString		yyFileName;
static int		yyLineNr     = 1 ;
static Entry*		current_root = 0 ;
static Entry*		global_root  = 0 ;
static Entry*		file_root    = 0 ;
static Entry*		current      = 0 ;
static Entry*		last_entry   = 0 ;
static ScanVar          v_type       = V_IGNORE; // type of parsed variable
static QList<Entry>     moduleProcedures; // list of all interfaces which contain unresolved 
                                          // module procedures
static QCString         docBlock;
static QCString         docBlockName;
static bool             docBlockInBody;
static bool             docBlockJavaStyle;

static MethodTypes 	mtype;
static bool    		gstat;
static Specifier 	virt;

static QCString          debugStr;
static QCString          result; // function result
static Argument          *parameter; // element of parameter list
static QCString          argType;  // fortran type of an argument of a parameter list
static QCString          argName;  // last identifier name in variable list
static QCString          initializer;  // initial value of a variable
static QCString          useModuleName;  // name of module in the use statement
static Protection        defaultProtection;

static char              stringStartSymbol; // single or double quote

//! Accumulated modifiers of current statement, eg variable declaration.
static SymbolModifiers currentModifiers;
//! Holds program scope->symbol name->symbol modifiers.
static QMap<Entry*,QMap<QCString,SymbolModifiers> > modifiers;

//-----------------------------------------------------------------------------

static int yyread(char *buf,int max_size);
static void startCommentBlock(bool);
static void handleCommentBlock(const QCString &doc,bool brief);
static void addCurrentEntry();
static void addInterface(QCString name);
static Argument *addFortranParameter(const QCString &type,const QCString &name, const QCString docs);
static void scanner_abort();

static void startScope(Entry *scope);
static bool endScope(Entry *scope);
static QCString getFullName(Entry *e);
static bool isTypeName(QCString name);
static void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root);

//-----------------------------------------------------------------------------
#undef	YY_INPUT
#define	YY_INPUT(buf,result,max_size) result=yyread(buf,max_size);
//-----------------------------------------------------------------------------

%}

 //-----------------------------------------------------------------------------
 //-----------------------------------------------------------------------------
IDSYM	  [a-z_A-Z0-9]
NOTIDSYM  [^a-z_A-Z0-9]
SEPARATE  [:, \t]
ID        [a-z_A-Z%]+{IDSYM}*
PP_ID     {ID}
LABELID   [a-z_A-Z]+[a-z_A-Z0-9\-]*
SUBPROG   (subroutine|function)
B         [ \t]
BS        [ \t]*
BS_       [ \t]+
COMMA     {BS},{BS}
ARGS      {BS}("("[^)]*")")
NOARGS    {BS}"\n"

NUM_TYPE  (complex|integer|logical|real)
KIND      {ARGS}
CHAR      (CHARACTER{ARGS}?|CHARACTER{BS}"*"([0-9]+|{ARGS}))
TYPE_SPEC (({NUM_TYPE}("*"[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS}PRECISION|{CHAR}|TYPE{ARGS})

INTENT_SPEC intent{BS}"("{BS}(in|out|in{BS}out){BS}")"
ATTR_SPEC (ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET)
ACCESS_SPEC (PRIVATE|PUBLIC)
/* Assume that attribute statements are almost the same as attributes. */
ATTR_STMT {ATTR_SPEC}|DIMENSION|{ACCESS_SPEC}

%option noyywrap
%option stack
%option caseless
/*%option debug */

 //---------------------------------------------------------------------------------

 /** fortran parsing states */
%x	Subprog
%x	Parameterlist
%x	SubprogBody
%x	Start
%x	Comment
%x      Module
%x      ModuleBody
%x	AttributeList
%x      Variable
%x      Initialization
%x      ArrayInitializer
%x      Typedef
%x      TypedefBody
%x      InterfaceBody
%x      StrIgnore
%x      String
%x      Use
%x      UseOnly
%x      ModuleProcedure

 /** comment parsing states */
%x	DocBlock
%x	DocBackLine
%x	EndDoc

%%

 /*-----------------------------------------------------------------------------------*/

<*>"&".*"\n"                            { if (YY_START == String) REJECT; // "&" is ignored in strings
                                          yyLineNr++;}  /* line not finished -> read next line (text after "&" may be 
                                                           comment and has to be ignored */

 /*------ ignore strings */ 
<*>"\\\\"                               { /* ignore \\  */}
<*>"\\\""|\\\'                          { /* ignore \" and \'  */}

<String>\"|\'                           { // string ends with next quote without previous backspace
                                          if(yytext[0]!=stringStartSymbol) REJECT; // single vs double quote
                                          // fprintf(stderr,"string end: %s\n",debugStr.data());
                                          yy_pop_state();
                                        }           

<String>.                               { debugStr+=yytext; } // ignore String contents (especially '!') 

<*>\"|\'                                { /* string starts */
					  if(YY_START == StrIgnore) REJECT; // ignore in simple comments
                                          // fprintf(stderr,"string start: %c %d\n",yytext[0],yyLineNr);
                                          yy_push_state(YY_START);
                                          stringStartSymbol=yytext[0]; // single or double quote
                                          BEGIN(String); debugStr="!^!";
                                        }

 /*------ ignore simple comment (not documentation comments) */

<*>"!"/[^<>\n]                         {  if (YY_START == String) REJECT; // "!" is ignored in strings
                                          // skip comment line (without docu comments "!>" "!<" ) 
                                          /* ignore further "!" and ignore comments in Strings */
                                          if ((YY_START != StrIgnore) && (YY_START != String)) {
                                            yy_push_state(YY_START);
                                            BEGIN(StrIgnore); 
                                            debugStr="*!";
                                            //fprintf(stderr,"start comment %d\n",yyLineNr);
                                           }      
                                        }
<StrIgnore>.?/\n                        { yy_pop_state(); // comment ends with endline character
                                          //fprintf(stderr,"end comment %d %s\n",yyLineNr,debugStr.data());
                                        } // comment line ends
<StrIgnore>.                            { debugStr+=yytext; } 


 /*------ use handling ------------------------------------------------------------*/

<Start,ModuleBody,TypedefBody,SubprogBody>"use"{BS_} { 
                                          yy_push_state(YY_START);
					  BEGIN(Use);     
                                        }
<Use>{ID}                               { 
                                          //fprintf(stderr,"using dir %s\n",yytext);
                                          current->name=yytext;
                                          current->fileName = yyFileName; 
  					  current->section=Entry::USINGDIR_SEC;
					  current_root->addSubEntry(current);
					  current = new Entry;
                                          yy_pop_state();
                                        }
<Use>{ID}/,                             { 
                                          useModuleName=yytext;
                                        }
<Use>,{BS}"ONLY"                        { BEGIN(UseOnly); 
                                        }           
<UseOnly>{BS},{BS}                      {}
<UseOnly>{ID}                           {
  					  current->name= useModuleName+"::"+yytext;
                                          current->fileName = yyFileName; 
  					  current->section=Entry::USINGDECL_SEC;
					  current_root->addSubEntry(current);
					  current = new Entry ;
  					}
<Use,UseOnly>"\n"                       {
                                          unput(*yytext);
                                          yy_pop_state();
                                        }

 /*------ ignore special fortran statements */
<Start,ModuleBody,SubprogBody>^[ \t]*interface({BS_}{ID}({BS}\({BS}[^ \t()]+{BS}\))?)? { // handle interface block
					  QCString name = yytext;
					  int index = name.find("interface", 0, FALSE);
					  index = name.find(QRegExp("[^ \\t]"), index+9);
					  //printf(stderr,"%s,%d\n",name.data(),index);
					  if(index!=-1)
					    name = name.right(name.length()-index);
					  else // interface without name, must be inside subprog
					    name = "interface"; 
					  addInterface(name);
					  yy_push_state(InterfaceBody);
 					  startScope(last_entry);
                                        }
<InterfaceBody>"end"{BS}"interface".*   {
					  if(!endScope(current_root))
					    yyterminate();
					  yy_pop_state();
                                        }
<InterfaceBody>module{BS}procedure      { yy_push_state(YY_START);
                                          BEGIN(ModuleProcedure);
                                        }
<ModuleProcedure>{ID}                   {                       			
                                          current->section = Entry::FUNCTION_SEC ;
                                          current->name = yytext; 
 	                                  moduleProcedures.append(current);
                                          addCurrentEntry();
                                        }
<ModuleProcedure>"\n"                   { unput(*yytext); 
                                          yy_pop_state();
                                        }
<InterfaceBody>.                        {}
                 
 /*------ module handling ------------------------------------------------------------*/ 
<Start>module|program{BS_}             {  //
					    BEGIN(Module);
                                            defaultProtection = Public;
                                       }
<Start,ModuleBody>"end"{BS}(module|program).* { // end module	
					    resolveModuleProcedures(moduleProcedures, current_root);
					    if(!endScope(current_root))
					      yyterminate();
                                            defaultProtection = Public;
					    BEGIN(Start);
                                       }
<Module>{ID}                           {  
                                            //cout << "0=========> got module " << yytext  << endl; 
                                            current->section = Entry::NAMESPACE_SEC;
  					    current->name = yytext;
			                    current->type = "module";
 					    current->fileName  = yyFileName;
					    current->bodyLine  = yyLineNr; // used for source reference
					    current->protection = Public ;

                                            addCurrentEntry();
					    startScope(last_entry);

					    BEGIN(ModuleBody);
                                       }

  /*------- access specification --------------------------------------------------------------------------*/

<ModuleBody>private/{BS}(\n|"!")         { defaultProtection = Private; }
<ModuleBody>public/{BS}(\n|"!")          { defaultProtection = Public; }

 /*------- type definition  -------------------------------------------------------------------------------*/

<Start,ModuleBody>"type"({BS_}|({COMMA}{ACCESS_SPEC})) { /* type definition found : TYPE , access-spec::type-name |*/
 					    yy_push_state(YY_START);
                                            BEGIN(Typedef);
					    current->protection = defaultProtection;
                                        }
<Typedef>{ACCESS_SPEC}          	{ 	
                                            QCString type= yytext;				    
                                        }
<Typedef>{ID}                        	{ /* type name found */
                                            //cout << "=========> got typedef " << yytext << ": " << yyLineNr << endl; 
                                            current->section = Entry::CLASS_SEC; // was Entry::STRUCT_SEC;
   					    current->spec = Entry::Struct;        	
  					    current->name = yytext;

                                            /* if type is part of a module, mod name is necessary for output */
                                            if ((current_root) && 
                                               (current_root->section ==  Entry::CLASS_SEC ||
					        current_root->section ==  Entry::NAMESPACE_SEC))
						//current_root->section ==  Entry::INTERFACE_SEC)) 
					    {
                                              current->name= current_root->name+"::"+current->name;
                                            }
					    current->fileName = yyFileName;
					    current->bodyLine  = yyLineNr; 
                                            addCurrentEntry();
					    startScope(last_entry); 
                                            BEGIN(TypedefBody);
                                        }
<TypedefBody>"end"{BS}"type".*          { /* end type definition */
                                           //cout << "=========> got typedef end "<< endl; 
					   if(!endScope(current_root))
					     yyterminate();
                                           yy_pop_state();
                                        } 

 /*------- module/global/typedef variable ---------------------------------------------------*/

<Start,ModuleBody,TypedefBody,SubprogBody>{
{TYPE_SPEC}/{SEPARATE}			{
                                          /* variable declaration starts */
                                          //fprintf(stderr,"4=========> got variable type: %s\n",yytext);
 					  QCString help=yytext;
					  help= help.simplifyWhiteSpace();
					  argType= help;
					  yy_push_state(AttributeList);
                                        }
^{BS}{PP_ID}{KIND}?			{ /* check for preprocessor symbol expand to type */
					  QCString str = yytext;
					  str = str.stripWhiteSpace();
					  DefineDict* defines = getFileDefineDict();
					  QCString name;
					  int index = str.find("(");
					  if(index != -1)
					    name = str.left(index).stripWhiteSpace();
					  else
					    name = str;

					  Define *define = (*defines)[name];
					  if(define != 0 && isTypeName(define->definition)) {
					    argType = str;
					    yy_push_state(AttributeList);
					  } else {
					    REJECT;
					  }
					}
{ATTR_STMT}/{BS_}{ID}		       |
{ATTR_STMT}/{BS}"::"                   { 
                                          /* attribute statement starts */
                                          //fprintf(stderr,"5=========> Attribute statement: %s\n", yytext); 
                                          QCString tmp = yytext;
                                          currentModifiers |= tmp.stripWhiteSpace();
					  argType="";
					  yy_push_state(YY_START);
					  BEGIN( AttributeList ) ;
  				       }
}
<AttributeList>{
{COMMA}					{}
{BS}					{}
{ATTR_SPEC}				{ /* update current modifiers */
                                          QCString tmp = yytext;
                                          currentModifiers |= (tmp);
					}
"::"					{ /* end attribute list */
					  BEGIN( Variable );
					}
.					{ /* unknown attribute, consider variable name */
					  //cout<<"start variables, unput "<<*yytext<<endl;
					  unput(*yytext);
					  BEGIN( Variable );
					}
}

<Variable>{BS}				{}
<Variable>{ID}				{ /* parse variable declaration */
                                          //cout << "5=========> got variable: " << argType << "::" << yytext << endl;
 					  /* work around for bug in QCString.replace (QCString works) */
					  QCString name=yytext;
					  /* remember attributes for the symbol */
					  modifiers[current_root][name.lower()] |= currentModifiers;
					  argName= name;
					  int last= yy_top_state();

					  v_type= V_IGNORE;
  					  if (!argType.isEmpty() && last != SubprogBody) { // new variable entry
					    v_type = V_VARIABLE;
                                            current->section = Entry::VARIABLE_SEC;
 					    current->name = argName;
					    current->type = argType;
					    current->fileName = yyFileName;
					    current->bodyLine  = yyLineNr; // used for source reference
                                            addCurrentEntry();
                                          } else if(!argType.isEmpty()){ // deklaration of parameter list: add type for corr. parameter 
					    parameter= addFortranParameter(argType,argName,docBlock);
					    if (parameter) v_type= V_PARAMETER;
					    // save, it may be function return type
					    modifiers[current_root][name.lower()].type = argType;
					    // any accumulated doc for argument should be emptied,
					    // because it is handled other way and this doc can be
					    // unexpectedly passed to the next member.
					    current->doc.resize(0);
					    current->brief.resize(0);
                                          } 
  					}
<Variable>{ARGS}			{ /* dimension of the previous entry. */
					  QCString name(argName);
					  QCString attr("dimension");
					  attr += yytext;
					  modifiers[current_root][name] |= attr;
					}
<Variable>{COMMA}	                {}
<Variable>{BS}"="                       { yy_push_state(YY_START);
                                          initializer="";
					  BEGIN(Initialization);
                                        }
<Variable>"\n"	                        { currentModifiers = SymbolModifiers();
                                          yy_pop_state(); // end variable deklaration list
                                          yyLineNr++;
                                          docBlock.resize(0);
                                        }

<Initialization>"(/"                    { initializer+=yytext; 
                                          BEGIN(ArrayInitializer); // initializer may contain comma
                                        }
<ArrayInitializer>.                     { initializer+=yytext; }
<ArrayInitializer>"/)"                  { initializer+=yytext;
                                          yy_pop_state(); // end initialization
                                          if (v_type == V_VARIABLE) last_entry->initializer= initializer;
                                        }
<Initialization>{COMMA}                 { yy_pop_state(); // end initialization
                                          if (v_type == V_VARIABLE) last_entry->initializer= initializer;
                                        }
<Initialization>"\n"|"!"                { //| 
                                          yy_pop_state(); // end initialization
                                          if (v_type == V_VARIABLE) last_entry->initializer= initializer;
 					  unput(*yytext);
                                        }
<Initialization>.                       { initializer+=yytext; }
 
 /*------ fortran subroutine/function handling ------------------------------------------------------------*/
 /*       Start is initial condition                                                                       */
 
<Start,ModuleBody,SubprogBody,InterfaceBody>{TYPE_SPEC}{BS}/{SUBPROG}{BS_} {   
		                           // TYPE_SPEC is for old function style function result
                                           result= yytext; 
                                           result= result.stripWhiteSpace();
  					   current->type = result;
                                       }              
<Start,ModuleBody,SubprogBody,InterfaceBody>{BS}{SUBPROG}{BS_} {   // Fortran subroutine or function found
 					   //fprintf(stderr,"1=========> got subprog, type: %s\n",yytext); 
                                           current->section = Entry::FUNCTION_SEC ;
                                           QCString subtype = yytext; subtype=subtype.lower().stripWhiteSpace();
	                                   if (!current->type) current->type = subtype;
					   current->fileName  = yyFileName;
					   current->bodyLine  = yyLineNr; // used for source reference
		                           current->startLine = -1; // ??? what is startLine for?
					   current->args.resize(0);
					   current->argList->clear();
                                           yy_push_state(Subprog);
                                           docBlock.resize(0);
                                       }
<Subprog>{BS}                          {   /* ignore white space */   }
<Subprog>{ID}                          {   current->name = yytext; 
					   //cout << "1a==========> got " << current->type << " " << yytext << " " << yyLineNr << endl;
					   modifiers[current_root][current->name.lower()].returnName = current->name;
					   BEGIN(Parameterlist);
                                       } 
<Parameterlist>{ARGS}                  {   
				           //current->type not yet available
                                           QCString arglist= yytext;
					   //cout << "3=========> got parameterlist " << yytext << endl;
                                           yyLineNr+= arglist.contains('\n');
                                           arglist = arglist.replace(QRegExp("&[^\n]*\n"),"");
					   //cout << "3=========> got parameterlist " << arglist << endl;
					   current->args = arglist;
					   current->args = removeRedundantWhiteSpace(current->args);
					   stringToArgumentList(current->args, current->argList);
                                           addCurrentEntry();
					   startScope(last_entry);
					   BEGIN(SubprogBody);
 				       } 
<Parameterlist>{NOARGS}                {   
                                           yyLineNr++;
					   //cout << "3=========> without parameterlist " <<endl;
 					   stringToArgumentList("", current->argList);
                                           addCurrentEntry();
					   startScope(last_entry);
					   BEGIN(SubprogBody);				           
}
<SubprogBody>result{BS}\({BS}{ID}      {  
                                           result= yytext;
                                           result= result.right(result.length()-result.find("(")-1);
                                           result= result.stripWhiteSpace();
 					   modifiers[current_root->parent()][current_root->name.lower()].returnName = result;
                                           //cout << "=====> got result " <<  result << endl;
 				       } 
<SubprogBody>"end"{BS}{SUBPROG}.*      {  
                                           //cout << "1e=========> got end subprog: " << yytext << endl;

                                           /* args is used for parameters in list of functions, argList for 
                                             parameters in detailed function descripttion */
                                           //current->args = argListToString(current->argList); 
					   //current->endBodyLine  = yyLineNr; // ??? what ist endBodyLine for
					   if(!endScope(current_root))
					     yyterminate();
					   yy_pop_state() ;
				       } 

 /*---- documentation comments --------------------------------------------------------------------*/

<Variable>"!<"                           { /* backward docu comment (only one line) */
                                          if (v_type != V_IGNORE) {
                                           yy_push_state(YY_START);
					   current->docLine  = yyLineNr;
 					   docBlockJavaStyle = FALSE;
					   docBlock.resize(0);
					   docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF");
					   startCommentBlock(TRUE);
					   BEGIN(DocBackLine);
                                          }
  					 }
<DocBackLine>.*    			 { // contents of current comment line
                                          docBlock=yytext;
					  if (v_type == V_VARIABLE) {
					    Entry *tmp_entry = current; 
					    current = last_entry; // temporarily switch to the previous entry
  					    handleCommentBlock(docBlock,TRUE);
 					    current=tmp_entry;
                                          }
					  else if (v_type == V_PARAMETER) {
					    parameter->docs=docBlock;
                                          }
                                          yy_pop_state();
 					 }
   
<Start,SubprogBody,ModuleBody,TypedefBody,InterfaceBody>"!>"  {
                                          yy_push_state(YY_START);
					  current->docLine  = yyLineNr;
 					  docBlockJavaStyle = FALSE;
					  docBlock.resize(0);
					  docBlockJavaStyle = Config_getBool("JAVADOC_AUTOBRIEF");
					  startCommentBlock(TRUE);
					  BEGIN(DocBlock);
                                          //cout << "start DocBlock " << endl;
					}

<DocBlock>.*    			{ // contents of current comment line
                                          docBlock+=yytext;
  					}
<DocBlock>"\n"{BS}"!"(">"|"!"+)		{ // comment block (next line is also comment line)
					  docBlock+="\n"; // \n is necessary for lists
                                          yyLineNr++;
  					}
<DocBlock>"\n"        			{ // comment block ends at the end of this line
                                          //cout <<"3=========> comment block : "<< docBlock << endl;
					  unput(*yytext);                                        
 					  handleCommentBlock(docBlock,TRUE);
                                          yy_pop_state();                                          
  					}

 /*------------------------------------------------------------------------------------------------*/

<*>"\n"                                 {yyLineNr++;
                                         //if (debugStr.stripWhiteSpace().length() > 0) cout << "ignored text: " << debugStr << " state: " <<YY_START << endl;
                                         debugStr="";
                                        }

 /*---- error: EOF in wrong state --------------------------------------------------------------------*/
 <SubprogBody,ModuleBody,String,StrIgnore,InterfaceBody><<EOF>> {
                                          fprintf(stderr,"==== Error: EOF reached in wrong state (end missing)");
					  scanner_abort();
					  yyterminate();
                                        }
 <*>.                 	                {debugStr+=yytext;} // ignore remaining text 

 /**********************************************************************************/
 /**********************************************************************************/
 /**********************************************************************************/
%%
//----------------------------------------------------------------------------

/** used to copy entry to an interface module procedure */
static void copyEntry(Entry *dest, Entry *src) 
{
   dest->type     = src->type;
   dest->fileName = src->fileName;
   dest->bodyLine = src->bodyLine;
   dest->args     = src->args;
   dest->argList  = new ArgumentList(*src->argList);
}

/** fill empty interface module procedures with info from 
    corresponding module subprogs 
    @TODO: handle procedures in used modules
*/
void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root)
{
  if (moduleProcedures.isEmpty()) return;
 
  EntryListIterator eli1(moduleProcedures);
  // for all module procedures
  for (Entry *ce1; (ce1=eli1.current()); ++eli1) 
  {
    // check all entries in this module
    EntryListIterator eli2(*current_root->children());
    for (Entry *ce2; (ce2=eli2.current()); ++eli2) 
    {
      if (ce1->name == ce2->name) 
      {
        copyEntry(ce1, ce2);
      }
    } // for procedures in current module
  } // for all interface module procedures
  moduleProcedures.clear();
}

static bool isTypeName(QCString name)
{
  name = name.lower();
  return name=="integer" || name == "real" || 
    name=="complex" || name == "logical";
}

/*! Extracts string which resides within parentheses of provided string. */
static QCString extractFromParens(const QCString name)
{
  QCString extracted = name;
  int start = extracted.find("(");
  if(start != -1) 
  {
    extracted.remove(0, start+1);
  }
  int end = extracted.findRev(")");
  if(end != -1) 
  {
    int length = extracted.length();
    extracted.remove(end, length);
  }
  extracted = extracted.stripWhiteSpace();

  return extracted;
}

/*! Adds passed modifiers to these modifiers.*/
SymbolModifiers& SymbolModifiers::operator|=(const SymbolModifiers &mdfs)
{
  if(mdfs.protection!=NONE_P) protection = mdfs.protection;
  if(mdfs.direction!=NONE_D) direction = mdfs.direction;
  optional |= mdfs.optional;
  if(!mdfs.dimension.isNull()) dimension = mdfs.dimension;
  allocatable |= mdfs.allocatable;
  external |= mdfs.external;
  intrinsic |= mdfs.intrinsic;
  parameter |= mdfs.parameter;
  pointer |= mdfs.pointer;
  target |= mdfs.target;
  save |= mdfs.save;
  return *this;
}

/*! Extracts  and adds passed modifier to these modifiers.*/
SymbolModifiers& SymbolModifiers::operator|=(QCString mdfString)
{
  mdfString = mdfString.lower();
  SymbolModifiers newMdf;

  if (mdfString.find("dimension")==0) 
  {
    newMdf.dimension=mdfString;
  }
  else if (mdfString.contains("intent")) 
  {
    QCString tmp = extractFromParens(mdfString);
    bool isin = tmp.contains("in");
    bool isout = tmp.contains("out");
    if(isin && isout) newMdf.direction = SymbolModifiers::INOUT;
    else if(isin) newMdf.direction = SymbolModifiers::IN;
    else if(isout) newMdf.direction = SymbolModifiers::OUT;
  }
  else if (mdfString=="public") 
  {
    newMdf.protection = SymbolModifiers::PUBLIC;
  }
  else if (mdfString=="private") 
  {
    newMdf.protection = SymbolModifiers::PRIVATE;
  }
  else if (mdfString=="optional") 
  {
    newMdf.optional = TRUE;
  }
  else if (mdfString=="allocatable") 
  {
    newMdf.allocatable = TRUE;
  }
  else if (mdfString=="external") 
  {
    newMdf.external = TRUE;
  }
  else if(mdfString=="intrinsic") 
  {
    newMdf.intrinsic = TRUE;
  }
  else if(mdfString=="parameter") 
  {
    newMdf.parameter = TRUE;
  }
  else if(mdfString=="pointer") 
  {
    newMdf.pointer = TRUE;
  }
  else if(mdfString=="target") 
  {
    newMdf.target = TRUE;
  }
  else if(mdfString=="save") 
  {
    newMdf.save = TRUE;
  }

  (*this) |= newMdf;
  return *this;
}

/*! For debugging purposes. */
//ostream& operator<<(ostream& out, const SymbolModifiers& mdfs)
//{
//  out<<mdfs.protection<<", "<<mdfs.direction<<", "<<mdfs.optional<<
//    ", "<<(mdfs.dimension.isNull() ? "" : mdfs.dimension.latin1())<<
//    ", "<<mdfs.allocatable<<", "<<mdfs.external<<", "<<mdfs.intrinsic;
//
//  return out;
//}

/*! Find argument with given name in \a subprog entry. */
static Argument *findArgument(Entry* subprog, QCString name, bool byTypeName = FALSE)
{
  QCString cname(name.lower());
  for (unsigned int i=0; i<subprog->argList->count(); i++) 
  {
    Argument *arg = subprog->argList->at(i);
    if(!byTypeName && arg->name.lower() == cname ||
	byTypeName && arg->type.lower() == cname)
      return arg;
  }

  return 0;
}

/*! Find function with given name in \a entry. */
#if 0
static Entry *findFunction(Entry* entry, QCString name)
{
  QCString cname(name.lower());

  EntryListIterator eli(*entry->children());
  Entry *ce;
  for (;(ce=eli.current());++eli) 
  {
    if(ce->section != Entry::FUNCTION_SEC)
      continue;

    if(ce->name.lower() == cname)
      return ce;
  }

  return 0;
}
#endif

/*! Apply modifiers stored in \a mdfs to the \a typeName string. */
static QCString applyModifiers(QCString typeName, SymbolModifiers& mdfs) 
{
  if(!mdfs.dimension.isNull()) 
  {
    typeName += ",";
    typeName += mdfs.dimension;
  }
  if(mdfs.direction!=SymbolModifiers::NONE_D) 
  {
    typeName += ",";
    typeName += directionStrs[mdfs.direction];
  }
  if(mdfs.optional) 
  {
    typeName += ",";
    typeName += "optional";
  }
  if(mdfs.allocatable) 
  {
    typeName += ",";
    typeName += "allocatable";
  }
  if(mdfs.external) 
  {
    typeName += ",";
    typeName += "external";
  }
  if(mdfs.intrinsic) 
  {
    typeName += ",";
    typeName += "intrinsic";
  }
  if(mdfs.parameter) 
  {
    typeName += ",";
    typeName += "parameter";
  }
  if(mdfs.pointer) 
  {
    typeName += ",";
    typeName += "pointer";
  }
  if(mdfs.target) 
  {
    typeName += ",";
    typeName += "target";
  }
  if(mdfs.save) 
  {
    typeName += ",";
    typeName += "save";
  }

  return typeName;
}

/*! Apply modifiers stored in \a mdfs to the \a arg argument. */
static void applyModifiers(Argument *arg, SymbolModifiers& mdfs)
{
  QCString tmp = arg->type;
  arg->type = applyModifiers(tmp, mdfs);
}

/*! Apply modifiers stored in \a mdfs to the \a ent entry. */
static void applyModifiers(Entry *ent, SymbolModifiers& mdfs)
{
  QCString tmp = ent->type;
  ent->type = applyModifiers(tmp, mdfs);

  if(mdfs.protection == SymbolModifiers::PUBLIC)
    ent->protection = Public;
  else if(mdfs.protection == SymbolModifiers::PRIVATE)
    ent->protection = Private;
}

/*! Starts the new scope in fortran program. Consider using this function when
 * starting module, interface, function or other program block.
 * \see endScope()
 */
static void startScope(Entry *scope) 
{
  //cout<<"start scope: "<<scope->name<<endl;
  current_root= scope; /* start substructure */

  QMap<QCString,SymbolModifiers> mdfMap;
  modifiers.insert(scope, mdfMap);
}

/*! Ends scope in fortran program: may update subprogram arguments or module variable attributes.
 * \see startScope()
 */
static bool endScope(Entry *scope) 
{
  //cout<<"end scope: "<<scope->name<<endl;
  if (current_root->parent())
  {
    current_root= current_root->parent(); /* end substructure */
  }
  else 
  {
    fprintf(stderr,"parse error in end <scopename>");
    scanner_abort();
    return FALSE;
  }

  // update variables or subprogram arguments with modifiers
  QMap<QCString,SymbolModifiers>& mdfsMap = modifiers[scope];

  if (scope->section == Entry::FUNCTION_SEC) 
  {
    // iterate all symbol modifiers of the scope
    for (QMap<QCString,SymbolModifiers>::Iterator it=mdfsMap.begin(); it!=mdfsMap.end(); it++) 
    {
      //cout<<it.key()<<": "<<it.data()<<endl;
      Argument *arg = findArgument(scope, it.key());

      if (arg)
        applyModifiers(arg, it.data());
    }

    // find return type for function
    //cout<<"RETURN NAME "<<modifiers[current_root][scope->name.lower()].returnName<<endl;
    QCString returnName = modifiers[current_root][scope->name.lower()].returnName.lower();
    if (modifiers[scope].contains(returnName)) 
    {
      scope->type = modifiers[scope][returnName].type; // returning type works
      applyModifiers(scope, modifiers[scope][returnName]); // returning array works
    }

  } 
  if (scope->section == Entry::CLASS_SEC) 
  { // was INTERFACE_SEC
    if (scope->parent()->section == Entry::FUNCTION_SEC) 
    { // interface within function
      // iterate functions of interface and 
      // try to find types for dummy(ie. argument) procedures.
      //cout<<"Search in "<<scope->name<<endl;
      EntryListIterator eli(*scope->children());
      Entry *ce;
      for (;(ce=eli.current());++eli) 
      {
        if (ce->section != Entry::FUNCTION_SEC)
          continue;

        Argument *arg = findArgument(scope->parent(), ce->name, TRUE);
        if(arg != 0) 
	{
          // set type of dummy procedure argument to interface
	  arg->name = arg->type;
          arg->type = scope->name;
        }
      }
    }
  } 
  if (scope->section!=Entry::FUNCTION_SEC) 
  { // not function section 
    // iterate variables: get and apply modifiers
    EntryListIterator eli(*scope->children());
    Entry *ce;
    for (;(ce=eli.current());++eli) 
    {
      if(ce->section != Entry::VARIABLE_SEC && ce->section != Entry::FUNCTION_SEC)
        continue;

      //cout<<ce->name<<", "<<mdfsMap.contains(ce->name.lower())<<mdfsMap.count()<<endl;
      if(mdfsMap.contains(ce->name.lower()))
        applyModifiers(ce, mdfsMap[ce->name.lower()]);
    }
  }

  // clear all modifiers of the scope
  modifiers.remove(scope);

  return TRUE;
}

//! Return full name of the entry. Sometimes we must combine several names recursively.
static QCString getFullName(Entry *e) 
{
  QCString name = e->name;
  if (e->section == Entry::CLASS_SEC //  || e->section == Entry::INTERFACE_SEC
     || !e->parent() || e->parent()->name.isEmpty())
    return name;

  return getFullName(e->parent())+"::"+name;
}

static int yyread(char *buf,int max_size)
{
  int c=0;
  while ( c < max_size && inputString[inputPosition] )
  {
    *buf = inputString[inputPosition++] ;
    c++; buf++;
  }
  return c;
}

static void initParser()
{
  last_entry = 0;
}

static void initEntry()
{
  current->protection = defaultProtection ;
  current->mtype      = mtype;
  current->virt       = virt;
  current->stat       = gstat;
  initGroupInfo(current);
}

/**
  adds current entry to current_root and creates new current
*/
static void addCurrentEntry()
{
  //cout << "Adding entry " <<current->name.data() << endl;
  current_root->addSubEntry(current);
  last_entry = current;
  current = new Entry ;
  initEntry();
}

/*! Adds interface to the root entry.
 * \note Code was brought to this procedure from the parser,
 * because there was/is idea to use it in several parts of the parser.
 */ 
static void addInterface(QCString name) 
{
  current->section = Entry::CLASS_SEC; // was Entry::INTERFACE_SEC;
  current->spec = Entry::Interface;
  current->name = name;

  /* if type is part of a module, mod name is necessary for output */
  if ((current_root) && 
      (current_root->section ==  Entry::CLASS_SEC ||
       current_root->section ==  Entry::NAMESPACE_SEC)) 
  {
    current->name= current_root->name+"::"+current->name;
  }
  if ((current_root) &&
      (current_root->section ==  Entry::FUNCTION_SEC)) 
  {
    current->name = getFullName(current_root) + "__" + QCString(current->name);
  }

  current->fileName = yyFileName;
  current->bodyLine  = yyLineNr; 
  addCurrentEntry();
}


//-----------------------------------------------------------------------------

/*! Update the argument \a name with additional \a type info. 
 */
static Argument *addFortranParameter(const QCString &type,const QCString &name, const QCString docs)
{
  //cout<<"addFortranParameter(): "<<name<<" DOCS:"<<(docs.isNull()?QCString("null"):docs)<<endl;
  Argument *ret = 0;
  if (current_root->argList==0) return 0;
  ArgumentListIterator ali(*current_root->argList);
  Argument *a;
  for (ali.toFirst();(a=ali.current());++ali)
  {
    if (a->type.lower()==name.lower())
    {
      ret=a;
//cout << "addParameter found:   " << type << " , " << name << endl;
      a->type=type.stripWhiteSpace();
      a->name=name.stripWhiteSpace();
      if (!docs.isNull())
        a->docs = docs;
      break;
    }
  } // for
  return ret;
}

  //----------------------------------------------------------------------------
static void startCommentBlock(bool brief)
{
  if (brief)
  {
    current->briefFile = yyFileName;
    current->briefLine = yyLineNr;
  }
  else
  {
    current->docFile = yyFileName;
    current->docLine = yyLineNr;
  }
}

  //----------------------------------------------------------------------------
static void handleCommentBlock(const QCString &doc,bool brief)
{
  docBlockInBody = FALSE;
  bool needsEntry = FALSE;
  static bool hideInBodyDocs = Config_getBool("HIDE_IN_BODY_DOCS");
  int position=0;
  if (docBlockInBody && hideInBodyDocs) return;
  //fprintf(stderr,"call parseCommentBlock [%s]\n",doc.data());
  while (parseCommentBlock(
	g_thisParser,
	docBlockInBody ? last_entry : current,
	doc,        // text
	yyFileName, // file
	brief ? current->briefLine : current->docLine,   // line of block start
	docBlockInBody ? FALSE : brief, 
	docBlockInBody ? FALSE : docBlockJavaStyle,
	docBlockInBody,
	defaultProtection,
        position,
        needsEntry
        )) 
  {
	   //fprintf(stderr,"parseCommentBlock position=%d [%s]  needsEntry=%d\n",position,doc.data()+position,needsEntry);
   if (needsEntry) addCurrentEntry();
  }
  //fprintf(stderr,"parseCommentBlock position=%d [%s]  needsEntry=%d\n",position,doc.data()+position,needsEntry);

  if (needsEntry) addCurrentEntry();
}

//----------------------------------------------------------------------------
static int level=0;
static void debugCompounds(Entry *rt)  // print Entry structure (for debugging)
{
 level++;
  printf("%d) debugCompounds(%s) line %d\n",level, rt->name.data(), rt->bodyLine);
  EntryListIterator eli(*rt->children());
  Entry *ce;
  for (;(ce=eli.current());++eli)
  {
     debugCompounds(ce); 
  } 
level--;
}


static void parseMain(const char *fileName,const char *fileBuf,Entry *rt)
{
  initParser();

  defaultProtection = Public;
  inputString = fileBuf;
  inputPosition = 0;

  //anonCount     = 0;  // don't reset per file
  mtype         = Method;
  gstat         = FALSE;
  virt          = Normal;
  current_root  = rt;
  global_root   = rt;
  inputFile.setName(fileName);
  if (inputFile.open(IO_ReadOnly))
  {
    yyLineNr= 1 ; 
    yyFileName = fileName;
    msg("Parsing file %s...\n",yyFileName.data());

    current_root  = rt ;
    initParser();
    groupEnterFile(yyFileName,yyLineNr);

    current          = new Entry;
    current->name    = yyFileName;
    current->section = Entry::SOURCE_SEC;
    current_root->addSubEntry(current);
    file_root        = current;
    current          = new Entry;

    fscanYYrestart( fscanYYin );
    {
      BEGIN( Start );
    }

    fscanYYlex();
    groupLeaveFile(yyFileName,yyLineNr);

    //debugCompounds(rt); //debug 

    rt->program.resize(0);
    delete current; current=0;
    moduleProcedures.clear();

    inputFile.close();
  }
}

//----------------------------------------------------------------------------

void FortranLanguageScanner::parseInput(const char *fileName,const char *fileBuf,Entry *root)
{
  g_thisParser = this;
  ::parseMain(fileName,fileBuf,root);
}

void FortranLanguageScanner::parseCode(CodeOutputInterface & codeOutIntf,
                   const char * scopeName,
                   const QCString & input,
                   bool isExampleBlock,
                   const char * exampleName,
                   FileDef * fileDef,
                   int startLine,
                   int endLine,
                   bool inlineFragment,
		   MemberDef *memberDef
                  )
{
  ::parseFortranCode(codeOutIntf,scopeName,input,isExampleBlock,exampleName,
                     fileDef,startLine,endLine,inlineFragment,memberDef);
}

bool FortranLanguageScanner::needsPreprocessing(const QCString &extension)
{
  (void)extension;
  return TRUE;
}
void FortranLanguageScanner::resetCodeParserState()
{
  ::resetFortranCodeParserState();
}

void FortranLanguageScanner::parsePrototype(const char *text)
{
  (void)text;
}

static void scanner_abort() 
{
  fprintf(stderr,"********************************************************************\n");
  fprintf(stderr,"Error in file %s line: %d, state: %d\n",yyFileName.data(),yyLineNr,YY_START);
  fprintf(stderr,"********************************************************************\n");
   
  EntryListIterator eli(*global_root->children());
  Entry *ce;
  bool start=FALSE;

  for (;(ce=eli.current());++eli)
  {
     if (ce == file_root) start=TRUE;
     if (start) ce->reset(); 
  } 
  
  return;
  //exit(-1);
}

//----------------------------------------------------------------------------

#if !defined(YY_FLEX_SUBMINOR_VERSION) 
//----------------------------------------------------------------------------
extern "C" { // some bogus code to keep the compiler happy
  void fscannerYYdummy() { yy_flex_realloc(0,0); yy_top_state(); } 
}
#endif