* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.55 $
- * $Date: 2000/04/04 15:41:56 $
+ * $Revision: 1.64 $
+ * $Date: 2000/04/10 09:40:03 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
static Void local toggleSet ( Char,Bool );
static Void local togglesIn ( Bool );
static Void local optionInfo ( Void );
-#if USE_REGISTRY
-static String local optionsToStr ( Void );
-#endif
static Void local readOptions ( String );
static Bool local processOption ( String );
static Void local setHeapSize ( String );
Bool debugSC = FALSE;
Bool combined = FALSE;
- char* currentFile; /* Name of current file, or NULL */
-static char currentFileName[1000]; /* name is stored here if it exists*/
-
-
-
-static Text evalModule = 0; /* Name of module we eval exprs in */
-static String currProject = 0; /* Name of current project file */
-static Bool projectLoaded = FALSE; /* TRUE => project file loaded */
+ Module moduleBeingParsed; /* so the parser (topModule) knows */
+static char* currentFile; /* Name of current file, or NULL */
+static char currentFileName[1000]; /* name is stored here if it exists*/
static Bool autoMain = FALSE;
static String lastEdit = 0; /* Name of script to edit (if any) */
static Int lastEdLine = 0; /* Editor line number (if possible)*/
static String prompt = 0; /* Prompt string */
static Int hpSize = DEFAULTHEAP; /* Desired heap size */
+static Bool disableOutput = FALSE; /* TRUE => quiet */
String hugsEdit = 0; /* String for editor command */
String hugsPath = 0; /* String for file search path */
Int argc;
String argv[]; {
Int i;
- String proj = 0;
char argv_0_orig[1000];
List initialModules;
#endif
hugsPath = strCopy(HUGSPATH);
readOptions("-p\"%s> \" -r$$");
-#if USE_REGISTRY
- projectPath = strCopy(readRegChildStrings(HKEY_LOCAL_MACHINE,ProjectRoot,
- "HUGSPATH", PATHSEP, ""));
- readOptions(readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"Options",""));
- readOptions(readRegString(HKEY_CURRENT_USER, HugsRoot,"Options",""));
-#endif /* USE_REGISTRY */
readOptions(fromEnv("STGHUGSFLAGS",""));
strncpy(argv_0_orig,argv[0],1000); /* startupHaskell mangles argv[0] */
# endif
/* Find out early on if we're in combined mode or not.
- everybody(PREPREL) needs to know this.
+ everybody(PREPREL) needs to know this. Also, establish the
+ heap size;
*/
for (i=1; i < argc; ++i) {
if (strcmp(argv[i], "--")==0) break;
if (strcmp(argv[i], "-c")==0) combined = FALSE;
if (strcmp(argv[i], "+c")==0) combined = TRUE;
+
+ if (strncmp(argv[i],"+h",2)==0 ||
+ strncmp(argv[i],"-h",2)==0)
+ setHeapSize(&(argv[i][2]));
}
everybody(PREPREL);
Putchar('\n');
}
-#if USE_REGISTRY
-#define PUTC(c) \
- *next++=(c)
-
-#define PUTS(s) \
- strcpy(next,s); \
- next+=strlen(next)
-
-#define PUTInt(optc,i) \
- sprintf(next,"-%c%d",optc,i); \
- next+=strlen(next)
-
-#define PUTStr(c,s) \
- next=PUTStr_aux(next,c,s)
-
-static String local PUTStr_aux ( String,Char, String));
-
-static String local PUTStr_aux(next,c,s)
-String next;
-Char c;
-String s; {
- if (s) {
- String t = 0;
- sprintf(next,"-%c\"",c);
- next+=strlen(next);
- for(t=s; *t; ++t) {
- PUTS(unlexChar(*t,'"'));
- }
- next+=strlen(next);
- PUTS("\" ");
- }
- return next;
-}
-
-static String local optionsToStr() { /* convert options to string */
- static char buffer[2000];
- String next = buffer;
-
- Int i;
- for (i=0; toggle[i].c; ++i) {
- PUTC(*toggle[i].flag ? '+' : '-');
- PUTC(toggle[i].c);
- PUTC(' ');
- }
- PUTS(haskell98 ? "+98 " : "-98 ");
- PUTInt('h',hpSize); PUTC(' ');
- PUTStr('p',prompt);
- PUTStr('r',repeatStr);
- PUTStr('P',hugsPath);
- PUTStr('E',hugsEdit);
- PUTInt('c',cutoff); PUTC(' ');
-#if USE_PREPROCESSOR && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
- PUTStr('F',preprocessor);
-#endif
- PUTC('\0');
- return buffer;
-}
-#endif /* USE_REGISTRY */
-
#undef PUTC
#undef PUTS
#undef PUTInt
return TRUE;
#endif
- case 'h' : setHeapSize(s+1);
+ case 'h' : /* don't do anything, since pre-scan of args
+ will have got it already */
return TRUE;
case 'c' : /* don't do anything, since pre-scan of args
hpSize = MAXIMUMHEAP;
if (initDone && hpSize != heapSize) {
/* ToDo: should this use a message box in winhugs? */
-#if USE_REGISTRY
- FPrintf(stderr,"Change to heap size will not take effect until you rerun Hugs\n");
-#else
FPrintf(stderr,"You cannot change heap size from inside Hugs\n");
-#endif
} else {
heapSize = hpSize;
}
do {
if (!processOption(s)) {
ERRMSG(0) "Option string must begin with `+' or `-'"
- EEND;
+ EEND_NO_LONGJMP;
}
} while ((s=readFilename())!=0);
-#if USE_REGISTRY
- writeRegString("Options", optionsToStr());
-#endif
}
else
optionInfo();
switch (mode) {
case FM_SOURCE: return "source";
case FM_OBJECT: return "object";
- case FM_EITHER: return "either";
+ case FM_EITHER: return "source or object";
default: internal("modeToString");
}
}
assert(isModule(mod));
strncpy(currentFileName, textToStr(module(mod).text), 990);
strcat(currentFileName, textToStr(module(mod).srcExt));
- currentFile = currentFileName;
+ currentFile = currentFileName;
+ moduleBeingParsed = mod;
+}
+
+static void clearCurrentFile ( void )
+{
+ currentFile = NULL;
+ moduleBeingParsed = NIL;
}
static void ppMG ( void )
u = hd(t);
switch (whatIs(u)) {
case GRP_NONREC:
- fprintf ( stderr, " %s\n", textToStr(textOf(snd(u))));
+ FPrintf ( stderr, " %s\n", textToStr(textOf(snd(u))));
break;
case GRP_REC:
- fprintf ( stderr, " {" );
+ FPrintf ( stderr, " {" );
for (v = snd(u); nonNull(v); v=tl(v))
- fprintf ( stderr, "%s ", textToStr(textOf(hd(v))) );
- fprintf ( stderr, "}\n" );
+ FPrintf ( stderr, "%s ", textToStr(textOf(hd(v))) );
+ FPrintf ( stderr, "}\n" );
break;
default:
internal("ppMG");
usesT = NIL;
for (u = module(mod).uses; nonNull(u); u=tl(u))
usesT = cons(textOf(hd(u)),usesT);
- /* artifically give all modules a dependency on Prelude */
-#if 0
- if (mT != textPrelude && mT != textPrimPrel)
+
+ /* artificially give all modules a dependency on Prelude */
+ if (mT != textPrelude && mT != textPrelPrim)
usesT = cons(textPrelude,usesT);
-#endif
adjList = cons(pair(mT,usesT),adjList);
}
startModule(m);
tree = unap(M_MODULE,module(m).tree);
modNm = zfst3(tree);
- assert(textOf(modNm)==module(m).text); /* wrong, but ... */
+
+ if (textOf(modNm) != module(m).text) {
+ ERRMSG(0) "Module name \"%s\" does not match file name \"%s%s\"",
+ textToStr(textOf(modNm)),
+ textToStr(module(m).text),
+ textToStr(module(m).srcExt)
+ EEND;
+ }
+
setExportList(zsnd3(tree));
topEnts = zthd3(tree);
addUnqualImport(zfst(te2),zsnd(te2));
break;
case M_TYCON:
- tyconDefn(zsel14(te2),zsel24(te2),zsel34(te2),zsel44(te2));
+ tyconDefn(intOf(zsel14(te2)),zsel24(te2),zsel34(te2),zsel44(te2));
break;
case M_CLASS:
- classDefn(zsel14(te2),zsel24(te2),zsel34(te2),zsel44(te2));
+ classDefn(intOf(zsel14(te2)),zsel24(te2),zsel34(te2),zsel44(te2));
break;
case M_INST:
- instDefn(zfst3(te2),zsnd3(te2),zthd3(te2));
+ instDefn(intOf(zfst3(te2)),zsnd3(te2),zthd3(te2));
break;
case M_DEFAULT:
- defaultDefn(zfst(te2),zsnd(te2));
+ defaultDefn(intOf(zfst(te2)),zsnd(te2));
break;
case M_FOREIGN_IM:
- foreignImport(zsel15(te2),zsel25(te2),zsel35(te2),
+ foreignImport(intOf(zsel15(te2)),zsel25(te2),zsel35(te2),
zsel45(te2),zsel55(te2));
break;
case M_FOREIGN_EX:
- foreignExport(zsel15(te2),zsel25(te2),zsel35(te2),
+ foreignExport(intOf(zsel15(te2)),zsel25(te2),zsel35(te2),
zsel45(te2),zsel55(te2));
case M_VALUE:
valDefns = cons(te2,valDefns);
internal("parseModuleOrInterface");
}
-
/* Actually do the parsing. */
if (useSource) {
module(mod).srcExt = findText(sExt);
cant_find:
if (path) free(path);
+ clearCurrentFile();
ERRMSG(0)
"Can't find %s for module \"%s\"",
modeToString(modeRequest), textToStr(mt)
assert(nonNull(m));
if (module(m).mode == FM_SOURCE) {
processModule ( m );
+ module(m).tree = NIL;
} else {
processInterfaces ( singleton(snd(grp)) );
+ m = findModule(textOf(snd(grp)));
+ assert(nonNull(m));
+ module(m).tree = NIL;
}
break;
case GRP_REC:
}
}
processInterfaces ( snd(grp) );
+ for (t = snd(grp); nonNull(t); t=tl(t)) {
+ m = findModule(textOf(hd(t)));
+ assert(nonNull(m));
+ module(m).tree = NIL;
+ }
break;
default:
internal("tryLoadGroup");
Bool oiAvail; Time oiTime; Long oSize; Long iSize;
volatile Time oisTime;
- volatile Bool sourceIsLatest;
volatile Bool out_of_date;
volatile List ood_new;
volatile List us;
*/
toChase = dupList(targetModules);
for (t = toChase; nonNull(t); t=tl(t)) {
- Cell mode = (loadingThePrelude && combined)
- ? FM_OBJECT
- : ( (loadingThePrelude && !combined)
- ? FM_SOURCE
+ Cell mode = (!combined)
+ ? FM_SOURCE
+ : ( (loadingThePrelude && combined)
+ ? FM_OBJECT
: FM_EITHER );
hd(t) = zpair(hd(t), mode);
}
mod = findModule(textOf(mc));
assert(nonNull(mod));
if (!compatibleNewMode(mode,module(mod).mode)) {
+ clearCurrentFile();
ERRMSG(0)
"module %s: %s required, but %s is more recent",
textToStr(textOf(mc)), modeToString(mode),
}
-static void refreshActions ( ConId nextCurrMod )
+static void refreshActions ( ConId nextCurrMod, Bool cleanAfter )
{
+ List t;
ConId tryFor = mkCon(module(currentModule).text);
achieveTargetModules(FALSE);
if (nonNull(nextCurrMod))
if (combined && textOf(tryFor)==findText("PrelHugs"))
tryFor = mkCon(findText("Prelude"));
+ if (cleanAfter) {
+ /* delete any targetModules which didn't actually get loaded */
+ t = targetModules;
+ targetModules = NIL;
+ for (; nonNull(t); t=tl(t))
+ if (elemMG(hd(t)))
+ targetModules = cons(hd(t),targetModules);
+ }
+
setCurrModule ( findModule(textOf(tryFor)) );
Printf("Hugs session for:\n");
ppMG();
targetModules = cons(extra,targetModules);
}
refreshActions ( isNull(extraModules)
- ? NIL
- : hd(reverse(extraModules))
+ ? NIL
+ : hd(reverse(extraModules)),
+ TRUE
);
}
targetModules = cons(load,targetModules);
}
refreshActions ( isNull(loadModules)
- ? NIL
- : hd(reverse(loadModules))
+ ? NIL
+ : hd(reverse(loadModules)),
+ TRUE
);
}
addActions(modConIds);
modConIds = NIL;
break;
- case RELOAD : refreshActions(NIL);
+ case RELOAD : refreshActions(NIL,FALSE);
break;
case SETMODULE :
setModule();
Cell errAssert(l) /* message to use when raising asserts, etc */
Int l; {
- char tmp[100];
Cell str;
if (currentFile) {
str = mkStr(findText(currentFile));
return NULL;
}
+
/* --------------------------------------------------------------------------
* Compiler output
* We can redirect compiler output (prompts, error messages, etc) by
* tweaking these functions.
* ------------------------------------------------------------------------*/
+#ifdef HAVE_STDARG_H
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+Void hugsEnableOutput(f)
+Bool f; {
+ disableOutput = !f;
+}
+
+#ifdef HAVE_STDARG_H
+Void hugsPrintf(const char *fmt, ...) {
+ va_list ap; /* pointer into argument list */
+ va_start(ap, fmt); /* make ap point to first arg after fmt */
+ if (!disableOutput) {
+ vprintf(fmt, ap);
+ } else {
+ }
+ va_end(ap); /* clean up */
+}
+#else
+Void hugsPrintf(fmt, va_alist)
+const char *fmt;
+va_dcl {
+ va_list ap; /* pointer into argument list */
+ va_start(ap); /* make ap point to first arg after fmt */
+ if (!disableOutput) {
+ vprintf(fmt, ap);
+ } else {
+ }
+ va_end(ap); /* clean up */
+}
+#endif
+
+Void hugsPutchar(c)
+int c; {
+ if (!disableOutput) {
+ putchar(c);
+ } else {
+ }
+}
+
+Void hugsFlushStdout() {
+ if (!disableOutput) {
+ fflush(stdout);
+ }
+}
+
+Void hugsFFlush(fp)
+FILE* fp; {
+ if (!disableOutput) {
+ fflush(fp);
+ }
+}
+
+#ifdef HAVE_STDARG_H
+Void hugsFPrintf(FILE *fp, const char* fmt, ...) {
+ va_list ap;
+ va_start(ap, fmt);
+ if (!disableOutput) {
+ vfprintf(fp, fmt, ap);
+ } else {
+ }
+ va_end(ap);
+}
+#else
+Void hugsFPrintf(FILE *fp, const char* fmt, va_list)
+FILE* fp;
+const char* fmt;
+va_dcl {
+ va_list ap;
+ va_start(ap);
+ if (!disableOutput) {
+ vfprintf(fp, fmt, ap);
+ } else {
+ }
+ va_end(ap);
+}
+#endif
+
+Void hugsPutc(c, fp)
+int c;
+FILE* fp; {
+ if (!disableOutput) {
+ putc(c,fp);
+ } else {
+ }
+}
+
/* --------------------------------------------------------------------------
* Send message to each component of system:
* ------------------------------------------------------------------------*/
typeChecker(what);
compiler(what);
codegen(what);
+
+ mark(moduleGraph);
+ mark(prelModules);
+ mark(targetModules);
+ mark(daSccs);
}
/*-------------------------------------------------------------------------*/
projects / ghc-hetmet.git / blobdiff