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 "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 acceptPrim = FALSE;       /* Set if Int#, etc., may be used                */
  20 BOOLEAN haskell1_2Flag = FALSE;   /* Set if we are compiling for 1.2               */
  21 BOOLEAN etags = FALSE;            /* Set if we're parsing only to produce tags.    */
  22 BOOLEAN hashIds = FALSE;          /* Set if Identifiers should be hashed.          */
  23
  24 BOOLEAN ignoreSCC = TRUE;         /* Set if we ignore/filter scc expressions.      */
  25
  26 BOOLEAN implicitPrelude = TRUE;   /* Set if we implicitly import the Prelude.      */
  27 BOOLEAN ignorePragmas = FALSE;    /* Set if we want to ignore pragmas              */
  28
  29 /* From time to time, the format of interface files may change.
  30
  31    So that we don't get gratuitous syntax errors or silently slurp in
  32    junk info, two things: (a) the compiler injects a "this is a
  33    version N interface":
  34
  35         {-# GHC_PRAGMA INTERFACE VERSION <n> #-}
  36
  37    (b) this parser has a "minimum acceptable version", below which it
  38    refuses to parse the pragmas (it just considers them as comments).
  39    It also has a "maximum acceptable version", above which...
  40
  41    The minimum is so a new parser won't try to grok overly-old
  42    interfaces; the maximum (usually the current version number when
  43    the parser was released) is so an old parser will not try to grok
  44    since-upgraded interfaces.
  45
  46    If an interface has no INTERFACE VERSION line, it is taken to be
  47    version 0.
  48 */
  49 int minAcceptablePragmaVersion = 7;  /* 1.3-xx ONLY */
  50 int maxAcceptablePragmaVersion = 7;  /* 1.3-xx+ */
  51 int thisIfacePragmaVersion = 0;
  52
  53 char *input_file_dir; /* The directory where the input file is. */
  54
  55 char HiSuffix[64] = ".hi";              /* can be changed with -h flag */
  56 char PreludeHiSuffix[64] = ".hi";       /* can be changed with -g flag */
  57
  58 static BOOLEAN verbose = FALSE;         /* Set for verbose messages. */
  59
  60 /* Forward decls */
  61 static void who_am_i PROTO((void));
  62
  63 /**********************************************************************
  64 *                                                                     *
  65 *                                                                     *
  66 *     Utility Functions                                               *
  67 *                                                                     *
  68 *                                                                     *
  69 **********************************************************************/
  70
  71 # include <stdio.h>
  72 # include "constants.h"
  73 # include "hspincl.h"
  74 # include "utils.h"
  75
  76 void
  77 process_args(argc,argv)
  78   int argc;
  79   char **argv;
  80 {
  81     BOOLEAN keep_munging_option = FALSE;
  82
  83     imports_dirlist     = mklnil();
  84     sys_imports_dirlist = mklnil();
  85
  86     argc--, argv++;
  87
  88     while (argc > 0 && argv[0][0] == '-') {
  89
  90         keep_munging_option = TRUE;
  91
  92         while (keep_munging_option && *++*argv != '\0') {
  93             switch(**argv) {
  94
  95             /* -I dir */
  96             case 'I':
  97                     imports_dirlist = lapp(imports_dirlist,*argv+1);
  98                     keep_munging_option = FALSE;
  99                     break;
 100
 101             /* -J dir (for system imports) */
 102             case 'J':
 103                     sys_imports_dirlist = lapp(sys_imports_dirlist,*argv+1);
 104                     keep_munging_option = FALSE;
 105                     break;
 106
 107             case 'g':
 108                     strcpy(PreludeHiSuffix, *argv+1);
 109                     keep_munging_option = FALSE;
 110                     break;
 111
 112             case 'h':
 113                     strcpy(HiSuffix, *argv+1);
 114                     keep_munging_option = FALSE;
 115                     break;
 116
 117             case 'v':
 118                     who_am_i(); /* identify myself */
 119                     verbose = TRUE;
 120                     break;
 121
 122             case 'N':
 123                     nonstandardFlag = TRUE;
 124                     acceptPrim = TRUE;
 125                     break;
 126
 127             case '2':
 128                     haskell1_2Flag = TRUE;
 129                     break;
 130
 131             case 'S':
 132                     ignoreSCC = FALSE;
 133                     break;
 134
 135             case 'p':
 136                     ignorePragmas = TRUE;
 137                     break;
 138
 139             case 'P':
 140                     implicitPrelude = FALSE;
 141                     break;
 142
 143             case 'D':
 144 #ifdef HSP_DEBUG
 145                     { extern int yydebug;
 146                       yydebug = 1;
 147                     }
 148 #endif
 149                     break;
 150
 151             /* -Hn -- Use Hash Table, Size n (if given) */
 152             case 'H':
 153                     hashIds = TRUE;
 154                     if(*(*argv+1)!= '\0')
 155                       hash_table_size = atoi(*argv+1);
 156                     break;
 157             case 'E':
 158                     etags = TRUE;
 159                     break;
 160             }
 161         }
 162         argc--, argv++;
 163     }
 164
 165     if(argc >= 1 && freopen(argv[0], "r", stdin) == NULL) {
 166             fprintf(stderr, "Cannot open %s.\n", argv[0]);
 167             exit(1);
 168     }
 169
 170     if(argc >= 2 && freopen(argv[1], "w", stdout) == NULL) {
 171             fprintf(stderr, "Cannot open %s.\n", argv[1]);
 172             exit(1);
 173     }
 174
 175
 176     /* By default, imports come from the directory of the source file */
 177     if ( argc >= 1 )
 178       {
 179         char *endchar;
 180
 181         input_file_dir = xmalloc (strlen(argv[0]) + 1);
 182         strcpy(input_file_dir, argv[0]);
 183 #ifdef macintosh
 184         endchar = rindex(input_file_dir, (int) ':');
 185 #else
 186         endchar = rindex(input_file_dir, (int) '/');
 187 #endif /* ! macintosh */
 188
 189         if ( endchar == NULL )
 190           {
 191             free(input_file_dir);
 192             input_file_dir = ".";
 193           }
 194         else
 195           *endchar = '\0';
 196       }
 197
 198     /* No input file -- imports come from the current directory first */
 199     else
 200       input_file_dir = ".";
 201
 202     imports_dirlist = mklcons( input_file_dir, imports_dirlist );
 203
 204     if (verbose)
 205       {
 206         fprintf(stderr,"Hash Table Contains %d entries\n",hash_table_size);
 207         if(acceptPrim)
 208           fprintf(stderr,"Allowing special syntax for Unboxed Values\n");
 209       }
 210 }
 211
 212 void
 213 error(s)
 214   char *s;
 215 {
 216         fprintf(stderr, "PARSER: Error %s\n", s);
 217         exit(1);
 218 }
 219
 220 static void
 221 who_am_i(void)
 222 {
 223   fprintf(stderr,"Glasgow Haskell parser, version %s\n", PARSER_VERSION);
 224 }
 225
 226 list
 227 lconc(l1, l2)
 228   list l1;
 229   list l2;
 230 {
 231         list t;
 232
 233         if (tlist(l1) == lnil)
 234                 return(l2);
 235         for(t = l1; tlist(ltl(t)) != lnil; t = ltl(t))
 236                 ;
 237         ltl(t) = l2;
 238         return(l1);
 239 }
 240
 241 list
 242 lapp(list l1, VOID_STAR l2)
 243 {
 244         list t;
 245
 246         if (tlist(l1) == lnil)
 247                 return(mklcons(l2, mklnil()));
 248         for(t = l1; tlist(ltl(t)) != lnil; t = ltl(t))
 249                 ;
 250         ltl(t) = mklcons(l2, mklnil());
 251         return(l1);
 252 }