ctags/parsers/pascal.c

   1 /*
   2 *   Copyright (c) 2001-2002, Darren Hiebert
   3 *
   4 *   This source code is released for free distribution under the terms of the
   5 *   GNU General Public License version 2 or (at your option) any later version.
   6 *
   7 *   This module contains functions for generating tags for the Pascal language,
   8 *   including some extensions for Object Pascal.
   9 */
  10
  11 /*
  12 *   INCLUDE FILES
  13 */
  14 #include "general.h"  /* must always come first */
  15
  16 #include <string.h>
  17
  18 #include "entry.h"
  19 #include "parse.h"
  20 #include "read.h"
  21 #include "routines.h"
  22 #include "vstring.h"
  23
  24 /*
  25 *   DATA DEFINITIONS
  26 */
  27 typedef enum {
  28         K_FUNCTION, K_PROCEDURE
  29 } pascalKind;
  30
  31 static kindOption PascalKinds [] = {
  32         { true, 'f', "function",  "functions"},
  33         { true, 'p', "procedure", "procedures"}
  34 };
  35
  36 /*
  37 *   FUNCTION DEFINITIONS
  38 */
  39
  40 static void createPascalTag (tagEntryInfo* const tag,
  41                                                          const vString* const name, const int kind,
  42                                                          const char *arglist, const char *vartype)
  43 {
  44         if (PascalKinds [kind].enabled  &&  name != NULL  &&  vStringLength (name) > 0)
  45         {
  46                 initTagEntry (tag, vStringValue (name), &(PascalKinds [kind]));
  47
  48                 tag->extensionFields.signature = arglist;
  49                 tag->extensionFields.varType = vartype;
  50         }
  51         else
  52                 /* TODO: Passing NULL as name makes an assertion behind initTagEntry failure */
  53                 initTagEntry (tag, NULL, NULL);
  54 }
  55
  56 static void makePascalTag (const tagEntryInfo* const tag)
  57 {
  58         if (tag->name != NULL)
  59                 makeTagEntry (tag);
  60 }
  61
  62 static const unsigned char* dbp;
  63
  64 #define starttoken(c) (isalpha ((int) c) || (int) c == '_')
  65 #define intoken(c)    (isalnum ((int) c) || (int) c == '_' || (int) c == '.')
  66 #define endtoken(c)   (! intoken (c)  &&  ! isdigit ((int) c))
  67
  68 static bool tail (const char *cp)
  69 {
  70         bool result = false;
  71         register int len = 0;
  72
  73         while (*cp != '\0' && tolower ((int) *cp) == tolower ((int) dbp [len]))
  74                 cp++, len++;
  75         if (*cp == '\0' && !intoken (dbp [len]))
  76         {
  77                 dbp += len;
  78                 result = true;
  79         }
  80         return result;
  81 }
  82
  83 static void parseArglist(const char *buf, char **arglist, char **vartype)
  84 {
  85         char *c, *start, *end;
  86         int level;
  87
  88         if (NULL == buf || NULL == arglist)
  89                 return;
  90
  91         c = strdup(buf);
  92         /* parse argument list which can be missing like in "function ginit:integer;" */
  93         if (NULL != (start = strchr(c, '(')))
  94         {
  95                 for (level = 1, end = start + 1; level > 0; ++end)
  96                 {
  97                         if ('\0' == *end)
  98                                 break;
  99                         else if ('(' == *end)
 100                                 ++ level;
 101                         else if (')' == *end)
 102                                 -- level;
 103                 }
 104         }
 105         else /* if no argument list was found, continue looking for a return value */
 106         {
 107                 start = "()";
 108                 end = c;
 109         }
 110
 111         /* parse return type if requested by passing a non-NULL vartype argument */
 112         if (NULL != vartype)
 113         {
 114                 char *var, *var_start;
 115
 116                 *vartype = NULL;
 117
 118                 if (NULL != (var = strchr(end, ':')))
 119                 {
 120                         var++; /* skip ':' */
 121                         while (isspace((int) *var))
 122                                 ++var;
 123
 124                         if (starttoken(*var))
 125                         {
 126                                 var_start = var;
 127                                 var++;
 128                                 while (intoken(*var))
 129                                         var++;
 130                                 if (endtoken(*var))
 131                                 {
 132                                         *var = '\0';
 133                                         *vartype = strdup(var_start);
 134                                 }
 135                         }
 136                 }
 137         }
 138
 139         *end = '\0';
 140         *arglist = strdup(start);
 141
 142         eFree(c);
 143 }
 144
 145
 146 /* Algorithm adapted from from GNU etags.
 147  * Locates tags for procedures & functions.  Doesn't do any type- or
 148  * var-definitions.  It does look for the keyword "extern" or "forward"
 149  * immediately following the procedure statement; if found, the tag is
 150  * skipped.
 151  */
 152 static void findPascalTags (void)
 153 {
 154         vString *name = vStringNew ();
 155         tagEntryInfo tag;
 156         char *arglist = NULL;
 157         char *vartype = NULL;
 158         pascalKind kind = K_FUNCTION;
 159                 /* each of these flags is true iff: */
 160         bool incomment = false;  /* point is inside a comment */
 161         int comment_char = '\0'; /* type of current comment */
 162         bool inquote = false;    /* point is inside '..' string */
 163         bool get_tagname = false;/* point is after PROCEDURE/FUNCTION
 164                 keyword, so next item = potential tag */
 165         bool found_tag = false;  /* point is after a potential tag */
 166         bool inparms = false;    /* point is within parameter-list */
 167         bool verify_tag = false;
 168                 /* point has passed the parm-list, so the next token will determine
 169                  * whether this is a FORWARD/EXTERN to be ignored, or whether it is a
 170                  * real tag
 171                  */
 172
 173         dbp = readLineFromInputFile ();
 174         while (dbp != NULL)
 175         {
 176                 int c = *dbp++;
 177
 178                 if (c == '\0')  /* if end of line */
 179                 {
 180                         dbp = readLineFromInputFile ();
 181                         if (dbp == NULL  ||  *dbp == '\0')
 182                                 continue;
 183                         if (!((found_tag && verify_tag) || get_tagname))
 184                                 c = *dbp++;
 185                                         /* only if don't need *dbp pointing to the beginning of
 186                                          * the name of the procedure or function
 187                                          */
 188                 }
 189                 if (incomment)
 190                 {
 191                         if (comment_char == '{' && c == '}')
 192                                 incomment = false;
 193                         else if (comment_char == '(' && c == '*' && *dbp == ')')
 194                         {
 195                                 dbp++;
 196                                 incomment = false;
 197                         }
 198                         continue;
 199                 }
 200                 else if (inquote)
 201                 {
 202                         if (c == '\'')
 203                                 inquote = false;
 204                         continue;
 205                 }
 206                 else switch (c)
 207                 {
 208                         case '\'':
 209                                 inquote = true;  /* found first quote */
 210                                 continue;
 211                         case '{':  /* found open { comment */
 212                                 incomment = true;
 213                                 comment_char = c;
 214                                 continue;
 215                         case '(':
 216                                 if (*dbp == '*')  /* found open (* comment */
 217                                 {
 218                                         incomment = true;
 219                                         comment_char = c;
 220                                         dbp++;
 221                                 }
 222                                 else if (found_tag)  /* found '(' after tag, i.e., parm-list */
 223                                         inparms = true;
 224                                 continue;
 225                         case ')':  /* end of parms list */
 226                                 if (inparms)
 227                                         inparms = false;
 228                                 continue;
 229                         case ';':
 230                                 if (found_tag && !inparms)  /* end of proc or fn stmt */
 231                                 {
 232                                         verify_tag = true;
 233                                         break;
 234                                 }
 235                                 continue;
 236                 }
 237                 if (found_tag && verify_tag && *dbp != ' ')
 238                 {
 239                         /* check if this is an "extern" declaration */
 240                         if (*dbp == '\0')
 241                                 continue;
 242                         if (tolower ((int) *dbp == 'e'))
 243                         {
 244                                 if (tail ("extern"))  /* superfluous, really! */
 245                                 {
 246                                         found_tag = false;
 247                                         verify_tag = false;
 248                                 }
 249                         }
 250                         else if (tolower ((int) *dbp) == 'f')
 251                         {
 252                                 if (tail ("forward"))  /*  check for forward reference */
 253                                 {
 254                                         found_tag = false;
 255                                         verify_tag = false;
 256                                 }
 257                         }
 258                         else if (tolower ((int) *dbp) == 't')
 259                         {
 260                                 if (tail ("type"))      /*  check for forward reference */
 261                                 {
 262                                         found_tag = false;
 263                                         verify_tag = false;
 264                                 }
 265                         }
 266                         if (found_tag && verify_tag)  /* not external proc, so make tag */
 267                         {
 268                                 found_tag = false;
 269                                 verify_tag = false;
 270                                 makePascalTag (&tag);
 271                                 continue;
 272                         }
 273                 }
 274                 if (get_tagname)  /* grab name of proc or fn */
 275                 {
 276                         const unsigned char *cp;
 277
 278                         if (*dbp == '\0')
 279                                 continue;
 280
 281                         /* grab block name */
 282                         while (isspace ((int) *dbp))
 283                                 ++dbp;
 284                         for (cp = dbp  ;  *cp != '\0' && !endtoken (*cp)  ;  cp++)
 285                                 continue;
 286                         vStringNCopyS (name, (const char*) dbp,  cp - dbp);
 287                         if (arglist != NULL)
 288                                 eFree(arglist);
 289                         if (kind == K_FUNCTION && vartype != NULL)
 290                                 eFree(vartype);
 291                         parseArglist((const char*) cp, &arglist, (kind == K_FUNCTION) ? &vartype : NULL);
 292                         createPascalTag (&tag, name, kind, arglist, (kind == K_FUNCTION) ? vartype : NULL);
 293                         dbp = cp;  /* set dbp to e-o-token */
 294                         get_tagname = false;
 295                         found_tag = true;
 296                         /* and proceed to check for "extern" */
 297                 }
 298                 else if (!incomment && !inquote && !found_tag)
 299                 {
 300                         switch (tolower ((int) c))
 301                         {
 302                                 case 'c':
 303                                         if (tail ("onstructor"))
 304                                         {
 305                                                 get_tagname = true;
 306                                                 kind = K_PROCEDURE;
 307                                         }
 308                                         break;
 309                                 case 'd':
 310                                         if (tail ("estructor"))
 311                                         {
 312                                                 get_tagname = true;
 313                                                 kind = K_PROCEDURE;
 314                                         }
 315                                         break;
 316                                 case 'p':
 317                                         if (tail ("rocedure"))
 318                                         {
 319                                                 get_tagname = true;
 320                                                 kind = K_PROCEDURE;
 321                                         }
 322                                         break;
 323                                 case 'f':
 324                                         if (tail ("unction"))
 325                                         {
 326                                                 get_tagname = true;
 327                                                 kind = K_FUNCTION;
 328                                         }
 329                                         break;
 330                                 case 't':
 331                                         if (tail ("ype"))
 332                                         {
 333                                                 get_tagname = true;
 334                                                 kind = K_FUNCTION;
 335                                         }
 336                                         break;
 337                         }
 338                 }  /* while not eof */
 339         }
 340         if (arglist != NULL)
 341                 eFree(arglist);
 342         if (vartype != NULL)
 343                 eFree(vartype);
 344         vStringDelete (name);
 345 }
 346
 347 extern parserDefinition* PascalParser (void)
 348 {
 349         static const char *const extensions [] = { "p", "pas", NULL };
 350         parserDefinition* def = parserNew ("Pascal");
 351         def->extensions = extensions;
 352         def->kinds      = PascalKinds;
 353         def->kindCount  = ARRAY_SIZE (PascalKinds);
 354         def->parser     = findPascalTags;
 355         return def;
 356 }