ghc/compiler/yaccParser/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 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(module_name, is_sys_import, returned_filename)
  64   char *module_name;
  65   BOOLEAN is_sys_import;
  66   char *returned_filename;
  67 {
  68     char try[FILENAME_SIZE];
  69
  70     list imports_dirs;
  71
  72 #ifdef HAVE_STAT
  73     struct stat sbuf[MAX_MATCH];
  74 #endif
  75
  76     int no_of_matches = 0;
  77     BOOLEAN tried_source_dir = FALSE;
  78
  79     char *try_end;
  80     char *suffix_to_use = (is_sys_import) ? PreludeHiSuffix : HiSuffix;
  81     int modname_len = strlen(module_name);
  82
  83     /*
  84        Check every directory in (sys_)imports_dirlist for the imports file.
  85        The first directory in the list is the source directory.
  86     */
  87     for (imports_dirs = (is_sys_import) ? sys_imports_dirlist : imports_dirlist;
  88          tlist(imports_dirs) == lcons;
  89          imports_dirs = ltl(imports_dirs))
  90       {
  91         char *dir = (char *) lhd(imports_dirs);
  92         strcpy(try, dir);
  93
  94         try_end = try + strlen(try);
  95
  96 #ifdef macintosh /* ToDo: use DIR_SEP_CHAR */
  97         if (*(try_end - 1) != ':')
  98             strcpy (try_end++, ":");
  99 #else
 100         if (*(try_end - 1) != '/')
 101           strcpy (try_end++, "/");
 102 #endif /* ! macintosh */
 103
 104         strcpy(try_end, module_name);
 105
 106         strcpy(try_end+modname_len, suffix_to_use);
 107
 108         /* See whether the file exists and is readable. */
 109         if (access (try,R_OK) == 0)
 110           {
 111             if ( no_of_matches == 0 )
 112                 strcpy(returned_filename, try);
 113
 114             /* Return as soon as a match is found in the source directory. */
 115             if (!tried_source_dir)
 116               return;
 117
 118 #ifdef HAVE_STAT
 119             if ( no_of_matches < MAX_MATCH && stat(try, sbuf + no_of_matches) == 0 )
 120               {
 121                 int i;
 122                 for (i = 0; i < no_of_matches; i++)
 123                   {
 124                     if ( sbuf[no_of_matches].st_dev == sbuf[i].st_dev &&
 125                          sbuf[no_of_matches].st_ino == sbuf[i].st_ino)
 126                       goto next;    /* Skip dups */
 127                   }
 128               }
 129 #endif /* HAVE_STAT */
 130             no_of_matches++;
 131           }
 132         else if (access (try,F_OK) == 0)
 133           fprintf(stderr,"Warning: %s exists, but is not readable\n",try);
 134
 135       next:
 136         tried_source_dir = TRUE;
 137       }
 138
 139     if ( no_of_matches == 0 && ! is_sys_import ) { /* Nothing so far */
 140
 141         /* If we are explicitly meddling about with .hi suffixes,
 142            then some system-supplied modules may need to be looked
 143            for with PreludeHiSuffix; unsavoury but true...
 144         */
 145         suffix_to_use = PreludeHiSuffix;
 146
 147         for (imports_dirs = sys_imports_dirlist;
 148              tlist(imports_dirs) == lcons;
 149              imports_dirs = ltl(imports_dirs))
 150           {
 151             char *dir = (char *) lhd(imports_dirs);
 152             strcpy(try, dir);
 153
 154             try_end = try + strlen(try);
 155
 156 #ifdef macintosh /* ToDo: use DIR_SEP_STRING */
 157             if (*(try_end - 1) != ':')
 158                 strcpy (try_end++, ":");
 159 #else
 160             if (*(try_end - 1) != '/')
 161               strcpy (try_end++, "/");
 162 #endif /* ! macintosh */
 163
 164             strcpy(try_end, module_name);
 165
 166             strcpy(try_end+modname_len, suffix_to_use);
 167
 168             /* See whether the file exists and is readable. */
 169             if (access (try,R_OK) == 0)
 170               {
 171                 if ( no_of_matches == 0 )
 172                     strcpy(returned_filename, try);
 173
 174 #ifdef HAVE_STAT
 175                 if ( no_of_matches < MAX_MATCH && stat(try, sbuf + no_of_matches) == 0 )
 176                   {
 177                     int i;
 178                     for (i = 0; i < no_of_matches; i++)
 179                       {
 180                         if ( sbuf[no_of_matches].st_dev == sbuf[i].st_dev &&
 181                              sbuf[no_of_matches].st_ino == sbuf[i].st_ino)
 182                           goto next_again;    /* Skip dups */
 183                       }
 184                   }
 185 #endif /* HAVE_STAT */
 186                 no_of_matches++;
 187               }
 188             else if (access (try,F_OK) == 0)
 189               fprintf(stderr,"Warning: %s exists, but is not readable\n",try);
 190           next_again:
 191            /*NOTHING*/;
 192           }
 193     }
 194
 195     /* Error checking */
 196
 197     switch ( no_of_matches ) {
 198     default:
 199           fprintf(stderr,"Warning: found %d %s files for module \"%s\"\n",
 200                         no_of_matches, suffix_to_use, module_name);
 201           break;
 202     case 0:
 203           {
 204             char disaster_msg[MODNAME_SIZE+1000];
 205             sprintf(disaster_msg,"can't find interface (%s) file for module \"%s\"%s",
 206                         suffix_to_use, module_name,
 207                         (strncmp(module_name, "PreludeGlaIO", 12) == 0)
 208                         ? "\n(The PreludeGlaIO interface no longer exists);"
 209                         :(
 210                         (strncmp(module_name, "PreludePrimIO", 13) == 0)
 211                         ? "\n(The PreludePrimIO interface no longer exists -- just use PreludeGlaST);"
 212                         :(
 213                         (strncmp(module_name, "Prelude", 7) == 0)
 214                         ? "\n(Perhaps you forgot a `-fglasgow-exts' flag?);"
 215                         : ""
 216             )));
 217             hsperror(disaster_msg);
 218             break;
 219           }
 220     case 1:
 221         /* Everything is fine */
 222         break;
 223     }
 224 }