tagmanager/haskell.c

   1
   2 /*
   3 * Copyright (c) 2003, Peter Strand <peter@zarquon.se>
   4 *
   5 * This source code is released for free distribution under the terms of the
   6 * GNU General Public License.
   7 *
   8 * This module contains functions for generating tags for Haskell language
   9 * files.
  10 *
  11 *
  12 *
  13 * Does not handle operators or infix definitions like:
  14 * a `f` b = ...
  15 *
  16 */
  17
  18
  19 /*
  20 *   INCLUDE FILES
  21 */
  22
  23 #include "general.h"    /* must always come first */
  24
  25 #include <string.h>
  26
  27 #include "parse.h"
  28 #include "read.h"
  29 #include "vstring.h"
  30
  31
  32 /*
  33 *   DATA DEFINITIONS
  34 */
  35 typedef enum {
  36     K_TYPE, K_CONSTRUCTOR, K_FUNCTION, K_MODULE
  37 } haskellKind;
  38
  39 static kindOption HaskellKinds [] = {
  40     { TRUE, 't', "typedef", "types" },
  41     { TRUE, 'c', "macro", "type constructors" },
  42     { TRUE, 'f', "function", "functions" },
  43     { TRUE, 'm', "namespace", "modules"}
  44 };
  45
  46
  47 typedef const unsigned char *custr;
  48
  49 /*
  50 *   FUNCTION DEFINITIONS
  51 */
  52
  53
  54 static void skip_rest_of_line(void)
  55 {
  56     int c;
  57     do {
  58         c = fileGetc();
  59     } while (c != EOF && c != '\n');
  60 }
  61
  62 static int get_line(char *buf)
  63 {
  64     int i = 0;
  65     int c;
  66     do {
  67         c = fileGetc();
  68         buf[i++] = c;
  69     } while (c != EOF && c != '\n' && i < 1000);
  70     buf[i] = '\0';
  71     return i;
  72 }
  73
  74 static int get_next_char(void)
  75 {
  76     int c, nxt;
  77     c = fileGetc();
  78     if (c == EOF)
  79         return c;
  80     nxt = fileGetc();
  81     if (nxt == EOF)
  82         return c;
  83     fileUngetc(nxt);
  84
  85     if (c == '-' && nxt == '-') {
  86         skip_rest_of_line();
  87         return get_next_char();
  88     }
  89     if (c == '{' && nxt == '-') {
  90         int last = '\0';
  91         do {
  92             last = c;
  93             c = get_next_char();
  94         } while (! (c == EOF || (last == '-' && c == '}')));
  95         return get_next_char();
  96     }
  97     return c;
  98 }
  99
 100 static void add_tag(const char *token, haskellKind kind, vString *name)
 101 {
 102     int i;
 103     for (i = 0; token[i] != '\0'; ++i)
 104         vStringPut(name, token[i]);
 105
 106     vStringTerminate(name);
 107     makeSimpleTag(name, HaskellKinds, kind);
 108     vStringClear(name);
 109 }
 110
 111 static int isident(char c)
 112 {
 113     return isalnum(c) || c == '_' || c == '\'' || c == '$';
 114 }
 115
 116 static int get_token(char *token, int n)
 117 {
 118     int c = fileGetc();
 119     int i = n;
 120     while (c != EOF && isident(c) && i < 1000) {
 121         token[i] = c;
 122         i++;
 123         c = fileGetc();
 124     }
 125     if (c == EOF)
 126         return 0;
 127     if (i != n) {
 128         token[i] = '\0';
 129         fileUngetc(c);
 130         return 1;
 131     } else {
 132         return 0;
 133     }
 134 }
 135
 136 enum Find_State { Find_Eq, Find_Constr, Get_Extr, Find_Extr, Find_Bar };
 137
 138 static int inside_datatype(vString *name)
 139 {
 140     enum Find_State st = Find_Eq;
 141     int c;
 142     char token[1001];
 143
 144     while (1) {
 145         if (st == Find_Eq)
 146         {
 147             do {
 148                 c = get_next_char();
 149                 if (c == '\n') {
 150                     c = get_next_char();
 151                     if (! (c == ' ' || c == '\t')) {
 152                         return c;
 153                     }
 154                 }
 155             } while (c != EOF && c != '=');
 156             st = Find_Constr;
 157         }
 158         else if (st == Find_Constr)
 159         {
 160             do {
 161                 c = get_next_char();
 162             } while (isspace(c));
 163             if (!isupper(c)) {
 164                     skip_rest_of_line();
 165                     return '\n';
 166             }
 167             token[0] = c;
 168             if (!get_token(token, 1))
 169                 return '\n';
 170             add_tag(token, K_CONSTRUCTOR, name);
 171             st = Find_Extr;
 172         }
 173         else if (st == Find_Extr)
 174         {
 175             c = get_next_char();
 176             if (c == '{')
 177                 st = Get_Extr;
 178             else if (c == '|')
 179                 st = Find_Constr;
 180             else if (c == '\n') {
 181                     c = get_next_char();
 182                     if (! (c == ' ' || c == '\t')) {
 183                         return c;
 184                     }
 185             }
 186             else if (!isspace(c))
 187                 st = Find_Bar;
 188         }
 189         else if (st == Get_Extr)
 190         {
 191             do {
 192                 c = fileGetc();
 193             } while (isspace(c));
 194             if (c == EOF)
 195                 return c;
 196             token[0] = c;
 197             get_token(token, 1);
 198             add_tag(token, K_FUNCTION, name);
 199             do {
 200                 c = get_next_char();
 201                 if (c == '}') {
 202                     st = Find_Bar;
 203                     break;
 204                 }
 205             } while (c != EOF && c != ',');
 206         }
 207         else if (st == Find_Bar)
 208         {
 209             do {
 210                 c = get_next_char();
 211                 if (c == '\n') {
 212                     c = get_next_char();
 213                     if (! (c == ' ' || c == '\t')) {
 214                         return c;
 215                     }
 216                 }
 217             } while (c != EOF && c != '|');
 218             st = Find_Constr;
 219         }
 220     }
 221     return '\n';
 222 }
 223
 224 static void findHaskellTags (int is_literate)
 225 {
 226     vString *name = vStringNew ();
 227     char token[1001], arg[1001];
 228     int c;
 229     int in_tex_lit_code = 0;
 230     c = get_next_char();
 231
 232     while (c != EOF)
 233     {
 234         if (c == '\n') {
 235             c = get_next_char();
 236             continue;
 237         }
 238
 239         if (isspace(c)) {
 240             skip_rest_of_line();
 241             c = get_next_char();
 242             continue;
 243         }
 244         if (is_literate && !in_tex_lit_code) {
 245             if (c == '>') {
 246                 c = fileGetc();
 247                 if (c == ' ') {
 248                     c = get_next_char();
 249                     if (!isident(c)) {
 250                             skip_rest_of_line();
 251                             c = get_next_char();
 252                             continue;
 253                     }
 254                 } else {
 255                     skip_rest_of_line();
 256                     c = get_next_char();
 257                     continue;
 258                 }
 259             } else if (c == '\\') {
 260                 int n = get_line(token);
 261                 if (strncmp(token, "begin{code}", 11) == 0) {
 262                     in_tex_lit_code = 1;
 263                     c = get_next_char();
 264                     continue;
 265                 } else {
 266                     if (n > 0 && token[n-1] != '\n')
 267                         skip_rest_of_line();
 268                     else
 269                         c = get_next_char();
 270                 }
 271                 continue;
 272             } else {
 273                 skip_rest_of_line();
 274                 c = get_next_char();
 275                 continue;
 276             }
 277         }
 278         if (is_literate && in_tex_lit_code && c == '\\') {
 279             if (strncmp(token, "end{code}", 9) == 0) {
 280                 in_tex_lit_code = 0;
 281                 c = get_next_char();
 282                 continue;
 283             }
 284         }
 285         token[0] = c;
 286         token[1] = '\0';
 287         if (!isident(c)) {
 288                 skip_rest_of_line();
 289                 c = get_next_char();
 290                 continue;
 291         }
 292         if (!get_token(token, 1)) {
 293                 c = get_next_char();
 294                 continue;
 295         }
 296         do {
 297             if ((c = fileGetc()) == EOF)
 298                 return;
 299         } while (c == ' ' || c == '\t');
 300         arg[0] = c;
 301         get_token(arg, 1);
 302         if (strcmp(token, "data") == 0 || strcmp(token, "newtype") == 0) {
 303             add_tag(arg, K_TYPE, name);
 304             c = inside_datatype(name);
 305             continue;
 306         }
 307         if (strcmp(token, "type") == 0)
 308             add_tag(arg, K_TYPE, name);
 309         else if (strcmp(token, "module") == 0)
 310             add_tag(arg, K_MODULE, name);
 311         else if (strcmp(token, "instance") == 0 ||
 312                  strcmp(token, "foreign") == 0 ||
 313                  strcmp(token, "import") == 0)
 314             ;
 315         else {
 316             if (arg[0] != ':')
 317                 add_tag(token, K_FUNCTION, name);
 318         }
 319         skip_rest_of_line();
 320         c = get_next_char();
 321     }
 322     vStringDelete(name);
 323 }
 324
 325 static void findNormalHaskellTags (void)
 326 {
 327     findHaskellTags (0);
 328 }
 329
 330 static void findLiterateHaskellTags (void)
 331 {
 332     findHaskellTags (1);
 333 }
 334
 335 extern parserDefinition* HaskellParser (void)
 336 {
 337     static const char *const extensions [] = { "hs", NULL };
 338     parserDefinition* def  = parserNew ("Haskell");
 339
 340     def->kinds      = HaskellKinds;
 341     def->kindCount  = KIND_COUNT(HaskellKinds);
 342     def->extensions = extensions;
 343     def->parser     = findNormalHaskellTags;
 344     return def;
 345 }
 346
 347 extern parserDefinition* LiterateHaskellParser (void)
 348 {
 349     static const char *const extensions [] = { "lhs", NULL };
 350     parserDefinition* def = parserNew ("Literate Haskell");
 351     def->kinds      = HaskellKinds;
 352     def->kindCount  = KIND_COUNT(HaskellKinds);
 353     def->extensions = extensions;
 354     def->parser     = findLiterateHaskellTags;
 355     return def;
 356 }
 357
 358 /* vi:set expandtab tabstop=8 shiftwidth=4: */