* in the distribution for details.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.3 $
- * $Date: 1999/02/03 17:08:29 $
+ * $Revision: 1.5 $
+ * $Date: 1999/03/09 14:51:07 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
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 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 namesUpto; /* Number of script names set */
static Bool needsImports; /* set to TRUE if imports required */
static Bool projectLoaded = FALSE; /* TRUE => project file loaded */
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 */
+Bool preludeLoaded = FALSE;
#if REDIRECT_OUTPUT
static Bool disableOutput = FALSE; /* redirect output to buffer? */
Main main(argc,argv)
int argc;
char *argv[]; {
-
#ifdef HAVE_CONSOLE_H /* Macintosh port */
_ftype = 'TEXT';
_fcreator = 'R*ch'; /* // 'KAHL'; //'*TEX'; //'ttxt'; */
interpreter(argc,argv);
Printf("[Leaving Hugs]\n");
everybody(EXIT);
+ shutdownHaskell();
FlushStdout();
fflush(stderr);
exit(0);
readOptions(readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"Options",""));
readOptions(readRegString(HKEY_CURRENT_USER, HugsRoot,"Options",""));
#endif /* USE_REGISTRY */
- readOptions(fromEnv("HUGSFLAGS",""));
+ readOptions(fromEnv("STGHUGSFLAGS",""));
+
+ startupHaskell ( argc, argv );
+ argc = prog_argc; argv = prog_argv;
- for (i=1; i<argc; ++i) { /* process command line arguments */
+ for (i=1; i<argc; ++i) { /* process command line arguments */
if (strcmp(argv[i],"+")==0 && i+1<argc) {
if (proj) {
ERRMSG(0) "Multiple project filenames on command line"
addScriptName(argv[i],TRUE);
}
}
- /* ToDo: clean up this hack */
- {
- static char* my_argv[] = {"Hugs"};
- startupHaskell(sizeof(my_argv)/sizeof(char*),my_argv);
- }
+
#ifdef DEBUG
DEBUG_LoadSymbols(argv[0]);
#endif
loadProject(strCopy(proj));
}
readScripts(0);
- scriptBase = numScripts;
}
/* --------------------------------------------------------------------------
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)) {
currProject = s;
projInput(currProject);
scriptFile = currProject;
- forgetScriptsFrom(scriptBase);
+ forgetScriptsFrom(1);
while ((s=readFilename())!=0)
addScriptName(s,TRUE);
if (namesUpto<=1) {
}
#endif
scriptFile = 0;
+ preludeLoaded = TRUE;
return TRUE;
}
for (i=scno; i<namesUpto; ++i)
if (scriptName[i])
free(scriptName[i]);
- dropScriptsFrom(scno);
+ dropScriptsFrom(scno-1);
namesUpto = scno;
if (numScripts>namesUpto)
numScripts = scno;
/* to be read */
while ((s=readFilename())!=0)
addScriptName(s,TRUE);
- readScripts(scriptBase);
+ 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, */
for (; n<numScripts; n++) { /* Scan previously loaded scripts */
getFileInfo(scriptName[n], &timeStamp, &fileSize);
if (timeChanged(timeStamp,lastChange[n])) {
- dropScriptsFrom(n);
+ dropScriptsFrom(n-1);
numScripts = n;
break;
}
while (numScripts<namesUpto) { /* Process any remaining scripts */
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);
}
if (listScripts)
whatScripts();
- if (numScripts<=scriptBase)
+ if (numScripts<=1)
setLastEdit((String)0, 0);
}
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
}
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
static Void local evaluator() { /* evaluate expr and print value */
Type type, bd;
Kinds ks = NIL;
- Cell temp = NIL;
setCurrModule(findEvalModule());
scriptFile = 0;
#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(namePrint,d,inputExpr);
+ //inputExpr = ap(nameRunIO,inputExpr);
+
+ 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');
}
}
+#endif
+
+#if 0
+ printf ( "result type is " );
+ printType ( stdout, type );
+ printf ( "\n" );
+ evalExp();
+ printf ( "\n" );
+#endif
+
}
static Void local stopAnyPrinting() { /* terminate printing of expression,*/
Tycon tc = findTycon(t);
Class cl = findClass(t);
Name nm = findName(t);
- Module mod = findEvalModule();
+ //Module mod = findEvalModule();
if (nonNull(tc)) { /* as a type constructor */
Type t = tc;
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);
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;
/* ----------------------------------------------------------------------- */
-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);
}
-
/* --------------------------------------------------------------------------
* Hugs for Windows code (WinMain and related functions)
* ------------------------------------------------------------------------*/
projects / ghc-hetmet.git / blobdiff