-
/* --------------------------------------------------------------------------
* Input functions, lexical analysis parsing etc...
*
* included in the distribution.
*
* $RCSfile: input.c,v $
- * $Revision: 1.21 $
- * $Date: 2000/03/13 11:37:16 $
+ * $Revision: 1.30 $
+ * $Date: 2000/04/25 17:43:49 $
* ------------------------------------------------------------------------*/
-#include "prelude.h"
+#include "hugsbasictypes.h"
#include "storage.h"
#include "connect.h"
#include "errors.h"
#include <windows.h>
#endif
-#if IS_WIN32 || HUGS_FOR_WINDOWS
+#if IS_WIN32
#undef IN
#endif
-#if HAVE_LIBREADLINE && HAVE_READLINE_READLINE_H && HAVE_READLINE_HISTORY_H
+#if HAVE_READLINE_LIBS && HAVE_READLINE_HEADERS
#define USE_READLINE 1
#else
#define USE_READLINE 0
static Text textThen, textElse, textWhere, textLet, textIn;
static Text textInfix, textInfixl, textInfixr, textForeign, textNewtype;
static Text textDefault, textDeriving, textDo, textClass, textInstance;
+static Text textMdo;
#if IPARAM
static Text textWith, textDlet;
#endif
Text textStdcall; /* stdcall */
Text textNum; /* Num */
+Text textPrelPrim; /* PrelPrim */
Text textPrelude; /* Prelude */
Text textPlus; /* (+) */
static Cell varHiding; /* hiding */
static Cell varQualified; /* qualified */
static Cell varAsMod; /* as */
-static Cell varPrivileged; /* privileged */
static List imps; /* List of imports to be chased */
closeAnyInput();
}
else if (reading==KEYBOARD) {
- allowBreak();
+ /* allowBreak(); */
if (c0=='\n')
c1 = EOF;
else {
c1 = nextConsoleChar();
-#if IS_WIN32 && !HUGS_FOR_WINDOWS
+#if IS_WIN32
Sleep(0);
#endif
/* On Win32, hitting ctrl-C causes the next getchar to
* fail - returning "-1" to indicate an error.
* This is one of the rare cases where "-1" does not mean EOF.
*/
- if (EOF == c1 && (!feof(stdin) || broken==TRUE)) {
+ if (EOF == c1 && (!feof(stdin) /* || broken==TRUE */)) {
c1 = ' ';
}
}
startToken();
while (c0!=EOF && !isIn(c0,ZPACE)) {
- if (c0=='"') {
+ if (c0=='"') {
skip();
while (c0!=EOF && c0!='\"') {
Cell c = readAChar(TRUE);
* - Otherwise, if no `{' follows the keywords WHERE/LET or OF, a SOFT `{'
* is inserted with the column number of the first token after the
* WHERE/LET/OF keyword.
- * - When a soft indentation is uppermost on the indetation stack with
+ * - When a soft indentation is uppermost on the indentation stack with
* column col' we insert:
* `}' in front of token with column<col' and pop indentation off stack,
* `;' in front of token with column==col'.
if (it==textHiding) return HIDING;
if (it==textQualified) return QUALIFIED;
if (it==textAsMod) return ASMOD;
- if (it==textPrivileged) return PRIVILEGED;
if (it==textWildcard) return '_';
if (it==textAll && !haskell98) return ALL;
#if IPARAM
if (it==textWith && !haskell98) lookAhead(WITH);
if (it==textDlet && !haskell98) lookAhead(DLET);
+ if (it==textMdo && !haskell98) lookAhead(MDO);
#endif
if (it==textUUAll) return ALL;
if (it==textUUUsage) return UUUSAGE;
ERRMSG(row) "Parser overflow" /* as all syntax errors are caught */
EEND; /* in the parser... */
}
+
+ if (startWith==SCRIPT) pop(); /* zap spurious closing } token */
final = pop();
+
if (!stackEmpty()) /* stack should now be empty */
internal("parseInput");
return final;
}
-#ifdef HSCRIPT
-static String memPrefix = "@mem@";
-static Int lenMemPrefix = 5; /* strlen(memPrefix)*/
-
-Void makeMemScript(mem,fname)
-String mem;
-String fname; {
- strcat(fname,memPrefix);
- itoa((int)mem, fname+strlen(fname), 10);
-}
-
-Bool isMemScript(fname)
-String fname; {
- return (strstr(fname,memPrefix) != NULL);
-}
-
-String memScriptString(fname)
-String fname; {
- String p = strstr(fname,memPrefix);
- if (p) {
- return (String)atoi(p+lenMemPrefix);
- } else {
- return NULL;
- }
-}
-
-Void parseScript(fname,len) /* Read a script, possibly from mem */
-String fname;
-Long len; {
- input(RESET);
- if (isMemScript(fname)) {
- char* s = memScriptString(fname);
- stringInput(s);
- } else {
- fileInput(fname,len);
- }
- parseInput(SCRIPT);
-}
-#else
-Void parseScript(nm,len) /* Read a script */
-String nm;
-Long len; { /* Used to set a target for reading */
- input(RESET);
- fileInput(nm,len);
- parseInput(SCRIPT);
-}
-#endif
-
Void parseExp() { /* Read an expression to evaluate */
parseInput(EXPR);
setLastExpr(inputExpr);
}
-
#if EXPLAIN_INSTANCE_RESOLUTION
Void parseContext() { /* Read a context to prove */
parseInput(CONTEXT);
String nm;
Long len; { /* Used to set a target for reading */
input(RESET);
+ Printf("Reading interface \"%s\"\n", nm );
fileInput(nm,len);
return parseInput(INTERFACE);
}
+Cell parseModule(nm,len) /* Read a module */
+String nm;
+Long len; { /* Used to set a target for reading */
+ input(RESET);
+ Printf("Reading source file \"%s\"\n", nm );
+ fileInput(nm,len);
+ return parseInput(SCRIPT);
+}
+
/* --------------------------------------------------------------------------
* Input control:
textDefault = findText("default");
textDeriving = findText("deriving");
textDo = findText("do");
+ textMdo = findText("mdo");
textClass = findText("class");
#if IPARAM
textWith = findText("with");
textBang = findText("!");
textDot = findText(".");
textImplies = findText("=>");
+ textPrelPrim = findText("PrelPrim");
textPrelude = findText("Prelude");
textNum = findText("Num");
textModule = findText("module");
textHiding = findText("hiding");
textQualified = findText("qualified");
textAsMod = findText("as");
- textPrivileged = findText("privileged");
textWildcard = findText("_");
textAll = findText("forall");
textUUAll = findText("__forall");
varHiding = mkVar(textHiding);
varQualified = mkVar(textQualified);
varAsMod = mkVar(textAsMod);
- varPrivileged = mkVar(textPrivileged);
conMain = mkCon(findText("Main"));
varMain = mkVar(findText("main"));
evalDefaults = NIL;
mark(varHiding);
mark(varQualified);
mark(varAsMod);
- mark(varPrivileged);
mark(varMain);
mark(conMain);
mark(imps);
projects / ghc-hetmet.git / blobdiff