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