* included in the distribution.
*
* $RCSfile: input.c,v $
- * $Revision: 1.8 $
- * $Date: 1999/10/15 21:40:50 $
+ * $Revision: 1.20 $
+ * $Date: 2000/03/10 20:03:36 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "storage.h"
-#include "backend.h"
#include "connect.h"
-#include "command.h"
#include "errors.h"
-#include "link.h"
+
#include <ctype.h>
#if HAVE_GETDELIM_H
#include "getdelim.h"
#endif
-#if HUGS_FOR_WINDOWS
+#if IS_WIN32
+#include <windows.h>
+#endif
+
+#if IS_WIN32 || HUGS_FOR_WINDOWS
#undef IN
#endif
+#if HAVE_LIBREADLINE && HAVE_READLINE_READLINE_H && HAVE_READLINE_HISTORY_H
+#define USE_READLINE 1
+#else
+#define USE_READLINE 0
+#endif
+
+#if USE_READLINE
+#include <readline/readline.h>
+#include <readline/history.h>
+#endif
+
+
/* --------------------------------------------------------------------------
* Global data:
* ------------------------------------------------------------------------*/
-List tyconDefns = NIL; /* type constructor definitions */
-List typeInDefns = NIL; /* type synonym restrictions */
-List valDefns = NIL; /* value definitions in script */
-List classDefns = NIL; /* class defns in script */
-List instDefns = NIL; /* instance defns in script */
-List selDefns = NIL; /* list of selector lists */
-List genDefns = NIL; /* list of generated names */
-List unqualImports = NIL; /* unqualified import list */
-List foreignImports = NIL; /* foreign imports */
-List foreignExports = NIL; /* foreign exportsd */
-List defaultDefns = NIL; /* default definitions (if any) */
-Int defaultLine = 0; /* line in which default defs occur*/
-List evalDefaults = NIL; /* defaults for evaluator */
-
-Cell inputExpr = NIL; /* input expression */
-Bool literateScripts = FALSE; /* TRUE => default to lit scripts */
-Bool literateErrors = TRUE; /* TRUE => report errs in lit scrs */
-Bool offsideON = TRUE; /* TRUE => implement offside rule */
+List tyconDefns = NIL; /* type constructor definitions */
+List typeInDefns = NIL; /* type synonym restrictions */
+List valDefns = NIL; /* value definitions in script */
+List classDefns = NIL; /* class defns in script */
+List instDefns = NIL; /* instance defns in script */
+List selDefns = NIL; /* list of selector lists */
+List genDefns = NIL; /* list of generated names */
+List unqualImports = NIL; /* unqualified import list */
+List foreignImports = NIL; /* foreign imports */
+List foreignExports = NIL; /* foreign exportsd */
+List defaultDefns = NIL; /* default definitions (if any) */
+Int defaultLine = 0; /* line in which default defs occur*/
+List evalDefaults = NIL; /* defaults for evaluator */
+
+Cell inputExpr = NIL; /* input expression */
+Cell inputContext = NIL; /* input context */
+Bool literateScripts = FALSE; /* TRUE => default to lit scripts */
+Bool literateErrors = TRUE; /* TRUE => report errs in lit scrs */
+Bool offsideON = TRUE; /* TRUE => implement offside rule */
+Bool readingInterface = FALSE;
String repeatStr = 0; /* Repeat last expr */
static Int local yylex Args((Void));
static Int local repeatLast Args((Void));
-static Void local parseInput Args((Int));
+static Cell local parseInput Args((Int));
static Bool local doesNotExceed Args((String,Int,Int));
static Int local stringToInt Args((String,Int));
static Text textThen, textElse, textWhere, textLet, textIn;
static Text textInfix, textInfixl, textInfixr, textForeign, textNewtype;
static Text textDefault, textDeriving, textDo, textClass, textInstance;
+#if IPARAM
+static Text textWith, textDlet;
+#endif
static Text textCoco, textEq, textUpto, textAs, textLambda;
static Text textBar, textMinus, textFrom, textArrow, textLazy;
static Text textWildcard;
static Text textModule, textImport, textInterface, textInstImport;
-static Text textHiding, textQualified, textAsMod;
+static Text textHiding, textQualified, textAsMod, textPrivileged;
static Text textExport, textDynamic, textUUExport;
-static Text textUnsafe, textUUAll;
+static Text textUnsafe, textUUAll, textUUUsage;
+
+Text textCcall; /* ccall */
+Text textStdcall; /* stdcall */
Text textNum; /* Num */
Text textPrelude; /* Prelude */
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 */
#define LARGE 0x04
#define SYMBOL 0x08
#define IDAFTER 0x10
-#define SPACE 0x20
+#define ZPACE 0x20
#define PRINT 0x40
static Void local initCharTab() { /* Initialize char decode table */
setChar (IDAFTER, '\''); /* Characters in identifier */
setCopy (IDAFTER, (DIGIT|SMALL|LARGE));
- setChar (SPACE, ' '); /* ASCII space character */
- setChar (SPACE, 160); /* ISO non breaking space */
- setRange(SPACE, 9,13); /* special whitespace: \t\n\v\f\r */
+ setChar (ZPACE, ' '); /* ASCII space character */
+ setChar (ZPACE, 160); /* ISO non breaking space */
+ setRange(ZPACE, 9,13); /* special whitespace: \t\n\v\f\r */
setChars(PRINT, "(),;[]_`{}"); /* Special characters */
setChars(PRINT, " '\""); /* Space and quotes */
*
* At the lowest level of input, characters are read one at a time, with the
* current character held in c0 and the following (lookahead) character in
- * c1. The corrdinates of c0 within the file are held in (column,row).
+ * c1. The coordinates of c0 within the file are held in (column,row).
* The input stream is advanced by one character using the skip() function.
* ------------------------------------------------------------------------*/
static String nextChar;
#define nextConsoleChar() \
(unsigned char)(*nextChar=='\0' ? '\n' : *nextChar++)
-extern Void add_history Args((String));
-extern String readline Args((String));
#else
#define nextConsoleChar() getc(stdin)
#endif
if (s[i] != '\0') { /* check s `isPrefixOf` line */
return FALSE;
}
- while (isIn(line[i], SPACE)) { /* allow whitespace at end of line */
+ while (isIn(line[i], ZPACE)) { /* allow whitespace at end of line */
++i;
}
return (line[i] == '\0');
c1 = EOF;
else {
c1 = nextConsoleChar();
- /* 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)) {
+#if IS_WIN32 && !HUGS_FOR_WINDOWS
+ 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)) {
c1 = ' ';
}
}
litLines++;
return;
}
- while (c0 != '\n' && isIn(c0,SPACE)) /* maybe line is blank? */
+ while (c0 != '\n' && isIn(c0,ZPACE)) /* maybe line is blank? */
skip();
if (c0=='\n' || c0==EOF)
thisLineIs(BLANKLINE);
} while (isISO(c0) && isIn(c0,IDAFTER));
endToken();
identType = isIn(tokenStr[0],LARGE) ? CONID : VARID;
- return findText(tokenStr);
+ if (readingInterface)
+ return unZcodeThenFindText(tokenStr); else
+ return findText(tokenStr);
}
ERRMSG(row) "Illegal escape sequence"
EEND;
}
- else if (isIn(c0,SPACE)) {
+ else if (isIn(c0,ZPACE)) {
if (isStrLit) {
skipGap();
return NIL;
newlineSkip();
else
skip();
- while (isISO(c0) && isIn(c0,SPACE));
+ while (isISO(c0) && isIn(c0,ZPACE));
if (c0!='\\') {
ERRMSG(row) "Missing `\\' terminating string literal gap"
EEND;
String t = s;
Char c;
while ((c = *t)!=0 && isISO(c)
- && isIn(c,PRINT) && c!='"' && !isIn(c,SPACE)) {
+ && isIn(c,PRINT) && c!='"' && !isIn(c,ZPACE)) {
t++;
}
if (*t) {
do { /* which is empty */
saveTokenChar(c0);
skip();
- } while (c0!=EOF && !isIn(c0,SPACE));
+ } while (c0!=EOF && !isIn(c0,ZPACE));
endToken();
for (; cmds->cmdString; ++cmds)
return 0;
startToken();
- while (c0!=EOF && !isIn(c0,SPACE)) {
+ while (c0!=EOF && !isIn(c0,ZPACE)) {
if (c0=='"') {
skip();
while (c0!=EOF && c0!='\"') {
static Void local goOffside(col) /* insert offside marker */
Int col; { /* for specified column */
-assert(offsideON);
+ assert(offsideON);
if (indentDepth>=MAXINDENT) {
ERRMSG(row) "Too many levels of program nesting"
EEND;
}
static Void local unOffside() { /* leave layout rule area */
-assert(offsideON);
+ assert(offsideON);
indentDepth--;
}
static Bool local canUnOffside() { /* Decide if unoffside permitted */
-assert(offsideON);
+ assert(offsideON);
return indentDepth>=0 && layout[indentDepth]!=HARD;
}
return; /* report allows ... */
else if (c0=='\n')
newlineSkip();
- else if (isIn(c0,SPACE))
+ else if (isIn(c0,ZPACE))
skip();
else if (c0=='{' && c1=='-') { /* (potentially) nested comment */
Int nesting = 1;
* Now try to identify token type:
* --------------------------------------------------------------------*/
+ if (readingInterface) {
+ if (c0 == '(' && c1 == '#') { skip(); skip(); return UTL; };
+ if (c0 == '#' && c1 == ')') { skip(); skip(); return UTR; };
+ }
+
switch (c0) {
case EOF : return 0; /* End of file/input */
return STRINGLIT;
}
+#if IPARAM
+ if (c0=='?' && isIn(c1,SMALL) && !haskell98) {
+ Text it; /* Look for implicit param name */
+ skip();
+ it = readIdent();
+ top() = yylval = ap(IPVAR,it);
+ return identType=IPVARID;
+ }
+#endif
#if TREX
if (c0=='#' && isIn(c1,SMALL) && !haskell98) {
Text it; /* Look for record selector name */
if (it==textImport) return IMPORT;
if (it==textExport) return EXPORT;
if (it==textDynamic) return DYNAMIC;
+ if (it==textCcall) return CCALL;
+ if (it==textStdcall) return STDKALL;
if (it==textUUExport) return UUEXPORT;
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);
+#endif
if (it==textUUAll) return ALL;
+ if (it==textUUUsage) return UUUSAGE;
if (it==textRepeat && reading==KEYBOARD)
return repeatLast();
* main entry points to parser/lexer:
* ------------------------------------------------------------------------*/
-static Void local parseInput(startWith)/* Parse input with given first tok,*/
+static Cell local parseInput(startWith)/* Parse input with given first tok,*/
Int startWith; { /* determining whether to read a */
- firstToken = TRUE; /* script or an expression */
+ Cell final = NIL; /* script or an expression */
+ firstToken = TRUE;
firstTokenIs = startWith;
- if (startWith==INTERFACE)
- offsideON = FALSE; else
- offsideON = TRUE;
+ if (startWith==INTERFACE) {
+ offsideON = FALSE; readingInterface = TRUE;
+ } else {
+ offsideON = TRUE; readingInterface = FALSE;
+ }
clearStack();
if (yyparse()) { /* This can only be parser overflow */
ERRMSG(row) "Parser overflow" /* as all syntax errors are caught */
EEND; /* in the parser... */
}
- drop();
+ final = pop();
if (!stackEmpty()) /* stack should now be empty */
internal("parseInput");
+ return final;
}
#ifdef HSCRIPT
setLastExpr(inputExpr);
}
-Void parseInterface(nm,len) /* Read a GHC interface file */
+
+#if EXPLAIN_INSTANCE_RESOLUTION
+Void parseContext() { /* Read a context to prove */
+ parseInput(CONTEXT);
+}
+#endif
+
+Cell parseInterface(nm,len) /* Read a GHC interface file */
String nm;
Long len; { /* Used to set a target for reading */
- input(RESET);
- fileInput(nm,len);
- parseInput(INTERFACE);
+ input(RESET);
+ fileInput(nm,len);
+ return parseInput(INTERFACE);
}
Void input(what)
Int what; {
switch (what) {
- case INSTALL : initCharTab();
+ case POSTPREL: break;
+
+ case PREPREL : initCharTab();
textCase = findText("case");
textOfK = findText("of");
textData = findText("data");
textDeriving = findText("deriving");
textDo = findText("do");
textClass = findText("class");
+#if IPARAM
+ textWith = findText("with");
+ textDlet = findText("dlet");
+#endif
textInstance = findText("instance");
textCoco = findText("::");
textEq = findText("=");
textInstImport = findText("__instimport");
textExport = findText("export");
textDynamic = findText("dynamic");
+ textCcall = findText("ccall");
+ textStdcall = findText("stdcall");
textUUExport = findText("__export");
textImport = findText("import");
textHiding = findText("hiding");
textQualified = findText("qualified");
textAsMod = findText("as");
+ textPrivileged = findText("privileged");
textWildcard = findText("_");
textAll = findText("forall");
textUUAll = findText("__forall");
+ textUUUsage = findText("__u");
varMinus = mkVar(textMinus);
varPlus = mkVar(textPlus);
varBang = mkVar(textBang);
varHiding = mkVar(textHiding);
varQualified = mkVar(textQualified);
varAsMod = mkVar(textAsMod);
+ varPrivileged = mkVar(textPrivileged);
conMain = mkCon(findText("Main"));
varMain = mkVar(findText("main"));
evalDefaults = NIL;
instDefns = NIL;
selDefns = NIL;
genDefns = NIL;
- //primDefns = NIL;
unqualImports= NIL;
foreignImports= NIL;
foreignExports= NIL;
mark(instDefns);
mark(selDefns);
mark(genDefns);
- //mark(primDefns);
mark(unqualImports);
mark(foreignImports);
mark(foreignExports);
mark(varHiding);
mark(varQualified);
mark(varAsMod);
+ mark(varPrivileged);
mark(varMain);
mark(conMain);
mark(imps);
projects / ghc-hetmet.git / blobdiff