X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FyaccParser%2Fimport_dirlist.c;fp=ghc%2Fcompiler%2FyaccParser%2Fimport_dirlist.c;h=dc0eaec9380843f42ae32c685168df67cbafbd19;hb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;hp=0000000000000000000000000000000000000000;hpb=e48474bff05e6cfb506660420f025f694c870d38;p=ghc-hetmet.git diff --git a/ghc/compiler/yaccParser/import_dirlist.c b/ghc/compiler/yaccParser/import_dirlist.c new file mode 100644 index 0000000..dc0eaec --- /dev/null +++ b/ghc/compiler/yaccParser/import_dirlist.c @@ -0,0 +1,224 @@ +/********************************************************************** +* * +* * +* Import Directory List Handling * +* * +* * +**********************************************************************/ + +#include + +#include "hspincl.h" +#include "constants.h" +#include "utils.h" + +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifdef HAVE_SYS_TYPES_H +#include +#else +#ifdef HAVE_TYPES_H +#include +#endif +#endif + +#ifdef HAVE_SYS_STAT_H +#include +#endif + +#ifdef HAVE_SYS_FILE_H +#include +#endif + +#ifndef HAVE_ACCESS +#define R_OK "r" +#define F_OK "r" +short +access(const char *fileName, const char *mode) +{ + FILE *fp = fopen(fileName, mode); + if (fp != NULL) { + (VOID) fclose(fp); + return 0; + } + return 1; +} +#endif /* HAVE_ACCESS */ + + +list imports_dirlist, sys_imports_dirlist; /* The imports lists */ +extern char HiSuffix[]; +extern char PreludeHiSuffix[]; +extern BOOLEAN ExplicitHiSuffixGiven; + +#define MAX_MATCH 16 + +/* + This finds a module along the imports directory list. +*/ + +VOID +find_module_on_imports_dirlist(module_name, is_sys_import, returned_filename) + char *module_name; + BOOLEAN is_sys_import; + char *returned_filename; +{ + char try[FILENAME_SIZE]; + + list imports_dirs; + +#ifdef HAVE_STAT + struct stat sbuf[MAX_MATCH]; +#endif + + int no_of_matches = 0; + BOOLEAN tried_source_dir = FALSE; + + char *try_end; + char *suffix_to_use = (is_sys_import) ? PreludeHiSuffix : HiSuffix; + int modname_len = strlen(module_name); + + /* + Check every directory in (sys_)imports_dirlist for the imports file. + The first directory in the list is the source directory. + */ + for (imports_dirs = (is_sys_import) ? sys_imports_dirlist : imports_dirlist; + tlist(imports_dirs) == lcons; + imports_dirs = ltl(imports_dirs)) + { + char *dir = (char *) lhd(imports_dirs); + strcpy(try, dir); + + try_end = try + strlen(try); + +#ifdef macintosh /* ToDo: use DIR_SEP_CHAR */ + if (*(try_end - 1) != ':') + strcpy (try_end++, ":"); +#else + if (*(try_end - 1) != '/') + strcpy (try_end++, "/"); +#endif /* ! macintosh */ + + strcpy(try_end, module_name); + + strcpy(try_end+modname_len, suffix_to_use); + + /* See whether the file exists and is readable. */ + if (access (try,R_OK) == 0) + { + if ( no_of_matches == 0 ) + strcpy(returned_filename, try); + + /* Return as soon as a match is found in the source directory. */ + if (!tried_source_dir) + return; + +#ifdef HAVE_STAT + if ( no_of_matches < MAX_MATCH && stat(try, sbuf + no_of_matches) == 0 ) + { + int i; + for (i = 0; i < no_of_matches; i++) + { + if ( sbuf[no_of_matches].st_dev == sbuf[i].st_dev && + sbuf[no_of_matches].st_ino == sbuf[i].st_ino) + goto next; /* Skip dups */ + } + } +#endif /* HAVE_STAT */ + no_of_matches++; + } + else if (access (try,F_OK) == 0) + fprintf(stderr,"Warning: %s exists, but is not readable\n",try); + + next: + tried_source_dir = TRUE; + } + + if ( no_of_matches == 0 && ! is_sys_import ) { /* Nothing so far */ + + /* If we are explicitly meddling about with .hi suffixes, + then some system-supplied modules may need to be looked + for with PreludeHiSuffix; unsavoury but true... + */ + suffix_to_use = PreludeHiSuffix; + + for (imports_dirs = sys_imports_dirlist; + tlist(imports_dirs) == lcons; + imports_dirs = ltl(imports_dirs)) + { + char *dir = (char *) lhd(imports_dirs); + strcpy(try, dir); + + try_end = try + strlen(try); + +#ifdef macintosh /* ToDo: use DIR_SEP_STRING */ + if (*(try_end - 1) != ':') + strcpy (try_end++, ":"); +#else + if (*(try_end - 1) != '/') + strcpy (try_end++, "/"); +#endif /* ! macintosh */ + + strcpy(try_end, module_name); + + strcpy(try_end+modname_len, suffix_to_use); + + /* See whether the file exists and is readable. */ + if (access (try,R_OK) == 0) + { + if ( no_of_matches == 0 ) + strcpy(returned_filename, try); + +#ifdef HAVE_STAT + if ( no_of_matches < MAX_MATCH && stat(try, sbuf + no_of_matches) == 0 ) + { + int i; + for (i = 0; i < no_of_matches; i++) + { + if ( sbuf[no_of_matches].st_dev == sbuf[i].st_dev && + sbuf[no_of_matches].st_ino == sbuf[i].st_ino) + goto next_again; /* Skip dups */ + } + } +#endif /* HAVE_STAT */ + no_of_matches++; + } + else if (access (try,F_OK) == 0) + fprintf(stderr,"Warning: %s exists, but is not readable\n",try); + next_again: + /*NOTHING*/; + } + } + + /* Error checking */ + + switch ( no_of_matches ) { + default: + fprintf(stderr,"Warning: found %d %s files for module \"%s\"\n", + no_of_matches, suffix_to_use, module_name); + break; + case 0: + { + char disaster_msg[MODNAME_SIZE+1000]; + sprintf(disaster_msg,"can't find interface (%s) file for module \"%s\"%s", + suffix_to_use, module_name, + (strncmp(module_name, "PreludeGlaIO", 12) == 0) + ? "\n(The PreludeGlaIO interface no longer exists);" + :( + (strncmp(module_name, "PreludePrimIO", 13) == 0) + ? "\n(The PreludePrimIO interface no longer exists -- just use PreludeGlaST);" + :( + (strncmp(module_name, "Prelude", 7) == 0) + ? "\n(Perhaps you forgot a `-fglasgow-exts' flag?);" + : "" + ))); + hsperror(disaster_msg); + break; + } + case 1: + /* Everything is fine */ + break; + } +}