/* --------------------------------------------------------------------------
* Command interpreter
*
- * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
- * Haskell Group 1994-99, and is distributed as Open Source software
- * under the Artistic License; see the file "Artistic" that is included
- * in the distribution for details.
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved. It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.3 $
- * $Date: 1999/02/03 17:08:29 $
+ * $Revision: 1.12 $
+ * $Date: 1999/10/15 21:40:49 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
static Void local find Args((Void));
static Bool local startEdit Args((Int,String));
static Void local runEditor Args((Void));
-#if IGNORE_MODULES
-#define findEvalModule() doNothing()
-#else
static Void local setModule Args((Void));
static Module local findEvalModule Args((Void));
-#endif
static Void local evaluator Args((Void));
static Void local stopAnyPrinting Args((Void));
static Void local showtype Args((Void));
static Void local loadProject Args((String));
static Void local clearProject Args((Void));
-static Void local addScriptName Args((String,Bool));
-static Bool local addScript Args((String,Long));
+static Bool local addScript Args((Int));
static Void local forgetScriptsFrom Args((Script));
static Void local setLastEdit Args((String,Int));
static Void local failed Args((Void));
static String local strCopy Args((String));
+
/* --------------------------------------------------------------------------
* Machine dependent code for Hugs interpreter:
* ------------------------------------------------------------------------*/
static Bool showStats = FALSE; /* TRUE => print stats after eval */
static Bool listScripts = TRUE; /* TRUE => list scripts after loading*/
static Bool addType = FALSE; /* TRUE => print type with value */
-static Bool useShow = TRUE; /* TRUE => use Text/show printer */
-static Bool chaseImports = TRUE; /* TRUE => chase imports on load */
static Bool useDots = RISCOS; /* TRUE => use dots in progress */
static Bool quiet = FALSE; /* TRUE => don't show progress */
+static Bool lastWasObject = FALSE;
+ Bool preludeLoaded = FALSE;
+ Bool optimise = FALSE;
+
+typedef
+ struct {
+ String modName; /* Module name */
+ Bool details; /* FALSE => remaining fields are invalid */
+ String path; /* Path to module */
+ String srcExt; /* ".hs" or ".lhs" if fromSource */
+ Time lastChange; /* Time of last change to script */
+ Bool fromSource; /* FALSE => load object code */
+ Bool postponed; /* Indicates postponed load */
+ Bool objLoaded;
+ Long size;
+ Long oSize;
+ }
+ ScriptInfo;
+
+static Void local makeStackEntry Args((ScriptInfo*,String));
+static Void local addStackEntry Args((String));
+
+static ScriptInfo scriptInfo[NUM_SCRIPTS];
-static String scriptName[NUM_SCRIPTS]; /* Script file names */
-static Time lastChange[NUM_SCRIPTS]; /* Time of last change to script */
-static Bool postponed[NUM_SCRIPTS]; /* Indicates postponed load */
-static Int scriptBase; /* Number of scripts in Prelude */
static Int numScripts; /* Number of scripts loaded */
+static Int nextNumScripts;
static Int namesUpto; /* Number of script names set */
static Bool needsImports; /* set to TRUE if imports required */
String scriptFile; /* Name of current script (if any) */
+
+
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 */
+static Bool autoMain = FALSE;
static String lastEdit = 0; /* Name of script to edit (if any) */
-static Int lastLine = 0; /* Editor line number (if possible)*/
+static Int lastEdLine = 0; /* Editor line number (if possible)*/
static String prompt = 0; /* Prompt string */
static Int hpSize = DEFAULTHEAP; /* Desired heap size */
-String hugsEdit = 0; /* String for editor command */
-String hugsPath = 0; /* String for file search path */
+ String hugsEdit = 0; /* String for editor command */
+ String hugsPath = 0; /* String for file search path */
#if REDIRECT_OUTPUT
static Bool disableOutput = FALSE; /* redirect output to buffer? */
#endif
+String bool2str ( Bool b )
+{
+ if (b) return "Yes"; else return "No ";
+}
+
+void ppSmStack ( String who )
+{
+ int i, j;
+return;
+ fflush(stdout);fflush(stderr);
+ printf ( "\n" );
+ printf ( "ppSmStack %s: numScripts = %d namesUpto = %d needsImports = %s\n",
+ who, numScripts, namesUpto, bool2str(needsImports) );
+ assert (namesUpto >= numScripts);
+ printf ( " Det FrS Pst ObL Module Ext Size ModTime Path\n" );
+ for (i = namesUpto-1; i >= 0; i--) {
+ printf ( "%c%2d: %3s %3s %3s %3s %16s %-4s %5ld %8lx %s\n",
+ (i==numScripts ? '*' : ' '),
+ i, bool2str(scriptInfo[i].details),
+ bool2str(scriptInfo[i].fromSource),
+ bool2str(scriptInfo[i].postponed),
+ bool2str(scriptInfo[i].objLoaded),
+ scriptInfo[i].modName,
+ scriptInfo[i].fromSource ? scriptInfo[i].srcExt : "",
+ scriptInfo[i].size,
+ scriptInfo[i].lastChange,
+ scriptInfo[i].path
+ );
+ }
+ // printf ( "\n" );
+ fflush(stdout);fflush(stderr);
+ppScripts();
+ppModules();
+ printf ( "\n" );
+}
+
/* --------------------------------------------------------------------------
* Hugs entry point:
* ------------------------------------------------------------------------*/
Main main(argc,argv)
int argc;
char *argv[]; {
-
#ifdef HAVE_CONSOLE_H /* Macintosh port */
_ftype = 'TEXT';
_fcreator = 'R*ch'; /* // 'KAHL'; //'*TEX'; //'ttxt'; */
CStackBase = &argc; /* Save stack base for use in gc */
+ /* Try and figure out an absolute path to the executable, so
+ we can make a reasonable guess about where the default
+ libraries (Prelude etc) are.
+ */
+ setDefaultLibDir ( argv[0] );
+
+ /* If first arg is +Q or -Q, be entirely silent, and automatically run
+ main after loading scripts. Useful for running the nofib suite. */
+ if (argc > 1 && (strcmp(argv[1],"+Q") == 0 || strcmp(argv[1],"-Q")==0)) {
+ autoMain = TRUE;
+ hugsEnableOutput(0);
+ }
+
Printf("__ __ __ __ ____ ___ _______________________________________________\n");
Printf("|| || || || || || ||__ Hugs 98: The Nottingham and Yale Haskell system\n");
Printf("||___|| ||__|| ||__|| __|| Copyright (c) 1994-1999\n");
interpreter(argc,argv);
Printf("[Leaving Hugs]\n");
everybody(EXIT);
+ shutdownHaskell();
FlushStdout();
fflush(stderr);
exit(0);
Int argc;
String argv[]; {
Script i;
- String proj = 0;
+ String proj = 0;
+ char argv_0_orig[1000];
setLastEdit((String)0,0);
lastEdit = 0;
readOptions(readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"Options",""));
readOptions(readRegString(HKEY_CURRENT_USER, HugsRoot,"Options",""));
#endif /* USE_REGISTRY */
- readOptions(fromEnv("HUGSFLAGS",""));
+ readOptions(fromEnv("STGHUGSFLAGS",""));
- for (i=1; i<argc; ++i) { /* process command line arguments */
+ strncpy(argv_0_orig,argv[0],1000); /* startupHaskell mangles argv[0] */
+ startupHaskell (argc,argv);
+ argc = prog_argc; argv = prog_argv;
+
+ namesUpto = numScripts = 0;
+ addStackEntry("Prelude");
+
+ for (i=1; i<argc; ++i) { /* process command line arguments */
+ if (strcmp(argv[i], "--")==0) break;
if (strcmp(argv[i],"+")==0 && i+1<argc) {
if (proj) {
ERRMSG(0) "Multiple project filenames on command line"
}
} else if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/
&& !processOption(argv[i])) {
- addScriptName(argv[i],TRUE);
+ addStackEntry(argv[i]);
}
}
- /* ToDo: clean up this hack */
- {
- static char* my_argv[] = {"Hugs"};
- startupHaskell(sizeof(my_argv)/sizeof(char*),my_argv);
- }
+
#ifdef DEBUG
- DEBUG_LoadSymbols(argv[0]);
+ DEBUG_LoadSymbols(argv_0_orig);
#endif
- scriptName[0] = strCopy(findMPathname(NULL,STD_PRELUDE,hugsPath));
+
+
+#if 0
if (!scriptName[0]) {
Printf("Prelude not found on current path: \"%s\"\n",
hugsPath ? hugsPath : "");
fatal("Unable to load prelude");
}
+#endif
if (haskell98) {
Printf("Haskell 98 mode: Restart with command line option -98 to enable extensions\n\n");
loadProject(strCopy(proj));
}
readScripts(0);
- scriptBase = numScripts;
}
/* --------------------------------------------------------------------------
#if USE_PREPROCESSOR && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
Printf(fmts,"Fstr","Set preprocessor filter to str");
#endif
-#if PROFILING
- Printf(fmts,"dnum","Gather profiling statistics every <num> reductions\n");
-#endif
Printf("\nCurrent settings: ");
togglesIn(TRUE);
Printf("\nPreprocessor : -F");
printString(preprocessor);
#endif
-#if PROFILING
- Printf("\nProfile interval: -d%d", profiling ? profInterval : 0);
-#endif
Printf("\nCompatibility : %s", haskell98 ? "Haskell 98"
: "Hugs Extensions");
Putchar('\n');
#if USE_PREPROCESSOR && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
PUTStr('F',preprocessor);
#endif
-#if PROFILING
- PUTInt('d',profiling ? profInterval : 0);
-#endif
PUTC('\0');
return buffer;
}
while (*++s)
switch (*s) {
+ case 'Q' : break; /* already handled */
+
case 'p' : if (s[1]) {
if (prompt) free(prompt);
prompt = strCopy(s+1);
case 'h' : setHeapSize(s+1);
return TRUE;
- case 'd' : /* hack */
+ case 'D' : /* hack */
{
extern void setRtsFlags( int x );
setRtsFlags(argToInt(s+1));
Int n = 0;
String t = s;
- if (*s=='\0' || !isascii(*s) || !isdigit(*s)) {
+ if (*s=='\0' || !isascii((int)(*s)) || !isdigit((int)(*s))) {
ERRMSG(0) "Missing integer in option setting \"%s\"", t
EEND;
}
EEND;
}
n = 10*n + d;
- } while (isascii(*s) && isdigit(*s));
+ } while (isascii((int)(*s)) && isdigit((int)(*s)));
if (*s=='K' || *s=='k') {
if (n > (MAXPOSINT/1000)) {
{":reload", RELOAD}, {":gc", COLLECT}, {":edit", EDIT},
{":quit", QUIT}, {":set", SET}, {":find", FIND},
{":names", NAMES}, {":info", INFO}, {":project", PROJECT},
-#if !IGNORE_MODULES
+ {":dump", DUMP}, {":ztats", STATS},
{":module",SETMODULE},
-#endif
{"", EVAL},
{0,0}
};
Printf(":project <filename> use project file\n");
Printf(":edit <filename> edit file\n");
Printf(":edit edit last module\n");
-#if !IGNORE_MODULES
Printf(":module <module> set module for evaluating expressions\n");
-#endif
Printf("<expr> evaluate expression\n");
Printf(":type <expr> print type of expression\n");
Printf(":? display this list of commands\n");
Printf(":!command shell escape\n");
Printf(":cd dir change directory\n");
Printf(":gc force garbage collection\n");
+ Printf(":dump <name> print STG code for named fn\n");
+#ifdef CRUDE_PROFILING
+ Printf(":ztats <name> print reduction stats\n");
+#endif
Printf(":quit exit Hugs interpreter\n");
}
{'w', "Always show which modules are loaded", &listScripts},
{'k', "Show kind errors in full", &kindExpert},
{'o', "Allow overlapping instances", &allowOverlap},
- {'i', "Chase imports while loading modules", &chaseImports},
+ {'O', "Optimise (improve?) generated code", &optimise},
#if DEBUG_CODE
{'D', "Debug: show generated code", &debugCode},
#endif
currProject = s;
projInput(currProject);
scriptFile = currProject;
- forgetScriptsFrom(scriptBase);
+ forgetScriptsFrom(1);
while ((s=readFilename())!=0)
- addScriptName(s,TRUE);
+ addStackEntry(s);
if (namesUpto<=1) {
ERRMSG(0) "Empty project file"
EEND;
#endif
}
-static Void local addScriptName(s,sch) /* Add script to list of scripts */
-String s; /* to be read in ... */
-Bool sch; { /* TRUE => requires pathname search*/
+
+
+static Void local makeStackEntry ( ScriptInfo* ent, String iname )
+{
+ Bool ok, fromObj;
+ Bool sAvail, iAvail, oAvail;
+ Time sTime, iTime, oTime;
+ Long sSize, iSize, oSize;
+ String path, sExt;
+
+ ok = findFilesForModule (
+ iname,
+ &path,
+ &sExt,
+ &sAvail, &sTime, &sSize,
+ &iAvail, &iTime, &iSize,
+ &oAvail, &oTime, &oSize
+ );
+ if (!ok) {
+ ERRMSG(0)
+ /* "Can't file source or object+interface for module \"%s\"", */
+ "Can't file source for module \"%s\"",
+ iname
+ EEND;
+ }
+ /* findFilesForModule should enforce this */
+ if (!(sAvail || (oAvail && iAvail)))
+ internal("chase");
+ /* Load objects in preference to sources if both are available */
+ /* 11 Oct 99: disable object loading in the interim.
+ Will probably only reinstate when HEP becomes available.
+ fromObj = sAvail
+ ? (oAvail && iAvail && timeEarlier(sTime,oTime))
+ : TRUE;
+ */
+ fromObj = FALSE;
+
+ /* ToDo: namesUpto overflow */
+ ent->modName = strCopy(iname);
+ ent->details = TRUE;
+ ent->path = path;
+ ent->fromSource = !fromObj;
+ ent->srcExt = sExt;
+ ent->postponed = FALSE;
+ ent->lastChange = sTime; /* ToDo: is this right? */
+ ent->size = fromObj ? iSize : sSize;
+ ent->oSize = fromObj ? oSize : 0;
+ ent->objLoaded = FALSE;
+}
+
+
+
+static Void nukeEnding( String s )
+{
+ Int l = strlen(s);
+ if (l > 2 && strncmp(s+l-2,".o" ,3)==0) s[l-2] = 0; else
+ if (l > 3 && strncmp(s+l-3,".hi" ,3)==0) s[l-3] = 0; else
+ if (l > 3 && strncmp(s+l-3,".hs" ,3)==0) s[l-3] = 0; else
+ if (l > 4 && strncmp(s+l-4,".lhs",4)==0) s[l-4] = 0; else
+ if (l > 4 && strncmp(s+l-4,".dll",4)==0) s[l-4] = 0; else
+ if (l > 4 && strncmp(s+l-4,".DLL",4)==0) s[l-4] = 0;
+}
+
+static Void local addStackEntry(s) /* Add script to list of scripts */
+String s; { /* to be read in ... */
+ String s2;
+ Bool found;
+ Int i;
+
if (namesUpto>=NUM_SCRIPTS) {
ERRMSG(0) "Too many module files (maximum of %d allowed)",
NUM_SCRIPTS
EEND;
}
- else
- scriptName[namesUpto++] = strCopy(sch ? findPathname(NULL,s) : s);
+
+ s = strCopy(s);
+ nukeEnding(s);
+ for (s2 = s; *s2; s2++)
+ if (*s2 == SLASH && *(s2+1)) s = s2+1;
+
+ found = FALSE;
+ for (i = 0; i < namesUpto; i++)
+ if (strcmp(scriptInfo[i].modName,s)==0)
+ found = TRUE;
+
+ if (!found) {
+ makeStackEntry ( &scriptInfo[namesUpto], strCopy(s) );
+ namesUpto++;
+ }
+ free(s);
}
-static Bool local addScript(fname,len) /* read single script file */
-String fname; /* name of script file */
-Long len; { /* length of script file */
- scriptFile = fname;
+/* Return TRUE if no imports were needed; FALSE otherwise. */
+static Bool local addScript(stacknum) /* read single file */
+Int stacknum; {
+ static char name[FILENAME_MAX+1];
+ Int len = scriptInfo[stacknum].size;
#if HUGS_FOR_WINDOWS /* Set clock cursor while loading */
allowBreak();
SetCursor(LoadCursor(NULL, IDC_WAIT));
#endif
- Printf("Reading file \"%s\":\n",fname);
- setLastEdit(fname,0);
-
-#if 0
-ToDo: reinstate
- if (isInterfaceFile(fname)) {
- loadInterface(fname);
- } else
-#else
- {
- needsImports = FALSE;
- parseScript(fname,len); /* process script file */
- if (needsImports)
- return FALSE;
- checkDefns();
- typeCheckDefns();
- compileDefns();
- }
-#endif
- scriptFile = 0;
- return TRUE;
+ // setLastEdit(name,0);
+
+ nameObj[0] = 0;
+ strcpy(name, scriptInfo[stacknum].path);
+ strcat(name, scriptInfo[stacknum].modName);
+ if (scriptInfo[stacknum].fromSource)
+ strcat(name, scriptInfo[stacknum].srcExt); else
+ strcat(name, ".hi");
+
+ scriptFile = name;
+
+ if (scriptInfo[stacknum].fromSource) {
+ if (lastWasObject) finishInterfaces();
+ lastWasObject = FALSE;
+ Printf("Reading script \"%s\":\n",name);
+ needsImports = FALSE;
+ parseScript(name,len);
+ if (needsImports) return FALSE;
+ checkDefns();
+ typeCheckDefns();
+ compileDefns();
+ } else {
+ Printf("Reading iface \"%s\":\n", name);
+ scriptFile = name;
+ needsImports = FALSE;
+
+ // set nameObj for the benefit of openGHCIface
+ strcpy(nameObj, scriptInfo[stacknum].path);
+ strcat(nameObj, scriptInfo[stacknum].modName);
+ strcat(nameObj, DLL_ENDING);
+ sizeObj = scriptInfo[stacknum].oSize;
+
+ loadInterface(name,len);
+ scriptFile = 0;
+ lastWasObject = TRUE;
+ if (needsImports) return FALSE;
+ }
+
+ scriptFile = 0;
+ preludeLoaded = TRUE;
+ return TRUE;
}
+
Bool chase(imps) /* Process list of import requests */
List imps; {
- if (chaseImports) {
- Int origPos = numScripts; /* keep track of original position */
- String origName = scriptName[origPos];
- for (; nonNull(imps); imps=tl(imps)) {
- String iname = findPathname(origName,textToStr(textOf(hd(imps))));
- Int i = 0;
- for (; i<namesUpto; i++)
- if (pathCmp(scriptName[i],iname)==0)
- break;
- if (i>=origPos) { /* Neither loaded or queued */
- String theName;
- Time theTime;
- Bool thePost;
-
- postponed[origPos] = TRUE;
- needsImports = TRUE;
-
- if (i>=namesUpto) /* Name not found (i==namesUpto) */
- addScriptName(iname,FALSE);
- else if (postponed[i]) {/* Check for recursive dependency */
- ERRMSG(0)
- "Recursive import dependency between \"%s\" and \"%s\"",
- scriptName[origPos], iname
- EEND;
- }
- /* Right rotate section of tables between numScripts and i so
- * that i ends up with other imports in front of orig. script
- */
- theName = scriptName[i];
- thePost = postponed[i];
- timeSet(theTime,lastChange[i]);
- for (; i>numScripts; i--) {
- scriptName[i] = scriptName[i-1];
- postponed[i] = postponed[i-1];
- timeSet(lastChange[i],lastChange[i-1]);
- }
- scriptName[numScripts] = theName;
- postponed[numScripts] = thePost;
- timeSet(lastChange[numScripts],theTime);
- origPos++;
+ Int dstPosn;
+ ScriptInfo tmp;
+ Int origPos = numScripts; /* keep track of original position */
+ String origName = scriptInfo[origPos].modName;
+ for (; nonNull(imps); imps=tl(imps)) {
+ String iname = textToStr(textOf(hd(imps)));
+ Int i = 0;
+ for (; i<namesUpto; i++)
+ if (strcmp(scriptInfo[i].modName,iname)==0)
+ break;
+ //fprintf(stderr, "import name = %s num = %d\n", iname, i );
+
+ if (i<namesUpto) {
+ /* We should have filled in the details of each module
+ the first time we hear about it.
+ */
+ assert(scriptInfo[i].details);
+ }
+
+ if (i>=origPos) { /* Neither loaded or queued */
+ String theName;
+ Time theTime;
+ Bool thePost;
+ Bool theFS;
+
+ needsImports = TRUE;
+ if (scriptInfo[origPos].fromSource)
+ scriptInfo[origPos].postponed = TRUE;
+
+ if (i==namesUpto) { /* Name not found (i==namesUpto) */
+ /* Find out where it lives, whether source or object, etc */
+ makeStackEntry ( &scriptInfo[i], iname );
+ namesUpto++;
+ }
+ else
+ if (scriptInfo[i].postponed && scriptInfo[i].fromSource) {
+ /* Check for recursive dependency */
+ ERRMSG(0)
+ "Recursive import dependency between \"%s\" and \"%s\"",
+ scriptInfo[origPos].modName, iname
+ EEND;
}
+ /* Move stack entry i to somewhere below origPos. If i denotes
+ * an object, destination is immediately below origPos.
+ * Otherwise, it's underneath the queue of objects below origPos.
+ */
+ dstPosn = origPos-1;
+ if (scriptInfo[i].fromSource)
+ while (!scriptInfo[dstPosn].fromSource && dstPosn > 0)
+ dstPosn--;
+
+ dstPosn++;
+ tmp = scriptInfo[i];
+ for (; i > dstPosn; i--) scriptInfo[i] = scriptInfo[i-1];
+ scriptInfo[dstPosn] = tmp;
+ if (dstPosn < nextNumScripts) nextNumScripts = dstPosn;
+ origPos++;
}
- return needsImports;
}
- return FALSE;
+ return needsImports;
}
static Void local forgetScriptsFrom(scno)/* remove scripts from system */
Script scno; {
Script i;
+#if 0
for (i=scno; i<namesUpto; ++i)
if (scriptName[i])
free(scriptName[i]);
- dropScriptsFrom(scno);
+#endif
+ dropScriptsFrom(scno-1);
namesUpto = scno;
if (numScripts>namesUpto)
numScripts = scno;
String s; /* and add to list of scripts waiting */
/* to be read */
while ((s=readFilename())!=0)
- addScriptName(s,TRUE);
- readScripts(scriptBase);
+ addStackEntry(s);
+ readScripts(1);
}
static Void local project() { /* read list of script names from */
EEND;
}
loadProject(s);
- readScripts(scriptBase);
+ readScripts(1);
}
static Void local readScripts(n) /* Reread current list of scripts, */
Int n; { /* loading everything after and */
Time timeStamp; /* including the first script which*/
Long fileSize; /* has been either changed or added*/
+ static char name[FILENAME_MAX+1];
+ lastWasObject = FALSE;
+ ppSmStack("readscripts-begin");
#if HUGS_FOR_WINDOWS
SetCursor(LoadCursor(NULL, IDC_WAIT));
#endif
+#if 0
for (; n<numScripts; n++) { /* Scan previously loaded scripts */
+ ppSmStack("readscripts-loop1");
getFileInfo(scriptName[n], &timeStamp, &fileSize);
if (timeChanged(timeStamp,lastChange[n])) {
- dropScriptsFrom(n);
+ dropScriptsFrom(n-1);
numScripts = n;
break;
}
}
for (; n<NUM_SCRIPTS; n++) /* No scripts have been postponed */
postponed[n] = FALSE; /* at this stage */
+ numScripts = 0;
while (numScripts<namesUpto) { /* Process any remaining scripts */
+ ppSmStack("readscripts-loop2");
getFileInfo(scriptName[numScripts], &timeStamp, &fileSize);
timeSet(lastChange[numScripts],timeStamp);
- startNewScript(scriptName[numScripts]);
+ if (numScripts>0) /* no new script for prelude */
+ startNewScript(scriptName[numScripts]);
if (addScript(scriptName[numScripts],fileSize))
numScripts++;
else
- dropScriptsFrom(numScripts);
+ dropScriptsFrom(numScripts-1);
+ }
+#endif
+
+ interface(RESET);
+
+ for (; n<numScripts; n++) {
+ ppSmStack("readscripts-loop2");
+ strcpy(name, scriptInfo[n].path);
+ strcat(name, scriptInfo[n].modName);
+ if (scriptInfo[n].fromSource)
+ strcat(name, scriptInfo[n].srcExt); else
+ strcat(name, ".hi"); //ToDo: should be .o
+ getFileInfo(name,&timeStamp, &fileSize);
+ if (timeChanged(timeStamp,scriptInfo[n].lastChange)) {
+ dropScriptsFrom(n-1);
+ numScripts = n;
+ break;
+ }
+ }
+ for (; n<NUM_SCRIPTS; n++)
+ scriptInfo[n].postponed = FALSE;
+
+ //numScripts = 0;
+
+ while (numScripts < namesUpto) {
+ppSmStack ( "readscripts-loop2" );
+
+ if (scriptInfo[numScripts].fromSource) {
+
+ if (numScripts>0)
+ startNewScript(scriptInfo[numScripts].modName);
+ nextNumScripts = NUM_SCRIPTS; //bogus initialisation
+ if (addScript(numScripts)) {
+ numScripts++;
+assert(nextNumScripts==NUM_SCRIPTS);
+ }
+ else
+ dropScriptsFrom(numScripts-1);
+
+ } else {
+
+ if (scriptInfo[numScripts].objLoaded) {
+ numScripts++;
+ } else {
+ scriptInfo[numScripts].objLoaded = TRUE;
+ /* new */
+ if (numScripts>0)
+ startNewScript(scriptInfo[numScripts].modName);
+ /* end */
+ nextNumScripts = NUM_SCRIPTS;
+ if (addScript(numScripts)) {
+ numScripts++;
+assert(nextNumScripts==NUM_SCRIPTS);
+ } else {
+ //while (!scriptInfo[numScripts].fromSource && numScripts > 0)
+ // numScripts--;
+ //if (scriptInfo[numScripts].fromSource)
+ // numScripts++;
+ numScripts = nextNumScripts;
+assert(nextNumScripts<NUM_SCRIPTS);
+ }
+ }
+ }
+if (numScripts==namesUpto) ppSmStack( "readscripts-final") ;
+ }
+
+ finishInterfaces();
+
+ { Int m = namesUpto-1;
+ Text mtext = findText(scriptInfo[m].modName);
+ setCurrModule(mtext);
+ evalModule = mtext;
}
+
+
if (listScripts)
whatScripts();
- if (numScripts<=scriptBase)
+ if (numScripts<=1)
setLastEdit((String)0, 0);
+ ppSmStack("readscripts-end ");
}
static Void local whatScripts() { /* list scripts in current session */
if (projectLoaded)
Printf(" (project: %s)",currProject);
for (i=0; i<numScripts; ++i)
- Printf("\n%s",scriptName[i]);
+ Printf("\n%s%s",scriptInfo[i].path, scriptInfo[i].modName);
Putchar('\n');
}
}
static Void local find() { /* edit file containing definition */
+#if 0
+This just plain wont work no more.
+ToDo: Fix!
String nm = readFilename(); /* of specified name */
if (!nm) {
ERRMSG(0) "No name specified"
startNewScript(0);
if (nonNull(c=findTycon(t=findText(nm)))) {
if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
- readScripts(scriptBase);
+ readScripts(1);
}
} else if (nonNull(c=findName(t))) {
if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
- readScripts(scriptBase);
+ readScripts(1);
}
} else {
ERRMSG(0) "No current definition for name \"%s\"", nm
EEND;
}
}
+#endif
}
static Void local runEditor() { /* run editor on script lastEdit */
- if (startEdit(lastLine,lastEdit)) /* at line lastLine */
- readScripts(scriptBase);
+ if (startEdit(lastEdLine,lastEdit)) /* at line lastEdLine */
+ readScripts(1);
}
static Void local setLastEdit(fname,line)/* keep name of last file to edit */
if (lastEdit)
free(lastEdit);
lastEdit = strCopy(fname);
- lastLine = line;
+ lastEdLine = line;
#if HUGS_FOR_WINDOWS
DrawStatusLine(hWndMain); /* Redo status line */
#endif
* Read and evaluate an expression:
* ------------------------------------------------------------------------*/
-#if !IGNORE_MODULES
static Void local setModule(){/*set module in which to evaluate expressions*/
String s = readFilename();
if (!s) s = ""; /* :m clears the current module selection */
m = lastModule();
return m;
}
-#endif
static Void local evaluator() { /* evaluate expr and print value */
Type type, bd;
Kinds ks = NIL;
- Cell temp = NIL;
setCurrModule(findEvalModule());
scriptFile = 0;
EEND;
}
-#if PROFILING
- if (profiling)
- profilerLog("profile.hp");
- numReductions = 0;
- garbageCollect();
-#endif
-
#ifdef WANT_TIMER
updateTimers();
#endif
+
+#if 1
if (typeMatches(type,ap(typeIO,typeUnit))) {
inputExpr = ap(nameRunIO,inputExpr);
evalExp();
ERRTEXT "\n"
EEND;
}
- inputExpr = ap2(namePrint,d,inputExpr);
- inputExpr = ap(nameRunIO,inputExpr);
- evalExp();
+ inputExpr = ap2(findName(findText("show")),d,inputExpr);
+ inputExpr = ap(findName(findText("putStr")), inputExpr);
+ inputExpr = ap(nameRunIO, inputExpr);
+
+ evalExp(); printf("\n");
if (addType) {
printf(" :: ");
printType(stdout,type);
Putchar('\n');
}
}
+
+#else
+
+ printf ( "result type is " );
+ printType ( stdout, type );
+ printf ( "\n" );
+ evalExp();
+ printf ( "\n" );
+
+#endif
+
}
static Void local stopAnyPrinting() { /* terminate printing of expression,*/
Putchar('\n');
if (showStats) {
#define plural(v) v, (v==1?"":"s")
- /* Printf("(%lu reduction%s, ",plural(numReductions)); */
Printf("%lu cell%s",plural(numCells));
if (numGcs>0)
Printf(", %u garbage collection%s",plural(numGcs));
#endif
}
+extern Name nameHw;
+
+static Void local dumpStg( void ) { /* print STG stuff */
+ String s;
+ Text t;
+ Name n;
+ Int i;
+ Cell v; /* really StgVar */
+ setCurrModule(findEvalModule());
+ startNewScript(0);
+ for (; (s=readFilename())!=0;) {
+ t = findText(s);
+ v = n = NIL;
+ /* find the name while ignoring module scopes */
+ for (i=NAMEMIN; i<nameHw; i++)
+ if (name(i).text == t) n = i;
+
+ /* perhaps it's an "idNNNNNN" thing? */
+ if (isNull(n) &&
+ strlen(s) >= 3 &&
+ s[0]=='i' && s[1]=='d' && isdigit(s[2])) {
+ v = 0;
+ i = 2;
+ while (isdigit(s[i])) {
+ v = v * 10 + (s[i]-'0');
+ i++;
+ }
+ v = -v;
+ n = nameFromStgVar(v);
+ }
+
+ if (isNull(n) && whatIs(v)==STGVAR) {
+ Printf ( "\n{- `%s' has no nametable entry -}\n", s );
+ Printf ( "{- stgSize of body is %d -}\n\n", stgSize(stgVarBody(v)));
+ printStg(stderr, v );
+ } else
+ if (isNull(n)) {
+ Printf ( "Unknown reference `%s'\n", s );
+ } else
+ if (!isName(n)) {
+ Printf ( "Not a Name: `%s'\n", s );
+ } else
+ if (isNull(name(n).stgVar)) {
+ Printf ( "Doesn't have a STG tree: %s\n", s );
+ } else {
+ Printf ( "\n{- stgVar of `%s' is id%d -}\n", s, -name(n).stgVar);
+ Printf ( "{- stgSize of body is %d -}\n\n",
+ stgSize(stgVarBody(name(n).stgVar)));
+ printStg(stderr, name(n).stgVar);
+ }
+ }
+}
+
static Void local info() { /* describe objects */
Int count = 0; /* or give menu of commands */
String s;
}
}
+
static Void local describe(t) /* describe an object */
Text t; {
Tycon tc = findTycon(t);
Class cl = findClass(t);
Name nm = findName(t);
- Module mod = findEvalModule();
+ Module mod = findModule(t);
if (nonNull(tc)) { /* as a type constructor */
Type t = tc;
} else if (isSfun(nm)) {
Printf(" -- selector function");
}
-#if 0
- ToDo: reinstate
- if (name(nm).primDef) {
- Printf(" -- primitive");
+ Printf("\n\n");
+ }
+
+ if (nonNull(mod)) { /* as a module */
+ List t;
+ Printf("-- module\n");
+
+ Printf("\n-- values\n");
+ for (t=module(mod).names; nonNull(t); t=tl(t)) {
+ Name nm = hd(t);
+ Printf ( "%s ", textToStr(name(nm).text));
}
-#endif
+
+ Printf("\n\n-- type constructors\n");
+ for (t=module(mod).tycons; nonNull(t); t=tl(t)) {
+ Tycon tc = hd(t);
+ Printf ( "%s ", textToStr(tycon(tc).text));
+ }
+
+ Printf("\n\n-- classes\n");
+ for (t=module(mod).classes; nonNull(t); t=tl(t)) {
+ Class cl = hd(t);
+ Printf ( "%s ", textToStr(cclass(cl).text));
+ }
+
Printf("\n\n");
}
- if (isNull(tc) && isNull(cl) && isNull(nm)) {
+ if (isNull(tc) && isNull(cl) && isNull(nm) && isNull(mod)) {
Printf("Unknown reference `%s'\n",textToStr(t));
}
}
case NON_ASS : break;
}
Printf(" %i ",precOf(sy));
- if (isascii(*s) && isalpha(*s)) {
+ if (isascii((int)(*s)) && isalpha((int)(*s))) {
Printf("`%s`",s);
} else {
Printf("%s",s);
internal("Combined prompt and evaluation module name too long");
}
#endif
- consoleInput(promptBuffer);
+ if (autoMain)
+ stringInput("main\0"); else
+ consoleInput(promptBuffer);
}
/* --------------------------------------------------------------------------
String argv[]; {
Int errorNumber = setjmp(catch_error);
+ if (errorNumber && autoMain) {
+ fprintf(stderr, "hugs +Q: compilation failed -- can't run `main'\n" );
+ exit(1);
+ }
+
breakOn(TRUE); /* enable break trapping */
if (numScripts==0) { /* only succeeds on first time, */
if (errorNumber) /* before prelude has been loaded */
for (;;) {
Command cmd;
everybody(RESET); /* reset to sensible initial state */
- dropScriptsFrom(numScripts); /* remove partially loaded scripts */
+ dropScriptsFrom(numScripts-1); /* remove partially loaded scripts */
+ /* not counting prelude as a script*/
promptForInput(textToStr(module(findEvalModule()).text));
case FIND : find();
break;
case LOAD : clearProject();
- forgetScriptsFrom(scriptBase);
+ forgetScriptsFrom(1);
load();
break;
case ALSO : clearProject();
forgetScriptsFrom(numScripts);
load();
break;
- case RELOAD : readScripts(scriptBase);
+ case RELOAD : readScripts(1);
break;
case PROJECT: project();
break;
-#if !IGNORE_MODULES
case SETMODULE :
setModule();
break;
-#endif
case EVAL : evaluator();
break;
case TYPEOF : showtype();
break;
case SET : set();
break;
+ case STATS:
+#ifdef CRUDE_PROFILING
+ cp_show();
+#endif
+ break;
case SYSTEM : if (shellEsc(readLine()))
Printf("Warning: Shell escape terminated abnormally\n");
break;
break;
case INFO : info();
break;
+ case DUMP : dumpStg();
+ break;
case QUIT : return;
case COLLECT: consGC = FALSE;
garbageCollect();
Printf("Elapsed time (ms): %ld (user), %ld (system)\n",
millisecs(userElapsed), millisecs(systElapsed));
#endif
+ if (autoMain) break;
}
breakOn(FALSE);
}
/* ----------------------------------------------------------------------- */
-static HugsStream outputStream;
+static HugsStream outputStreamH;
/* ADR note:
- * We rely on standard C semantics to initialise outputStream.next to 0.
+ * We rely on standard C semantics to initialise outputStreamH.next to 0.
*/
Void hugsEnableOutput(f)
}
String hugsClearOutputBuffer() {
- return bufferClear(&outputStream);
+ return bufferClear(&outputStreamH);
}
#ifdef HAVE_STDARG_H
if (!disableOutput) {
vprintf(fmt, ap);
} else {
- vBufferedPrintf(&outputStream, fmt, ap);
+ vBufferedPrintf(&outputStreamH, fmt, ap);
}
va_end(ap); /* clean up */
}
if (!disableOutput) {
vprintf(fmt, ap);
} else {
- vBufferedPrintf(&outputStream, fmt, ap);
+ vBufferedPrintf(&outputStreamH, fmt, ap);
}
va_end(ap); /* clean up */
}
if (!disableOutput) {
putchar(c);
} else {
- bufferedPutchar(&outputStream, c);
+ bufferedPutchar(&outputStreamH, c);
}
}
if (!disableOutput) {
vfprintf(fp, fmt, ap);
} else {
- vBufferedPrintf(&outputStream, fmt, ap);
+ vBufferedPrintf(&outputStreamH, fmt, ap);
}
va_end(ap);
}
if (!disableOutput) {
vfprintf(fp, fmt, ap);
} else {
- vBufferedPrintf(&outputStream, fmt, ap);
+ vBufferedPrintf(&outputStreamH, fmt, ap);
}
va_end(ap);
}
if (!disableOutput) {
putc(c,fp);
} else {
- bufferedPutchar(&outputStream, c);
+ bufferedPutchar(&outputStreamH, c);
}
}
storage(what); /* important for the INSTALL command */
substitution(what);
input(what);
+ translateControl(what);
linkControl(what);
staticAnalysis(what);
deriveControl(what);
typeChecker(what);
- translateControl(what);
compiler(what);
codegen(what);
+ optimiser(what);
}
-
/* --------------------------------------------------------------------------
* Hugs for Windows code (WinMain and related functions)
* ------------------------------------------------------------------------*/
#if HUGS_FOR_WINDOWS
#include "winhugs.c"
#endif
-
-/*-------------------------------------------------------------------------*/
-
projects / ghc-hetmet.git / blobdiff