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 tree root;              /* The root of the built syntax tree. */
  14 list Lnil;
  15
  16 BOOLEAN nonstandardFlag = FALSE;  /* Set if non-std Haskell extensions to be used. */
  17 BOOLEAN etags = FALSE;            /* Set if we're parsing only to produce tags.    */
  18 BOOLEAN hashIds = FALSE;          /* Set if Identifiers should be hashed.          */
  19
  20 BOOLEAN ignoreSCC = TRUE;         /* Set if we ignore/filter scc expressions.      */
  21 BOOLEAN warnSCC = FALSE;          /* Set if we want to inform the user what _scc_s are
  22                                      being ignored. */
  23
  24 /**********************************************************************
  25 *                                                                     *
  26 *                                                                     *
  27 *     Utility Functions                                               *
  28 *                                                                     *
  29 *                                                                     *
  30 **********************************************************************/
  31
  32 # include <stdio.h>
  33 # include "constants.h"
  34 # include "hspincl.h"
  35 # include "utils.h"
  36
  37 void
  38 process_args(argc,argv)
  39   int argc;
  40   char **argv;
  41 {
  42     BOOLEAN keep_munging_option = FALSE;
  43
  44     while (argc > 0 && argv[0][0] == '-') {
  45
  46         keep_munging_option = TRUE;
  47
  48         while (keep_munging_option && *++*argv != '\0') {
  49             switch(**argv) {
  50
  51             case 'D':
  52 #ifdef HSP_DEBUG
  53                     { extern int yydebug;
  54                       yydebug = 1;
  55                     }
  56 #endif
  57                     break;
  58
  59             case 'E':
  60                     etags = TRUE;
  61                     break;
  62
  63             /* -Hn -- Use Hash Table, Size n (if given) */
  64             case 'H':
  65                     hashIds = TRUE;
  66                     if(*(*argv+1)!= '\0')
  67                       hash_table_size = atoi(*argv+1);
  68                     break;
  69             case 'N':
  70                     nonstandardFlag = TRUE;
  71                     break;
  72
  73             case 'S':
  74                     ignoreSCC = FALSE;
  75                     break;
  76
  77             case 'W':
  78                     warnSCC = TRUE;
  79                     break;
  80
  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 /* lconc l1 l2 appends l2 to the end of l1 */
 106 list
 107 lconc(l1, l2)
 108   list l1;
 109   list l2;
 110 {
 111         list t;
 112
 113         if (tlist(l1) == lnil)
 114                 return(l2);
 115         for(t = l1; tlist(ltl(t)) != lnil; t = ltl(t))
 116                 ;
 117         ltl(t) = l2;
 118         return(l1);
 119 }
 120
 121 /* lapp( l, x ) appends [x] to the end of list l */
 122 list
 123 lapp(list l1, VOID_STAR l2)
 124 {
 125         list t;
 126
 127         if (tlist(l1) == lnil)
 128                 return(mklcons(l2, mklnil()));
 129         for(t = l1; tlist(ltl(t)) != lnil; t = ltl(t))
 130                 ;
 131         ltl(t) = mklcons(l2, mklnil());
 132         return(l1);
 133 }