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