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