* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.64 $
- * $Date: 2000/04/10 09:40:03 $
+ * $Revision: 1.69 $
+ * $Date: 2000/04/27 16:35:29 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
static String local strCopy ( String );
static Void local browseit ( Module,String,Bool );
static Void local browse ( Void );
+static void local clearCurrentFile ( void );
+
/* --------------------------------------------------------------------------
* Machine dependent code for Hugs interpreter:
List ifaces_outstanding = NIL;
+static ConId currentModule_failed = NIL; /* Remember failed module from :r */
+
+
/* --------------------------------------------------------------------------
* Hugs entry point:
Printf("__ __ __ __ ____ ___ _________________________________________\n");
Printf("|| || || || || || ||__ STGHugs: Based on the Haskell 98 standard\n");
- Printf("||___|| ||__|| ||__|| __|| Copyright (c) 1994-1999\n");
+ Printf("||___|| ||__|| ||__|| __|| Copyright (c) 1994-2000\n");
Printf("||---|| ___|| World Wide Web: http://haskell.org/hugs\n");
Printf("|| || Report bugs to: hugs-bugs@haskell.org\n");
Printf("|| || Version: %s _________________________________________\n\n",HUGS_VERSION);
* Initialization, interpret command line args and read prelude:
* ------------------------------------------------------------------------*/
-static List /*CONID*/ initialize(argc,argv) /* Interpreter initialization */
-Int argc;
-String argv[]; {
- Int i;
- char argv_0_orig[1000];
+static List /*CONID*/ initialize ( Int argc, String argv[] )
+{
+ Int i, j;
List initialModules;
setLastEdit((String)0,0);
readOptions("-p\"%s> \" -r$$");
readOptions(fromEnv("STGHUGSFLAGS",""));
- strncpy(argv_0_orig,argv[0],1000); /* startupHaskell mangles argv[0] */
- startupHaskell (argc,argv,NULL);
- argc = prog_argc;
- argv = prog_argv;
-
# if DEBUG
{
char exe_name[N_INSTALLDIR + 6];
}
# endif
+ /* startupHaskell extracts args between +RTS ... -RTS, and sets
+ prog_argc/prog_argv to the rest. We want to further process
+ the rest, so we then get hold of them again.
+ */
+ startupHaskell ( argc, argv, NULL );
+ getProgArgv ( &argc, &argv );
+
/* Find out early on if we're in combined mode or not.
everybody(PREPREL) needs to know this. Also, establish the
heap size;
*/
- for (i=1; i < argc; ++i) {
+ 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)
+ if (strncmp(argv[i],"+h",2)==0 || strncmp(argv[i],"-h",2)==0)
setHeapSize(&(argv[i][2]));
}
everybody(PREPREL);
initialModules = NIL;
- for (i=1; i < argc; ++i) { /* process command line arguments */
- if (strcmp(argv[i], "--")==0) break;
- if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/
- && !processOption(argv[i])) {
- initialModules
- = cons ( mkCon(findText(argv[i])), initialModules );
+ for (i = 1; i < argc; ++i) { /* process command line arguments */
+ if (strcmp(argv[i], "--")==0)
+ { argv[i] = NULL; break; }
+ if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/) {
+ if (!processOption(argv[i]))
+ initialModules
+ = cons ( mkCon(findText(argv[i])), initialModules );
+ argv[i] = NULL;
}
}
" combined mode\n\n" );
}
+ /* slide args back over the deleted ones. */
+ j = 1;
+ for (i = 1; i < argc; i++)
+ if (argv[i])
+ argv[j++] = argv[i];
+
+ argc = j;
+
+ setProgArgv ( argc, argv );
+
initDone = TRUE;
return initialModules;
}
*toggle[i].flag = state;
return;
}
+ clearCurrentFile();
ERRMSG(0) "Unknown toggle `%c'", c
- EEND;
+ EEND_NO_LONGJMP;
}
static Void local togglesIn(state) /* Print current list of toggles in*/
String s = readFilename();
if (s && chdir(s)) {
ERRMSG(0) "Unable to change to directory \"%s\"", s
- EEND;
+ EEND_NO_LONGJMP;
}
}
}
+/* Refresh the current target modules, and attempt to set the
+ current module to what it was before (ie currentModule):
+ if currentModule_failed is different from currentModule,
+ use that instead
+ if nextCurrMod is non null, try to set it to that instead
+ if the one we're after insn't available, select a target
+ from the end of the module group list.
+*/
static void refreshActions ( ConId nextCurrMod, Bool cleanAfter )
{
List t;
- ConId tryFor = mkCon(module(currentModule).text);
+ ConId tryFor;
+
+ /* Remember what the old current module was. */
+ tryFor = mkCon(module(currentModule).text);
+
+ /* Do the Real Work. */
achieveTargetModules(FALSE);
+
+ /* Remember if the current module was invalidated by this
+ refresh, so later refreshes can attempt to reload it. */
+ if (!elemMG(tryFor))
+ currentModule_failed = tryFor;
+
+ /* If a previous refresh failed to get an old current module,
+ try for that instead. */
+ if (nonNull(currentModule_failed)
+ && textOf(currentModule_failed) != textOf(tryFor)
+ && elemMG(currentModule_failed))
+ tryFor = currentModule_failed;
+ /* If our caller specified a new current module, that overrides
+ all historical settings. */
if (nonNull(nextCurrMod))
tryFor = nextCurrMod;
+ /* Finally, if we can't actually get hold of whatever it was we
+ were after, select something which is possible. */
if (!elemMG(tryFor))
tryFor = selectLatestMG();
+
/* combined mode kludge, to get Prelude rather than PrelHugs */
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);
+ /* 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)) );
bd = type;
if (whatIs(bd)==QUAL) {
+ printing = FALSE;
+ clearCurrentFile();
ERRMSG(0) "Unresolved overloading" ETHEN
ERRTEXT "\n*** Type : " ETHEN ERRTYPE(type);
ERRTEXT "\n*** Expression : " ETHEN ERREXPR(inputExpr);
}
#if 1
+ printing = TRUE;
+ numEnters = 0;
if (isProgType(ks,bd)) {
inputExpr = ap(nameRunIO_toplevel,inputExpr);
evalExp();
} else {
Cell d = provePred(ks,NIL,ap(classShow,bd));
if (isNull(d)) {
+ clearCurrentFile();
+ printing = FALSE;
ERRMSG(0) "Cannot find \"show\" function for:" ETHEN
ERRTEXT "\n*** expression : " ETHEN ERREXPR(inputExpr);
ERRTEXT "\n*** of type : " ETHEN ERRTYPE(type);
nukeModule(evalMod);
setCurrModule(currMod);
setCurrentFile(currMod);
+ stopAnyPrinting();
}
names = addNamesMatching((String)0,names);
}
if (isNull(names)) { /* Then print them out */
+ clearCurrentFile();
ERRMSG(0) "No names selected"
EEND_NO_LONGJMP;
return;
modConIds = initialize(argc,argv); /* the initial modules to load */
setBreakAction ( HugsIgnoreBreak );
prelOK = loadThePrelude();
- if (combined) everybody(POSTPREL);
if (!prelOK) {
if (autoMain)
exit(1);
}
+ if (combined) everybody(POSTPREL);
loadActions(modConIds);
if (autoMain) {
case FIND : find();
break;
case LOAD : modConIds = NIL;
- while ((s=readFilename())!=0)
- modConIds = cons(mkCon(findText(s)),modConIds);
+ while ((s=readFilename())!=0) {
+ modConIds = cons(mkCon(findText(s)),modConIds);
+
+ }
loadActions(modConIds);
modConIds = NIL;
break;
Putchar('\n');
if (showStats) {
#define plural(v) v, (v==1?"":"s")
- Printf("%lu cell%s",plural(numCells));
- if (numGcs>0)
- Printf(", %u garbage collection%s",plural(numGcs));
- Printf(")\n");
+ Printf("(%lu enter%s)\n",plural(numEnters));
#undef plural
}
FlushStdout();
compiler(what);
codegen(what);
- mark(moduleGraph);
- mark(prelModules);
- mark(targetModules);
- mark(daSccs);
+ if (what == MARK) {
+ mark(moduleGraph);
+ mark(prelModules);
+ mark(targetModules);
+ mark(daSccs);
+ mark(currentModule_failed);
+ }
}
/*-------------------------------------------------------------------------*/
projects / ghc-hetmet.git / blobdiff