/* -*- 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 bool             isFixedForm;

static QCString         inputStringPrepass; ///< Input string for prepass of line cont. '&'

static unsigned int     inputPositionPrepass;

static int              lineCountPrepass = 0;

struct CommentInPrepass {

  int column;

  QCString str;

  CommentInPrepass(int column, QCString str) : column(column), str(str) {}

};

static QList<CommentInPrepass>  comments;

#define MAX_INCLUDE_DEPTH 10

YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];

int include_stack_ptr = 0;

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 addModule(const char *name, bool isModule=FALSE);

static void addSubprogram(const char *text);

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, bool isGlobalRoot=FALSE);

static QCString getFullName(Entry *e);

static bool isTypeName(QCString name);

static void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root);

static int getAmpersandAtTheStart(const char *buf, int length);

static int getAmpOrExclAtTheEnd(const char *buf, int length);

static void truncatePrepass(int index);

static void pushBuffer(QCString &buffer);

static void popBuffer();

static void extractPrefix(QCString& text);

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

#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|block)

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}"*"({BS}[0-9]+|{ARGS}))

TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[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}

CONTAINS  CONTAINS

PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTAL)?

%option noyywrap

%option stack

%option caseless

/*%option debug */

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

 /** fortran parsing states */

%x	Subprog

%x	SubprogPrefix

%x	Parameterlist

%x	SubprogBody

%x	SubprogBodyContains

%x	Start

%x	Comment

%x      Module

%x      Program

%x      ModuleBody

%x	ModuleBodyContains

%x	AttributeList

%x      Variable

%x      Initialization

%x      ArrayInitializer

%x      Typedef

%x      TypedefBody

%x      InterfaceBody

%x      StrIgnore

%x      String

%x      Use

%x      UseOnly

%x      ModuleProcedure

%x      Prepass

 /** comment parsing states */

%x	DocBlock

%x	DocBackLine

%x	EndDoc

%%

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

<*>^.*\n                                { // prepass: look for line continuations

                                          //fprintf(stderr, "---%s", yytext);

                                            int indexStart = getAmpersandAtTheStart(yytext, yyleng);                              

                                            int indexEnd = getAmpOrExclAtTheEnd(yytext, yyleng);

					    if (indexEnd>=0 && yytext[indexEnd]!='&') //we are only interested in amp

					      indexEnd=-1;

                                            if(indexEnd<0){ // ----- no ampersand as line continuation

                                               if(YY_START == Prepass) { // last line in "continuation"

                                                 // Only take input after initial ampersand

                                                 inputStringPrepass+=(const char*)(yytext+(indexStart+1));

                                                 pushBuffer(inputStringPrepass);

                                                 yy_pop_state();

                                               } else { // simple line

                                                 REJECT;

                                               }

                                            } else { // ----- line with continuation

                                              if(YY_START != Prepass) {

                                                comments.setAutoDelete(TRUE);

						comments.clear();

                                                yy_push_state(Prepass);

                                              }

                                              int length = inputStringPrepass.length();

                                              // Only take input after initial ampersand

                                              inputStringPrepass+=(const char*)(yytext+(indexStart+1));

                                              lineCountPrepass ++;

                                              // cut off & and remove following comment if present

					      truncatePrepass(length+indexEnd-(indexStart+1));

                                            }

                                        }

<String>\"|\'                           { // string ends with next quote without previous backspace

                                          if (yytext[0]!=stringStartSymbol) REJECT; // single vs double quote

                                          yy_pop_state();

                                        }           

<*>\"|\'                                { /* string starts */

					  if (YY_START == StrIgnore) REJECT; // ignore in simple comments

                                          yy_push_state(YY_START);

                                          stringStartSymbol=yytext[0]; // single or double quote

                                        }

 /*------ 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_} {

                                          if(YY_START == Start)

                                          {

                                            addModule(NULL); 

                                            yy_push_state(ModuleBody); //anon program

                                          }

                                          yy_push_state(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}\))?)?/{BS}(!|\n) { // handle interface block

                                          if(YY_START == Start)

                                          {

                                            addModule(NULL); 

                                            yy_push_state(ModuleBody); //anon program

                                          }

					  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>^{BS}"end"({BS}"interface"({BS_}{ID})?)?{BS}/(\n|!)   {

					  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>.                        {}

 /*-- Contains handling --*/

<Start>^{BS}{CONTAINS}/({BS}|\n|!)      {

                                          if(YY_START == Start)

                                          {

                                            addModule(NULL); 

                                            yy_push_state(ModuleBodyContains); //anon program

                                          }                                            

                                        }

<ModuleBody>^{BS}{CONTAINS}/({BS}|\n|!)   { BEGIN(ModuleBodyContains); }

<SubprogBody>^{BS}{CONTAINS}/({BS}|\n|!)  { BEGIN(SubprogBodyContains); }

 /*------ module handling ------------------------------------------------------------*/ 

<Start>module|program{BS_}             {  //

					    if(yytext[0]=='m' || yytext[0]=='M')

					      yy_push_state(Module);

					    else

					      yy_push_state(Program);

                                            defaultProtection = Public;

                                       }

<Start,ModuleBody,ModuleBodyContains>^{BS}"end"({BS}(module|program)({BS_}{ID})?)?{BS}/(\n|!) { // end module	

					    resolveModuleProcedures(moduleProcedures, current_root);

					    if (!endScope(current_root))

					      yyterminate();

                                            defaultProtection = Public;

					    yy_pop_state();

                                       }

<Module>{ID}                           {  

                                            addModule(yytext, TRUE);

					    BEGIN(ModuleBody);

                                       }

<Program>{ID}                           {  

                                            addModule(yytext, FALSE);

					    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 |*/

                                          if(YY_START == Start)

                                          {

                                            addModule(NULL); 

                                            yy_push_state(ModuleBody); //anon program

                                          }

 					    yy_push_state(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>^{BS}"end"{BS}"type"({BS_}{ID})?{BS}/(\n|!)         { /* end type definition */

                                           //printf("=========> got typedef end \n"); 

					   if (!endScope(current_root))

					     yyterminate();

                                           yy_pop_state();

                                        } 

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

<SubprogBody,SubprogBodyContains>^{BS}"end"({BS}{SUBPROG}({BS_}{ID})?)?{BS}/(\n|!) {  

                                           //fprintf(stderr,"1e=========> got end subprog: %s\n", yytext);