ghc/compiler/parser/import_dirlist.c

   1 /**********************************************************************
   2 *                                                                     *
   3 *                                                                     *
   4 *      Import Directory List Handling                                 *
   5 *                                                                     *
   6 *                                                                     *
   7 **********************************************************************/
   8
   9 #include <stdio.h>
  10
  11 #include "hspincl.h"
  12 #include "constants.h"
  13 #include "utils.h"
  14
  15 #ifdef HAVE_UNISTD_H
  16 #include <unistd.h>
  17 #endif
  18
  19 #ifdef HAVE_SYS_TYPES_H
  20 #include <sys/types.h>
  21 #else
  22 #ifdef HAVE_TYPES_H
  23 #include <types.h>
  24 #endif
  25 #endif
  26
  27 #ifdef HAVE_SYS_STAT_H
  28 #include <sys/stat.h>
  29 #endif
  30
  31 #ifdef HAVE_SYS_FILE_H
  32 #include <sys/file.h>
  33 #endif
  34
  35 #ifndef HAVE_ACCESS
  36 #define R_OK "r"
  37 #define F_OK "r"
  38 short
  39 access(const char *fileName, const char *mode)
  40 {
  41     FILE *fp = fopen(fileName, mode);
  42     if (fp != NULL) {
  43         (void) fclose(fp);
  44         return 0;
  45     }
  46     return 1;
  47 }
  48 #endif /* HAVE_ACCESS */
  49
  50
  51 list    imports_dirlist, sys_imports_dirlist; /* The imports lists */
  52 extern  char HiSuffix[];
  53 extern  char PreludeHiSuffix[];
  54 /* OLD 95/08: extern BOOLEAN ExplicitHiSuffixGiven; */
  55
  56 #define MAX_MATCH 16
  57
  58 /*
  59   This finds a module along the imports directory list.
  60 */
  61
  62 void
  63 find_module_on_imports_dirlist(char *module_name, BOOLEAN is_sys_import, char *returned_filename)
  64 {
  65     char try[FILENAME_SIZE];
  66
  67     list imports_dirs;
  68
  69 #ifdef HAVE_STAT
  70     struct stat sbuf[MAX_MATCH];
  71 #endif
  72
  73     int no_of_matches = 0;
  74     BOOLEAN tried_source_dir = FALSE;
  75
  76     char *try_end;
  77     char *suffix_to_use    = (is_sys_import) ? PreludeHiSuffix : HiSuffix;
  78     char *suffix_to_report = suffix_to_use; /* save this for reporting, because we
  79                                                 might change suffix_to_use later */
  80     int modname_len = strlen(module_name);
  81
  82     /*
  83        Check every directory in (sys_)imports_dirlist for the imports file.
  84        The first directory in the list is the source directory.
  85     */
  86     for (imports_dirs = (is_sys_import) ? sys_imports_dirlist : imports_dirlist;
  87          tlist(imports_dirs) == lcons;
  88          imports_dirs = ltl(imports_dirs))
  89       {
  90         char *dir = (char *) lhd(imports_dirs);
  91         strcpy(try, dir);
  92
  93         try_end = try + strlen(try);
  94
  95 #ifdef macintosh /* ToDo: use DIR_SEP_CHAR */
  96         if (*(try_end - 1) != ':')
  97             strcpy (try_end++, ":");
  98 #else
  99         if (*(try_end - 1) != '/')
 100           strcpy (try_end++, "/");
 101 #endif /* ! macintosh */
 102
 103         strcpy(try_end, module_name);
 104
 105         strcpy(try_end+modname_len, suffix_to_use);
 106
 107         /* See whether the file exists and is readable. */
 108         if (access (try,R_OK) == 0)
 109           {
 110             if ( no_of_matches == 0 )
 111                 strcpy(returned_filename, try);
 112
 113             /* Return as soon as a match is found in the source directory. */
 114             if (!tried_source_dir)
 115               return;
 116
 117 #ifdef HAVE_STAT
 118             if ( no_of_matches < MAX_MATCH && stat(try, sbuf + no_of_matches) == 0 )
 119               {
 120                 int i;
 121                 for (i = 0; i < no_of_matches; i++)
 122                   {
 123                     if ( sbuf[no_of_matches].st_dev == sbuf[i].st_dev &&
 124                          sbuf[no_of_matches].st_ino == sbuf[i].st_ino)
 125                       goto next;    /* Skip dups */
 126                   }
 127               }
 128 #endif /* HAVE_STAT */
 129             no_of_matches++;
 130           }
 131         else if (access (try,F_OK) == 0)
 132           fprintf(stderr,"Warning: %s exists, but is not readable\n",try);
 133
 134       next:
 135         tried_source_dir = TRUE;
 136       }
 137
 138     if ( no_of_matches == 0 && ! is_sys_import ) { /* Nothing so far */
 139
 140         /* If we are explicitly meddling about with .hi suffixes,
 141            then some system-supplied modules may need to be looked
 142            for with PreludeHiSuffix; unsavoury but true...
 143         */
 144         suffix_to_use = PreludeHiSuffix;
 145
 146         for (imports_dirs = sys_imports_dirlist;
 147              tlist(imports_dirs) == lcons;
 148              imports_dirs = ltl(imports_dirs))
 149           {
 150             char *dir = (char *) lhd(imports_dirs);
 151             strcpy(try, dir);
 152
 153             try_end = try + strlen(try);
 154
 155 #ifdef macintosh /* ToDo: use DIR_SEP_STRING */
 156             if (*(try_end - 1) != ':')
 157                 strcpy (try_end++, ":");
 158 #else
 159             if (*(try_end - 1) != '/')
 160               strcpy (try_end++, "/");
 161 #endif /* ! macintosh */
 162
 163             strcpy(try_end, module_name);
 164
 165             strcpy(try_end+modname_len, suffix_to_use);
 166
 167             /* See whether the file exists and is readable. */
 168             if (access (try,R_OK) == 0)
 169               {
 170                 if ( no_of_matches == 0 )
 171                     strcpy(returned_filename, try);
 172
 173 #ifdef HAVE_STAT
 174                 if ( no_of_matches < MAX_MATCH && stat(try, sbuf + no_of_matches) == 0 )
 175                   {
 176                     int i;
 177                     for (i = 0; i < no_of_matches; i++)
 178                       {
 179                         if ( sbuf[no_of_matches].st_dev == sbuf[i].st_dev &&
 180                              sbuf[no_of_matches].st_ino == sbuf[i].st_ino)
 181                           goto next_again;    /* Skip dups */
 182                       }
 183                   }
 184 #endif /* HAVE_STAT */
 185                 no_of_matches++;
 186               }
 187             else if (access (try,F_OK) == 0)
 188               fprintf(stderr,"Warning: %s exists, but is not readable\n",try);
 189           next_again:
 190            /*NOTHING*/;
 191           }
 192     }
 193
 194     /* Error checking */
 195
 196     switch ( no_of_matches ) {
 197     default:
 198           fprintf(stderr,"Warning: found %d %s files for module \"%s\"\n",
 199                         no_of_matches, suffix_to_report, module_name);
 200           break;
 201     case 0:
 202           {
 203             char disaster_msg[MODNAME_SIZE+1000];
 204             sprintf(disaster_msg,"can't find interface (%s) file for module \"%s\"%s",
 205                         suffix_to_report, module_name,
 206                         (strncmp(module_name, "PreludeGlaIO", 12) == 0)
 207                         ? "\n(The PreludeGlaIO interface no longer exists);"
 208                         :(
 209                         (strncmp(module_name, "PreludePrimIO", 13) == 0)
 210                         ? "\n(The PreludePrimIO interface no longer exists -- just use PreludeGlaST);"
 211                         :(
 212                         (strncmp(module_name, "Prelude", 7) == 0)
 213                         ? "\n(Perhaps you forgot a `-fglasgow-exts' flag?);"
 214                         : ""
 215             )));
 216             hsperror(disaster_msg);
 217             break;
 218           }
 219     case 1:
 220         /* Everything is fine */
 221         break;
 222     }
 223 }