ghc/compiler/parser/util.c

   1 /**********************************************************************
   2 *                                                                     *
   3 *                                                                     *
   4 *      Declarations                                                   *
   5 *                                                                     *
   6 *                                                                     *
   7 **********************************************************************/
   8
   9 #include "hspincl.h"
  10 #include "constants.h"
  11 #include "utils.h"
  12
  13 #define PARSER_VERSION "2.01 (Haskell 1.3)"
  14
  15 tree root;              /* The root of the built syntax tree. */
  16 list Lnil;
  17
  18 BOOLEAN nonstandardFlag = FALSE;  /* Set if non-std Haskell extensions to be used. */
  19 BOOLEAN haskell1_2Flag = FALSE;   /* Set if we are compiling for 1.2               */
  20 BOOLEAN etags = FALSE;            /* Set if we're parsing only to produce tags.    */
  21 BOOLEAN hashIds = FALSE;          /* Set if Identifiers should be hashed.          */
  22
  23 BOOLEAN ignoreSCC = TRUE;         /* Set if we ignore/filter scc expressions.      */
  24
  25 /**********************************************************************
  26 *                                                                     *
  27 *                                                                     *
  28 *     Utility Functions                                               *
  29 *                                                                     *
  30 *                                                                     *
  31 **********************************************************************/
  32
  33 # include <stdio.h>
  34 # include "constants.h"
  35 # include "hspincl.h"
  36 # include "utils.h"
  37
  38 void
  39 process_args(argc,argv)
  40   int argc;
  41   char **argv;
  42 {
  43     BOOLEAN keep_munging_option = FALSE;
  44
  45     while (argc > 0 && argv[0][0] == '-') {
  46
  47         keep_munging_option = TRUE;
  48
  49         while (keep_munging_option && *++*argv != '\0') {
  50             switch(**argv) {
  51
  52             case 'N':
  53                     nonstandardFlag = TRUE;
  54                     break;
  55
  56             case '2':
  57                     haskell1_2Flag = TRUE;
  58                     break;
  59
  60             case 'S':
  61                     ignoreSCC = FALSE;
  62                     break;
  63
  64             case 'D':
  65 #ifdef HSP_DEBUG
  66                     { extern int yydebug;
  67                       yydebug = 1;
  68                     }
  69 #endif
  70                     break;
  71
  72             /* -Hn -- Use Hash Table, Size n (if given) */
  73             case 'H':
  74                     hashIds = TRUE;
  75                     if(*(*argv+1)!= '\0')
  76                       hash_table_size = atoi(*argv+1);
  77                     break;
  78             case 'E':
  79                     etags = TRUE;
  80                     break;
  81             }
  82         }
  83         argc--, argv++;
  84     }
  85
  86     if(argc >= 1 && freopen(argv[0], "r", stdin) == NULL) {
  87             fprintf(stderr, "Cannot open %s.\n", argv[0]);
  88             exit(1);
  89     }
  90
  91     if(argc >= 2 && freopen(argv[1], "w", stdout) == NULL) {
  92             fprintf(stderr, "Cannot open %s.\n", argv[1]);
  93             exit(1);
  94     }
  95 }
  96
  97 void
  98 error(s)
  99   char *s;
 100 {
 101         fprintf(stderr, "PARSER: Error %s\n", s);
 102         exit(1);
 103 }
 104
 105 list
 106 lconc(l1, l2)
 107   list l1;
 108   list l2;
 109 {
 110         list t;
 111
 112         if (tlist(l1) == lnil)
 113                 return(l2);
 114         for(t = l1; tlist(ltl(t)) != lnil; t = ltl(t))
 115                 ;
 116         ltl(t) = l2;
 117         return(l1);
 118 }
 119
 120 list
 121 lapp(list l1, VOID_STAR l2)
 122 {
 123         list t;
 124
 125         if (tlist(l1) == lnil)
 126                 return(mklcons(l2, mklnil()));
 127         for(t = l1; tlist(ltl(t)) != lnil; t = ltl(t))
 128                 ;
 129         ltl(t) = mklcons(l2, mklnil());
 130         return(l1);
 131 }