ghc/CONTRIB/pphs/pphs.c

   1                                 /* pphs - a pretty printer for Haskell code */
   2 #include <stdio.h>
   3 #include <stdlib.h>
   4 #include <string.h>
   5 #define MAXLINELENGTH 256
   6
   7 enum face {KW, ID, IS, SU, ST, CO, NU, MA, SP, LC, RC, CR, BF, FQ, EQ, DQ, QD, EE, DC, DP, CP, LE, GE, LA, RA, RR, TI, BE};
   8                                 /* Possible values of typeface */
   9
  10 int widecolons = 0;             /* User may want space between double colons */
  11 int subscripts = 0;             /* User may want subscripts after '_' in identifiers */
  12 int tablength = 8;              /* User's input file tablength */
  13
  14 typedef struct ElementType_Tag { /* Basic storage unit */
  15   char chars[MAXLINELENGTH];    /* Characters */
  16   enum face typeface[MAXLINELENGTH]; /* Typefaces */
  17   int indentation, length, col; /* Indentation level, non-empty length, column level */
  18 } ElementType;
  19
  20 typedef struct StackNodeType_Tag *Link; /* Stack-related types */
  21 typedef struct StackNodeType_Tag {
  22   ElementType Element;          /* Stack item */
  23   Link Next;                    /* Link to next node */
  24 } StackNodeType;
  25 typedef StackNodeType *StackNodePtr;
  26 typedef StackNodePtr StackType;
  27
  28 typedef int QueueSizeType;      /* Queue-related types */
  29 typedef struct QueueNodeType_Tag *Connection;
  30 typedef struct QueueNodeType_Tag {
  31   ElementType Element;          /* Queue item */
  32   Connection Next;              /* Link to next node */
  33 } QueueNodeType;
  34 typedef QueueNodeType *QueueNodePtr;
  35 typedef struct QueueType_Tag {
  36   QueueNodePtr Front, Rear;
  37   QueueSizeType Length;
  38 } QueueType;
  39
  40 FILE *ifptr;                    /* input file pointer */
  41
  42                                 /* * * STACK FUNCTIONS * * */
  43 StackType
  44   CreateStack()                 /* Returns an empty stack */
  45 {
  46   return(NULL);
  47 }
  48
  49 int
  50   IsEmptyStack(s)               /* Returns 1 if s is empty, 0 otherwise */
  51 StackType s;
  52 {
  53   return(s == NULL);
  54 }
  55
  56 StackType
  57   Push(s, x)                    /* Returns stack with x pushed onto s */
  58 StackType s;
  59 ElementType x;
  60 {
  61   StackType p;
  62
  63   p = (StackNodeType *) malloc(sizeof(StackNodeType));
  64   if (p == NULL) {
  65     fprintf(stderr, "pphs: Stack is too big\n");
  66     exit(3);
  67   }
  68   else {
  69     (*p).Element = x;
  70     (*p).Next = s;
  71     return(p);
  72   }
  73 }
  74
  75 ElementType
  76   Top(s)                        /* Returns value of top element in s */
  77 StackType s;
  78 {
  79   return((*s).Element);
  80 }
  81
  82 StackType
  83   Pop(s)                        /* Returns stack with top element of s popped off */
  84 StackType s;
  85 {
  86   StackType t;
  87
  88   t = (*s).Next;
  89   free(s);
  90   return(t);
  91 }
  92
  93 StackType
  94   PopSym(s)           /* Returns stack with top element of s popped off without freeing */
  95 StackType s;
  96 {
  97   StackType t;
  98
  99   t = (*s).Next;
 100 /* free(s); As PopSym is called within a function, free would free space needed later */
 101   return(t);
 102 }
 103                                 /* * * QUEUE FUNCTIONS * * */
 104 QueueType
 105   CreateQueue()                 /* Returns an empty queue */
 106 {
 107   QueueType q;
 108
 109   q.Front = NULL;
 110   q.Rear = NULL;
 111   q.Length = 0;
 112   return(q);
 113 }
 114
 115 int
 116   IsEmptyQueue(q)               /* Returns 1 if q is empty, 0 otherwise */
 117 QueueType q;
 118 {
 119   return(q.Front == NULL);
 120 }
 121
 122 int
 123   LengthOfQueue(q)              /* Returns length of q */
 124 QueueType q;
 125 {
 126   return(q.Length);
 127 }
 128
 129 QueueNodePtr
 130   FrontOfQueue(q)               /* Returns pointer to front of q */
 131 QueueType q;
 132 {
 133   return(q.Front);
 134 }
 135
 136 QueueNodePtr
 137   RearOfQueue(q)                /* Returns pointer to rear of q */
 138 QueueType q;
 139 {
 140   return(q.Rear);
 141 }
 142
 143 QueueType
 144   AddToQueue(q, x)              /* Adds item x to rear of queue q */
 145 QueueType q;
 146 ElementType x;
 147 {
 148   QueueNodePtr p;
 149
 150   p = (QueueNodeType *) malloc(sizeof(QueueNodeType));
 151   if (p == NULL) {
 152     fprintf(stderr, "pphs: Queue is too big\n");
 153     exit(4);
 154   }
 155   else {
 156     (*p).Element = x;
 157     (*p).Next = NULL;
 158     if (q.Front == NULL)
 159       q.Front = p;
 160     else
 161       (*(q.Rear)).Next = p;
 162     q.Rear = p;
 163     q.Length++;
 164     return(q);
 165   }
 166 }
 167
 168 QueueType
 169   TakeFromQueue(q)              /* Removes front item from queue */
 170 QueueType q;
 171 {
 172   QueueNodePtr p;
 173
 174   if (q.Front == NULL) {
 175     fprintf(stderr, "pphs: Stack underflow\n");
 176     exit(5);
 177   }
 178   else {
 179     p = q.Front;
 180     q.Front = (*(q.Front)).Next;
 181     if (q.Front == NULL)
 182       q.Rear = NULL;
 183     q.Length--;
 184     free(p);
 185     return(q);
 186   }
 187 }
 188                                 /* * * TYPEFACE FUNCTIONS * * */
 189 int
 190   IsMathsChar(c)                /* Returns 1 if c is a character to be in maths */
 191 char c;
 192 {
 193   return((c == '[') || (c == ']') || (c == '/') || (c == ',') || (c == '!')
 194          || (c == ':') || (c == ';') || (c == '(') || (c == ')') || (c == '&')
 195          || (c == '#') || (c == '+') || (c == '-') || (c == '<') || (c == '>')
 196          || (c == '{') || (c == '}') || (c == '=') || (c == '|') || (c == '\'')
 197          || (c == '^'));
 198 }
 199
 200 ElementType
 201   ChangeTypeface(store, length, finish, tf) /* Changes the typeface to tf in store
 202                                                for length until finish */
 203 ElementType store;
 204 int length, finish;
 205 enum face tf;
 206 {
 207   int counter;
 208
 209   for (counter = (finish - length); counter < finish; counter++)
 210     store.typeface[counter] = tf;
 211   return(store);
 212 }
 213
 214 ElementType
 215   CheckForDoubleChar(store, position) /* Checks for double character
 216                                          in store.chars[position - 2..position - 1],
 217                                          if found alters typeface */
 218 ElementType store;
 219 int position;
 220 {
 221   if ((position >= 2) && (store.typeface[position - 2] != DC)) {
 222     if ((store.chars[position - 2] == '-') && (store.chars[position - 1] == '-')) {
 223       store.typeface[position - 2] = LC; /* Haskell "--" line comment */
 224       store.typeface[position - 1] = LC;
 225     }
 226     else if ((store.chars[position - 2] == '{') && (store.chars[position - 1] == '-')) {
 227       store.typeface[position - 2] = RC; /* Haskell "{-" regional comment begin */
 228       store.typeface[position - 1] = DC;
 229     }
 230     else if ((store.chars[position - 2] == '-') && (store.chars[position - 1] == '}')) {
 231       store.typeface[position - 2] = CR; /* Haskell "-}" regional comment end */
 232       store.typeface[position - 1] = DC;
 233     }
 234     else if ((store.chars[position - 2] == '+') && (store.chars[position - 1] == '+')) {
 235       store.typeface[position - 2] = DP; /* Double plus */
 236       store.typeface[position - 1] = DC;
 237     }
 238     else if ((store.chars[position - 2] == ':') && (store.chars[position - 1] == '+')) {
 239       store.typeface[position - 2] = CP; /* Colon plus */
 240       store.typeface[position - 1] = DC;
 241     }
 242     else if ((store.chars[position - 2] == '<') && (store.chars[position - 1] == '=')) {
 243       store.typeface[position - 2] = LE; /* Less than or equal to */
 244       store.typeface[position - 1] = DC;
 245     }
 246     else if ((store.chars[position - 2] == '>') && (store.chars[position - 1] == '=')) {
 247       store.typeface[position - 2] = GE; /* Greater than or equal to */
 248       store.typeface[position - 1] = DC;
 249     }
 250     else if ((store.chars[position - 2] == '<') && (store.chars[position - 1] == '-')) {
 251       store.typeface[position - 2] = LA; /* Leftarrow */
 252       store.typeface[position - 1] = DC;
 253     }
 254     else if ((store.chars[position - 2] == '-') && (store.chars[position - 1] == '>')) {
 255       store.typeface[position - 2] = RA; /* Rightarrow */
 256       store.typeface[position - 1] = DC;
 257     }
 258     else if ((store.chars[position - 2] == '=') && (store.chars[position - 1] == '>')) {
 259       store.typeface[position - 2] = RR; /* Double rightarrow */
 260       store.typeface[position - 1] = DC;
 261     }
 262     else if (((store.chars[position - 2] == '*') && (store.chars[position - 1] == '*'))
 263              || ((store.chars[position - 2] == '^') && (store.chars[position - 1] == '^'))) {
 264       store.typeface[position - 2] = MA; /* Exponent, ie not Times */
 265       store.typeface[position - 1] = MA;
 266     }
 267   }
 268   return(store);
 269 }
 270
 271 int
 272   IsHaskellPunc(c)     /* Returns 1 if c is a punctuation mark not part of identifier */
 273 char c;
 274 {
 275   return((c == ' ') || (c == ',') || (c == '@') || (c == '#') || (c == '$')
 276          || (c == '%') || (c == '&') || (c == '*') || (c == '(') || (c == ')')
 277          || (c == '-') || (c == '+') || (c == '=') || (c == '\\') || (c == '|')
 278          || (c == '[') || (c == ']') || (c == '{') || (c == '}') || (c == ':')
 279          || (c == ';') || (c == '"') || (c == '~') || (c == '?') || (c == '/')
 280          || (c == '<') || (c == '>') || (c == '^'));
 281 }
 282
 283 int
 284   IsKeyWord(str)                /* Returns 1 if str is a keyword to be in keyword font */
 285 char str[MAXLINELENGTH];
 286 {
 287   return((!(strcmp(str, "case"))) || (!(strcmp(str, "class")))
 288          || (!(strcmp(str, "data"))) || (!(strcmp(str, "default")))
 289          || (!(strcmp(str, "deriving"))) || (!(strcmp(str, "else")))
 290          || (!(strcmp(str, "hiding"))) || (!(strcmp(str, "if")))
 291          || (!(strcmp(str, "import"))) || (!(strcmp(str, "in")))
 292          || (!(strcmp(str, "infix"))) || (!(strcmp(str, "infixl")))
 293          || (!(strcmp(str, "infixr"))) || (!(strcmp(str, "instance")))
 294          || (!(strcmp(str, "interface"))) || (!(strcmp(str, "let")))
 295          || (!(strcmp(str, "module"))) || (!(strcmp(str, "of")))
 296          || (!(strcmp(str, "renaming"))) || (!(strcmp(str, "then")))
 297          || (!(strcmp(str, "to"))) || (!(strcmp(str, "type")))
 298          || (!(strcmp(str, "where"))));
 299 }
 300
 301 int
 302   KeyWord(c, store, position) /* Returns length of keyword if a keyword ends
 303                                        at store.chars[position - 1] */
 304 char c;
 305 ElementType store;
 306 int position;
 307 {
 308   int counter, start, end = position - 1, keywordlen = 0;
 309   char str[MAXLINELENGTH];
 310
 311   if ((!isalpha(c)) && (c != '_') && (c != '\'') && (position)) {
 312     for (counter = end; (counter >= 0) && ((isalpha(store.chars[counter]))
 313                                            || (c == '_') || (c == '\''))
 314                                        && (counter >= store.indentation); counter--) {
 315       ;  /* Just count letters */
 316     }
 317     start = ++counter;
 318     for (counter = 0; counter + start <= end; counter++) {
 319       str[counter] = store.chars[counter + start]; /* Copy letters into str */
 320     }
 321     str[counter] = '\0'; /* Add null character to end */
 322     if (IsKeyWord(str))         /* Checks word in str is keyword */
 323       keywordlen = strlen(str); /* and measures it */
 324   }
 325   return(keywordlen);
 326 }
 327
 328 ElementType
 329   CheckForKeyword(c, store, position) /* Returns store with any possible keyword
 330                                          ending at store.chars[position - 1]
 331                                          identified as such in store.typeface */
 332 char c;
 333 ElementType store;
 334 int position;
 335 {
 336   if (KeyWord(c, store, position))
 337     store = ChangeTypeface(store, KeyWord(c, store, position), position, KW);
 338   return(store);
 339 }
 340
 341 int
 342   IsNumber(c, store, position, statesok) /* Returns 1 if c forms part of a number */
 343 char c;
 344 ElementType store;
 345 int position, statesok;
 346 {
 347   int counter, foundident = 0, foundpunc = 0;
 348
 349   if (((isdigit(c)) || (c == 'e') || (c == 'E') || (c == '|') || (c == '.'))
 350       && (statesok)) {
 351     counter = position - 1;
 352     while ((isdigit(store.chars[counter])) && (counter >= 0))
 353       counter--;
 354     if (((store.chars[counter] == '+') || (store.chars[counter] == '-'))
 355         && ((store.chars[counter - 1] == 'e') || (store.chars[counter - 1] == 'E'))
 356         && (counter > 2))
 357       counter -= 2;
 358     else if (((store.chars[counter] == 'e') || (store.chars[counter] == 'E'))
 359              && (counter > 1))
 360       counter--;
 361     while ((isdigit(store.chars[counter])) && (counter >= 0))
 362       counter--;
 363     if ((store.chars[counter] == '.') && (counter > 1))
 364       counter--;
 365     while ((isdigit(store.chars[counter])) && (counter >= 0))
 366       counter--;
 367     if ((isalpha(store.chars[counter])) && (counter >= 0))
 368       foundident = 1;           /* ie not number */
 369     else if ((IsHaskellPunc(store.chars[counter])) || (counter < 0))
 370       foundpunc = 1; /* ie is number */
 371   }
 372   return(foundpunc);
 373 }
 374                                 /* * * LINE SELECTION FUNCTIONS * * */
 375 ElementType
 376   SelectSkipLine(s, store, linecounter) /* Returns store containing line for skipover */
 377 StackType s;
 378 ElementType store;
 379 int linecounter;
 380 {
 381   ElementType temp;
 382   int counter;
 383
 384   if (!(IsEmptyStack(s))) {
 385     while (((Top(s)).length <= linecounter) || ((Top(s)).indentation >= linecounter)) {
 386       temp = Top(s);
 387       s = PopSym(s);
 388       if (IsEmptyStack(s)) {
 389         counter = temp.length;
 390         while (counter < linecounter) {
 391           temp.chars[counter] = ' ';
 392           temp.typeface[counter++] = SP;
 393         }
 394         temp.chars[counter] = '\0'; /* Add null character to end */
 395         s = Push(s, temp);
 396         break;
 397       }
 398     }
 399     store = Top(s);
 400   }
 401   else {                        /* Stack is empty */
 402     counter = store.length;
 403     while (counter < linecounter) {
 404       store.chars[counter] = ' ';
 405       store.typeface[counter++] = SP;
 406     }
 407     store.chars[counter] = '\0'; /* Add null character to end */
 408   }
 409   return(store);
 410 }
 411                                 /* * * STORING FUNCTIONS * * */
 412 ElementType
 413   CreateStore()                 /* Returns an empty store */
 414 {
 415   ElementType store;
 416
 417   strcpy(store.chars, "");
 418   store.length = 0;
 419   store.indentation = 0;
 420   store.col = 0;
 421   return(store);
 422 }
 423
 424 ElementType
 425   StoreSpace(store, position) /* Stores a space in the store at current position */
 426 ElementType store;
 427 int position;
 428 {
 429   store.chars[position] = ' ';
 430   store.typeface[position] = SP;
 431   return(store);
 432 }
 433                                 /* * * WRITING FUNCTIONS * * */
 434 void
 435   WriteStartFace(tf)            /* Writes LaTeX typeface commands for start of section */
 436 enum face tf;
 437 {
 438   if (tf == KW)                 /* Keywords */
 439     printf("{\\keyword ");
 440   else if ((tf == ID) || (tf == IS)) /* Identifiers */
 441     printf("{\\iden ");
 442   else if (tf == ST)            /* Strings */
 443     printf("{\\stri ");
 444   else if (tf == CO)            /* Comments */
 445     printf("{\\com ");
 446   else if (tf == NU)            /* Numbers */
 447     printf("{\\numb ");
 448   else if ((tf == MA) || (tf == TI)) /* Various maths */
 449     printf("$");
 450 }
 451
 452 void
 453   WriteFinishFace(tf)           /* Writes LaTeX typeface commands for end of section */
 454 enum face tf;
 455 {
 456   if ((tf == KW) || (tf == ID) || (tf == ST) || (tf == CO)
 457       || (tf == NU)) /* Keywords, identifiers, strings, comments or numbers */
 458     printf("\\/}");
 459   else if ((tf == MA) || (tf == TI)) /* Various maths */
 460     printf("$");
 461   else if (tf == IS) /* Subscripts in identifiers */
 462     printf("\\/}$");
 463 }
 464
 465 int
 466   WriteSpaces(store, counter, finish) /* Writes consecutive spaces,
 467                                          returning new counter value */
 468 ElementType store;
 469 int counter, finish;
 470 {
 471   int spaces = 0;               /* The number of spaces found */
 472
 473   for (; (store.typeface[counter] == SP) && (counter < finish); counter++)
 474     spaces++;
 475   printf("\\xspa{%d}", spaces);
 476   return(--counter);
 477 }
 478
 479 int
 480   WriteChar(store, counter, finish)     /* Writes charater, returning new counter value */
 481 ElementType store;
 482 int counter, finish;
 483 {
 484   if (store.typeface[counter] == SP) /* Space */
 485     printf("\\xspa1");  /* Redundant */
 486   else if (store.typeface[counter] == BE) /* Bar under equals sign */
 487     printf("\\bareq");
 488   else if (store.typeface[counter] == DP) { /* Double plus */
 489     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 490       printf("\\plusplus");
 491       counter++;
 492     }
 493   }
 494   else if (store.typeface[counter] == CP) { /* Colon plus */
 495     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 496       printf("{:}{+}");
 497       counter++;
 498     }
 499   }
 500   else if (store.typeface[counter] == LE) { /* Less than or equal to */
 501     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 502       printf("$\\leq$");
 503       counter++;
 504     }
 505   }
 506   else if (store.typeface[counter] == GE) { /* Greater than or equal to */
 507     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 508       printf("$\\geq$");
 509       counter++;
 510     }
 511   }
 512   else if (store.typeface[counter] == LA) { /* Leftarrow */
 513     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 514       printf("$\\leftarrow$");
 515       counter++;
 516     }
 517   }
 518   else if (store.typeface[counter] == RA) { /* Rightarrow */
 519     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 520       printf("$\\rightarrow$");
 521       counter++;
 522     }
 523   }
 524   else if (store.typeface[counter] == RR) { /* Double rightarrow */
 525     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 526       printf("$\\Rightarrow$");
 527       counter++;
 528     }
 529   }
 530   else if (store.typeface[counter] == RC) { /* Regional comment begin */
 531     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 532       printf("{\\com \\{-\\/}");
 533       counter++;
 534     }
 535     else
 536       printf("{\\com \\{\\/}");
 537   }
 538   else if (store.typeface[counter] == CR) { /* Regional comment end */
 539     if ((counter < finish - 1) && (store.typeface[counter + 1] == DC)) {
 540       printf("{\\com -\\}\\/}");
 541       counter++;
 542     }
 543     else
 544       printf("{\\com -\\/}");
 545   }
 546   else if ((store.typeface[counter] == LC) && (store.chars[counter] == '-'))
 547     printf("{\\rm -}"); /* Comment - problem: "--" becomes "-" in LaTeX so fix done */
 548   else if (store.chars[counter] == '\\')
 549     printf("\\hbox{$\\setminus$}"); /* Backslash */
 550   else if (store.chars[counter] == '*') {
 551     if (store.typeface[counter] == TI)
 552       printf("\\times ");       /* Multiplication */
 553     else
 554       printf("*");              /* Other star symbols, eg Exponent */
 555   }
 556   else if ((store.chars[counter] == '_') && (store.typeface[counter] == SU)) {
 557       if ((counter < finish - 1) && (store.typeface[counter + 1] == IS))
 558         printf("$_");           /* Subscript character */
 559   }
 560   else if (store.chars[counter] == '^')
 561     printf("\\char'136 ");      /* Up-arrow */
 562   else if (store.chars[counter] == '~')
 563     printf("\\char'176 ");      /* Tilda */
 564   else if ((store.chars[counter] == ':') && (store.chars[counter - 1] == ':')
 565            && (widecolons))
 566     printf("\\,:");     /* Double colon */
 567   else if (store.chars[counter] == '"') {
 568     if ((counter) && ((store.chars[counter - 1] == '"')
 569                       || (store.chars[counter - 1] == '\'')))
 570       printf("\\,");    /* If previous character was a quote, leave a little space */
 571     if (store.typeface[counter] == DQ)
 572       printf("{\\rm ``}");      /* Open doublequote */
 573     else if (store.typeface[counter] == QD)
 574       printf("{\\rm \"}");      /* Close doublequote */
 575     else
 576       printf("{\\rm \\char'175}"); /* Escape doublequote in string */
 577   }
 578   else if (store.chars[counter] == '\'') {
 579     if ((counter) && ((store.chars[counter - 1] == '"')
 580                       || ((store.chars[counter - 1] == '\'')
 581                           && ((store.typeface[counter - 1] != MA)
 582                               || (store.typeface[counter] != MA)))))
 583       printf("\\,");    /* If previous character was a quote, leave a little space
 584                            except when it's a double prime */
 585     if (store.typeface[counter] == FQ)
 586       printf("\\forquo ");      /* Forward single quote */
 587     else if (store.typeface[counter] == EQ)
 588       printf("\\escquo ");      /* Escape single quote */
 589     else if (store.typeface[counter] == BF) {
 590       if ((counter + 1 < store.length) && (store.typeface[counter + 1] == BF)
 591           && (counter + 1 != store.indentation)) {
 592         printf("{\\com \'\'\\/}"); /* Closing LaTeX style quote */
 593         counter++;
 594       }
 595       else
 596         printf("{\\com \'\\/}"); /* Single quote following backquote in comment */
 597     }
 598     else
 599       printf("\'");             /* Prime */
 600   }
 601   else if (store.chars[counter] == '{')
 602     printf("\\hbox{$\\cal \\char'146$}"); /* Open curly bracket */
 603   else if (store.chars[counter] == '}')
 604     printf("\\hbox{$\\cal \\char'147$}"); /* Close curly bracket */
 605   else if ((counter) && (store.chars[counter - 1] == '[') && (store.chars[counter] == ']'))
 606     printf("\\,]");             /* Leave small gap between adjacent square brackets */
 607   else if ((store.chars[counter] == '$') || (store.chars[counter] == '%')
 608            || (store.chars[counter] == '_') || (store.chars[counter] == '#')
 609            || (store.chars[counter] == '&')) /* Various characters needing '\' for LaTeX */
 610     printf("\\%c", store.chars[counter]);
 611   else                          /* Other characters */
 612     printf("%c", store.chars[counter]);
 613   return(counter);
 614 }
 615
 616 void
 617   WriteSkipover(store) /* Writes the skipover portion of line in store */
 618 ElementType store;
 619 {
 620   int counter = 0;
 621
 622   printf("\\skipover{");        /* Write opening LaTeX skipover command */
 623   WriteStartFace(store.typeface[counter]); /* Write opening LaTeX typeface command */
 624   if (store.typeface[counter] == SP)
 625     counter = WriteSpaces(store, counter, store.indentation); /* Write spaces */
 626   else
 627     counter = WriteChar(store, counter, store.indentation); /* Write character */
 628   for (counter++; counter < store.indentation; counter++){ /* until end of skipover */
 629     if (store.typeface[counter - 1] != store.typeface[counter]) { /* If typeface change */
 630       WriteFinishFace(store.typeface[counter - 1]); /* write closing typeface command */
 631       WriteStartFace(store.typeface[counter]); /* write opening LaTeX typeface command */
 632     }
 633     if (store.typeface[counter] == SP)
 634       counter = WriteSpaces(store, counter, store.indentation); /* Write spaces */
 635     else
 636       counter = WriteChar(store, counter, store.indentation); /* Write character */
 637   }
 638   if (store.typeface[counter - 1] == SU)
 639     ;           /* If indentation is under subscript don't open math section */
 640   else
 641     WriteFinishFace(store.typeface[counter - 1]); /* Write closing LaTeX typeface command */
 642   printf("}");                  /* Write closing LaTeX skipover command */
 643 }
 644
 645 void
 646   WriteWords(store)             /* Writes rest of line, starting at indentation level */
 647 ElementType store;
 648 {
 649   int counter = store.indentation;
 650   int intabular = 0;           /* Boolean: is in tabular section for internal alignment */
 651
 652   WriteStartFace(store.typeface[counter]); /* Write opening LaTeX typeface command */
 653   if (store.typeface[counter] == SP)
 654     counter = WriteSpaces(store, counter, store.length); /* Write spaces */
 655   else
 656     counter = WriteChar(store, counter, store.length); /* Write character */
 657   for (counter++; counter < store.length; counter++){ /* until end of word */
 658     if ((store.col) && (store.col == counter)) {
 659       printf(" & ");
 660       if (store.chars[counter - 1] == ':')
 661         printf("$:");
 662       intabular = 1;
 663     }
 664     if (store.typeface[counter - 1] != store.typeface[counter]) /* If typeface change */
 665       WriteFinishFace(store.typeface[counter - 1]); /* Write closing typeface command */
 666     if ((store.typeface[counter] == SP) && (intabular)) {
 667       printf(" & ");
 668       intabular = 0;
 669     }
 670     if ((store.typeface[counter - 1] != store.typeface[counter]) /* If typeface change */
 671         && ((store.chars[counter] != ':') || (store.col != counter + 1)))
 672       WriteStartFace(store.typeface[counter]); /* Write opening LaTeX typeface command */
 673     if (store.typeface[counter] == SP)
 674       counter = WriteSpaces(store, counter, store.length); /* Write spaces */
 675     else if ((store.chars[counter] != ':') || (!store.col) || (store.col != counter + 1))
 676       counter = WriteChar(store, counter, store.length); /* Write character */
 677   }
 678   WriteFinishFace(store.typeface[counter - 1]); /* Write closing LaTeX typeface command */
 679 }
 680
 681 void
 682   WriteLine(store, needed)      /* Writes the line in store,
 683                                    only writing LaTeX newline if needed */
 684 ElementType store;
 685 int needed;
 686 {
 687   if (store.indentation)
 688     WriteSkipover(store);
 689   if (store.indentation < store.length)
 690     WriteWords(store);
 691   if (needed)
 692     printf("\\\\");             /* LaTeX newline character */
 693   printf("\n");
 694 }
 695
 696 QueueType
 697   WriteQueue(q)                 /* Writes lines, removing them from queue,
 698                                    leaves last line in queue if not in tabular section */
 699 QueueType q;
 700 {
 701   int intabular = 0;
 702
 703   if ((!(IsEmptyQueue(q))) && ((*(FrontOfQueue(q))).Element.col)) {
 704     printf("\\begin{tabular}{@{}l@{\\xspa1}c@{}l}\n");
 705     intabular = 1;
 706   }
 707   while (LengthOfQueue(q) > !intabular) {
 708     WriteLine((*(FrontOfQueue(q))).Element, 1); /* LaTeX newline character is needed */
 709     q = TakeFromQueue(q);
 710   }
 711   if (intabular)
 712     printf("\\end{tabular}\\\\\n");
 713   return(q);
 714 }
 715
 716 QueueType
 717   WriteRestOfQueue(q)           /* Writes all lines, removing them from queue,
 718                                    doesn't have LaTeX newline after last line */
 719 QueueType q;
 720 {
 721   int intabular = 0;
 722
 723   if ((!(IsEmptyQueue(q))) && ((*(FrontOfQueue(q))).Element.col)) {
 724     printf("\\begin{tabular}{@{}l@{\\xspa1}c@{}l}\n");
 725     intabular = 1;
 726   }
 727   while (!(IsEmptyQueue(q))) {
 728     WriteLine((*(FrontOfQueue(q))).Element, (LengthOfQueue(q) > 1)); /* Last line doesn't
 729                                                            need LaTeX newline character */
 730     q = TakeFromQueue(q);
 731   }
 732   if (intabular) {
 733     printf("\\end{tabular}");
 734     if (!IsEmptyQueue(q))       /* Last line doesn't need LaTeX newline character */
 735       printf("\\\\");
 736     printf("\n");
 737   }
 738   return(q);
 739 }
 740
 741 int
 742 main (argc, argv)               /* * * MAIN PROGRAM * * */
 743      int argc;
 744      char *argv[];
 745 {
 746   int tripped = 1, instring = 0, instringincomment = 0, inlinecomment = 0;
 747   int incharquote = 0, incharquoteincomment = 0, inbackquoteincomment = 0;
 748   int insub = 0;
 749   /* Booleans - just taken new line, in string, in string inside comment, in line comment,
 750      in character quote, in character quote inside comment, in backquote inside comment,
 751      in subscript */
 752   int linecounter = 0, indentcounter = 0, inregcomment = 0, pos;
 753   /* Counters: current position on line, indentation of current line,
 754      nesting level of regional comments, position marker */
 755   char c;                       /* Character */
 756   StackType s;                  /* Stack of previous longest lines */
 757   QueueType q;                  /* Queue of lines waiting to be printed */
 758   ElementType store;            /* Store of letters, typefaces and non-empty length */
 759
 760   if ((argc == 3) && (argv[1][0] == '-')) { /* If options specified with call */
 761     if (strstr(argv[1], "s"))   /* if -s option, subscripts in identifiers wanted */
 762       subscripts = 1;
 763     if (strstr(argv[1], "t")) { /* if -tX option, tab characters are X spaces */
 764       for (pos = 1; (argv[1][pos] != 't'); pos++) /* find 't' */
 765         ;
 766       for (pos++, tablength = 0; isdigit(argv[1][pos]); pos++) /* read number */
 767         tablength = (tablength * 10) + (argv[1][pos] - '0');
 768     }
 769     if (strstr(argv[1], "w"))   /* if -w option called, wide double colons wanted */
 770       widecolons = 1;
 771   }
 772   else if (argc == 2)           /* If no options */
 773     ;
 774   else {                        /* If not called with pphs and a filename */
 775     fprintf(stderr, "pphs: Call with one file name\n");
 776     exit(1);
 777   }
 778
 779   if ((strcspn(argv[argc - 1], ".") == strlen(argv[argc - 1])) /* If filename has no extention */
 780       && ((ifptr = fopen(argv[argc - 1], "r")) == NULL)) /* and no plain file of that name */
 781     strcat(argv[argc - 1], ".hs"); /* add a ".hs" extention */
 782   if ((ifptr = fopen(argv[argc - 1], "r")) == NULL) { /* Open input file */
 783     fprintf(stderr, "pphs: File could not be opened\n"); /* eg isn't there */
 784     exit(2);
 785   }
 786   else {
 787
 788     printf("\\begin{tabbing}\n"); /* Start of Haskell program */
 789
 790     store = CreateStore();      /* an empty one */
 791     s = CreateStack();          /* an empty one */
 792     q = CreateQueue();          /* an empty one */
 793
 794     fscanf(ifptr, "%c", &c);    /* Read character */
 795     while (!feof(ifptr)) {      /* While not at end of input file */
 796       while ((isspace(c)) && (!(feof(ifptr)))) { /* Read blank characters */
 797         if (c == ' ') {
 798           if (tripped)
 799             linecounter++;      /* Count leading spaces */
 800           else {                /* or */
 801             store = StoreSpace(store, linecounter++); /* Store intermediate
 802                                                          or trailing space */
 803             if (store.length < linecounter)
 804               store.chars[linecounter] = '\0'; /* Add null character to end */
 805           }
 806           fscanf(ifptr, "%c", &c); /* Read next character */
 807         }
 808         else if (c == '\t') {
 809           if (tripped)
 810             linecounter += (tablength - (linecounter % tablength));
 811           else {
 812             store = StoreSpace(store, linecounter++);
 813             for (; linecounter % tablength; linecounter++)
 814               store = StoreSpace(store, linecounter);
 815             if (store.length < linecounter)
 816               store.chars[linecounter] = '\0'; /* Add null character to end */
 817           }
 818           fscanf(ifptr, "%c", &c); /* Read next character */
 819         }
 820         else if (c == '\n') {
 821           tripped = 1;          /* Just taken a new line */
 822           inlinecomment = 0;
 823           if (!(IsEmptyStack(s)))
 824             while (((Top(s)).length <= store.length)
 825                    && ((Top(s)).indentation >= store.length)) {
 826               s = Pop(s);
 827               if (IsEmptyStack(s))
 828                 break;
 829             }
 830           if (store.length > 0) { /* Push non-empty line onto indentation stack */
 831             store.indentation = indentcounter;
 832             s = Push(s, store);
 833           }
 834           if (!(IsEmptyQueue(q))) {
 835             if ((store.col != (*(FrontOfQueue(q))).Element.col)
 836                 || (!(*(FrontOfQueue(q))).Element.col))
 837               q = WriteQueue(q); /* If internal alignment changes or there is none
 838                                     write out lines */
 839           }
 840           q = AddToQueue(q, store); /* Add to writing queue */
 841           linecounter = 0;      /* Get ready to count leading spaces */
 842           store.length = linecounter;
 843           fscanf(ifptr, "%c", &c); /* Read next character */
 844         }
 845         else break;
 846       }
 847       if (tripped) {
 848         indentcounter = linecounter;
 849         store.indentation = linecounter;
 850         store.col = 0;
 851       }
 852       if ((tripped) && (linecounter)) { /* Skipover necessary for indentation */
 853         store = SelectSkipLine(s, store, linecounter);
 854         store.indentation = linecounter;
 855         store.col = 0;
 856       }
 857       if (!feof(ifptr))
 858         tripped = 0;            /* No longer just taken new line */
 859       while ((!(isspace(c))) && (!(feof(ifptr)))) { /* Read word */
 860         if ((linecounter > 1) && (!IsEmptyQueue(q))
 861             && ((*(RearOfQueue(q))).Element.length >= linecounter)
 862             && (linecounter > store.indentation)
 863             && (linecounter > (*(RearOfQueue(q))).Element.indentation)
 864             && (store.chars[linecounter - 1] == ' ')
 865             && ((((*(RearOfQueue(q))).Element.chars[linecounter - 1] == ' ')
 866                  && ((c == (*(RearOfQueue(q))).Element.chars[linecounter])
 867                      || ((c == '=')
 868                          && ((*(RearOfQueue(q))).Element.chars[linecounter] == ':')
 869                          && ((*(RearOfQueue(q))).Element.chars[linecounter + 1] == ':'))))
 870                 || (((*(RearOfQueue(q))).Element.chars[linecounter - 1] == ':')
 871                     && ((*(RearOfQueue(q))).Element.chars[linecounter] == ':')
 872                     && (c == '=')))
 873             && ((store.chars[linecounter - 2] == ' ')
 874                 || ((*(RearOfQueue(q))).Element.chars[linecounter - 2] == ' '))
 875             && (((*(RearOfQueue(q))).Element.col == 0)
 876                 || ((*(RearOfQueue(q))).Element.col == linecounter))) {
 877           store.col = linecounter; /* Identify any internal alignment */
 878           (*(RearOfQueue(q))).Element.col = linecounter;
 879         }
 880         if ((c == '"') && (!incharquote) /* String outside comments */
 881             && (!inregcomment) && (!inlinecomment)) {
 882           if (((linecounter) && (store.chars[linecounter - 1] != '\\'))
 883               || (!linecounter))
 884             instring = !instring;
 885         }
 886         else if ((c == '"') && (!incharquoteincomment) /* String inside comment */
 887                  && (!inbackquoteincomment)
 888                  && ((inregcomment) || (inlinecomment))) {
 889           if (((linecounter) && (store.chars[linecounter - 1] != '\\'))
 890               || (!linecounter))
 891             instringincomment = !instringincomment;
 892         }
 893         else if ((c == '`') && ((inlinecomment) || (inregcomment))) {
 894           if ((linecounter) && (store.chars[linecounter - 1] == '`'))
 895             inbackquoteincomment = 2; /* Opening LaTeX style quote in comment */
 896           else
 897             inbackquoteincomment = !inbackquoteincomment; /* Backquote in comment */
 898         }
 899         else if ((linecounter) && (!inlinecomment) && (!instring)) {
 900           if ((store.chars[linecounter - 1] == '{') && (c == '-'))
 901             inregcomment++;     /* Haskell "{-" regional comment begin */
 902           else if ((store.chars[linecounter - 1] == '-') && (c == '}')) {
 903             inregcomment--;     /* Haskell "-}" regional comment end */
 904             instringincomment = 0;
 905             incharquoteincomment = 0;
 906             inbackquoteincomment = 0;
 907           }
 908         }
 909         if (c == '|') {
 910           if ((!IsEmptyQueue(q))
 911               && ((((*(RearOfQueue(q))).Element.chars[linecounter] == '=')
 912                    && (linecounter == store.indentation))
 913                   || ((*(RearOfQueue(q))).Element.typeface[linecounter] == BE)))
 914             store.typeface[linecounter] = BE;
 915           else
 916             store.typeface[linecounter] = MA;
 917         }
 918         else if ((c == '\'') && (linecounter) && (store.chars[linecounter - 1] == '\\'))
 919           store.typeface[linecounter] = EQ; /* Escape character quote */
 920         else if ((c == '\'') && (!instring) && (!inregcomment) && (!inlinecomment)) {
 921           if (((linecounter) && (store.chars[linecounter - 1] != '\\')
 922                && ((IsHaskellPunc(store.chars[linecounter - 1])) || (incharquote)))
 923               || (!linecounter)) {
 924             incharquote = !incharquote;
 925             store.typeface[linecounter] = FQ; /* Character quote */
 926           }
 927           else
 928             store.typeface[linecounter] = MA; /* Prime */
 929         }
 930         else if ((c == '\'') && (!instringincomment)
 931                  && ((inregcomment) || (inlinecomment))) {
 932           if (((linecounter) && (store.chars[linecounter - 1] != '\\')
 933                && ((IsHaskellPunc(store.chars[linecounter - 1]))
 934                    || (incharquoteincomment)))
 935               || (!linecounter)) {
 936             incharquoteincomment = !incharquoteincomment;
 937             store.typeface[linecounter] = FQ; /* Character quote in comment */
 938           }
 939           else if (inbackquoteincomment) {
 940             inbackquoteincomment--;
 941             store.typeface[linecounter] = BF; /* `x' character quote in comment */
 942           }
 943           else
 944             store.typeface[linecounter] = MA; /* Prime */
 945         }
 946         else if (c == '"') {
 947           if ((!incharquote) && (!incharquoteincomment) && (!inbackquoteincomment)
 948               && ((instring) || (instringincomment))) {
 949             if (((linecounter) && (store.chars[linecounter - 1] != '\\'))
 950                 || (!linecounter))
 951               store.typeface[linecounter] = DQ; /* Open doublequote */
 952             else if (store.chars[linecounter - 1] == '\\')
 953               store.typeface[linecounter] = EE; /* Escape doublequote */
 954           }
 955           else if ((!incharquote) && (!incharquoteincomment) && (!inbackquoteincomment)) {
 956             if (((linecounter) && (store.chars[linecounter - 1] != '\\'))
 957                 || (!linecounter))
 958               store.typeface[linecounter] = QD; /* Close doublequote */
 959             else if (store.chars[linecounter - 1] == '\\')
 960               store.typeface[linecounter] = EE; /* Escape doublequote */
 961           }
 962           else
 963             store.typeface[linecounter] = EE; /* Character quote of doublequote */
 964         }
 965         else if (c == '`') {
 966           if ((inlinecomment) || (inregcomment))
 967             store.typeface[linecounter] = CO;
 968           else
 969             store.typeface[linecounter] = MA;
 970         }
 971         else if ((linecounter) && (subscripts) && (c == '_')
 972                  && (store.typeface[linecounter - 1] == ID))
 973           store.typeface[linecounter] = SU; /* Subscript in identifier */
 974         else if (c == '*')
 975           store.typeface[linecounter] = TI; /* Times - may be changed by double char */
 976         else if (IsMathsChar(c))
 977           store.typeface[linecounter] = MA; /* Maths characters */
 978         else if (IsNumber(c, store, linecounter,
 979                           ((!inregcomment) && (!instring) && (!inlinecomment))))
 980           store.typeface[linecounter] = NU; /* Numbers */
 981         else if ((instring) || (incharquote))
 982           store.typeface[linecounter] = ST; /* Characters in strings */
 983         else if ((inlinecomment) || (inregcomment))
 984           store.typeface[linecounter] = CO; /* Characters in comments */
 985         else {
 986           if (insub)
 987             store.typeface[linecounter] = IS; /* Subscript identifiers */
 988           else
 989             store.typeface[linecounter] = ID; /* Others */
 990         }
 991         if (linecounter)
 992           if ((store.typeface[linecounter - 1] == IS)
 993               && (store.typeface[linecounter] != IS))
 994             insub = 0;          /* End of subscript identifier */
 995         store.chars[linecounter++] = c; /* Place character in store */
 996         if (linecounter > store.indentation + 1)
 997           store = CheckForDoubleChar(store, linecounter);
 998         if ((store.typeface[linecounter - 1] == LC) && (!inregcomment)
 999             && (!instring) && (!incharquote)) {
1000           instringincomment = 0;
1001           incharquoteincomment = 0;
1002           inbackquoteincomment = 0;
1003           inlinecomment = 1;
1004         }
1005         else if ((store.typeface[linecounter - 1] == SU)
1006                  && (linecounter != store.indentation))
1007           insub = 1;
1008         fscanf(ifptr, "%c", &c); /* Read next character */
1009         if (feof(ifptr))
1010           c = ' ';
1011         if ((!inregcomment) && (!inlinecomment) && (!instring))
1012           store = CheckForKeyword(c, store, linecounter); /* Keywords not in comments or
1013                                                              strings to be in keyword typeface */
1014       }
1015       insub = 0;
1016       store.chars[linecounter] = '\0'; /* String terminating null character */
1017       store.length = linecounter;
1018     }
1019     if ((!tripped) && (!store.col)) /* If last line not in internal alignment */
1020       q = WriteQueue(q);              /*   write previous lines which might */
1021     if (!tripped)               /* Put final line in queue if non-empty */
1022       q = AddToQueue(q, store);
1023     if (feof(ifptr))            /* Write remaining lines */
1024       q = WriteRestOfQueue(q);
1025
1026     printf("\\end{tabbing}\n"); /* End of Haskell program */
1027
1028     exit(0);
1029   }
1030 }