X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Finput.c;h=63ebe075efcdc2aa874e3e8a8d57310e33233328;hb=6c9a37e31afc41d57417a3828877577d8d270266;hp=5bc6da51168b7584a0040faa201ccd869a836e19;hpb=ecd09ad02c4ef8e28eebef72cf6f99ab47059a5e;p=ghc-hetmet.git diff --git a/ghc/interpreter/input.c b/ghc/interpreter/input.c index 5bc6da5..63ebe07 100644 --- a/ghc/interpreter/input.c +++ b/ghc/interpreter/input.c @@ -1,4 +1,3 @@ - /* -------------------------------------------------------------------------- * Input functions, lexical analysis parsing etc... * @@ -9,48 +8,64 @@ * included in the distribution. * * $RCSfile: input.c,v $ - * $Revision: 1.8 $ - * $Date: 1999/10/15 21:40:50 $ + * $Revision: 1.30 $ + * $Date: 2000/04/25 17:43:49 $ * ------------------------------------------------------------------------*/ -#include "prelude.h" +#include "hugsbasictypes.h" #include "storage.h" -#include "backend.h" #include "connect.h" -#include "command.h" #include "errors.h" -#include "link.h" + #include #if HAVE_GETDELIM_H #include "getdelim.h" #endif -#if HUGS_FOR_WINDOWS +#if IS_WIN32 +#include +#endif + +#if IS_WIN32 #undef IN #endif +#if HAVE_READLINE_LIBS && HAVE_READLINE_HEADERS +#define USE_READLINE 1 +#else +#define USE_READLINE 0 +#endif + +#if USE_READLINE +#include +#include +#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 */ @@ -62,51 +77,51 @@ String preprocessor = 0; * Local function prototypes: * ------------------------------------------------------------------------*/ -static Void local initCharTab Args((Void)); -static Void local fileInput Args((String,Long)); -static Bool local literateMode Args((String)); -static Bool local linecmp Args((String,String)); -static Int local nextLine Args((Void)); -static Void local skip Args((Void)); -static Void local thisLineIs Args((Int)); -static Void local newlineSkip Args((Void)); -static Void local closeAnyInput Args((Void)); - - Int yyparse Args((Void)); /* can't stop yacc making this */ +static Void local initCharTab ( Void ); +static Void local fileInput ( String,Long ); +static Bool local literateMode ( String ); +static Bool local linecmp ( String,String ); +static Int local nextLine ( Void ); +static Void local skip ( Void ); +static Void local thisLineIs ( Int ); +static Void local newlineSkip ( Void ); +static Void local closeAnyInput ( Void ); + + Int yyparse ( Void ); /* can't stop yacc making this */ /* public, but don't advertise */ /* it in a header file. */ -static Void local endToken Args((Void)); -static Text local readOperator Args((Void)); -static Text local readIdent Args((Void)); -static Cell local readRadixNumber Args((Int)); -static Cell local readNumber Args((Void)); -static Cell local readChar Args((Void)); -static Cell local readString Args((Void)); -static Void local saveStrChr Args((Char)); -static Cell local readAChar Args((Bool)); +static Void local endToken ( Void ); +static Text local readOperator ( Void ); +static Text local readIdent ( Void ); +static Cell local readRadixNumber ( Int ); +static Cell local readNumber ( Void ); +static Cell local readChar ( Void ); +static Cell local readString ( Void ); +static Void local saveStrChr ( Char ); +static Cell local readAChar ( Bool ); -static Bool local lazyReadMatches Args((String)); -static Cell local readEscapeChar Args((Bool)); -static Void local skipGap Args((Void)); -static Cell local readCtrlChar Args((Void)); -static Cell local readOctChar Args((Void)); -static Cell local readHexChar Args((Void)); -static Int local readHexDigit Args((Char)); -static Cell local readDecChar Args((Void)); +static Bool local lazyReadMatches ( String ); +static Cell local readEscapeChar ( Bool ); +static Void local skipGap ( Void ); +static Cell local readCtrlChar ( Void ); +static Cell local readOctChar ( Void ); +static Cell local readHexChar ( Void ); +static Int local readHexDigit ( Char ); +static Cell local readDecChar ( Void ); -static Void local goOffside Args((Int)); -static Void local unOffside Args((Void)); -static Bool local canUnOffside Args((Void)); +static Void local goOffside ( Int ); +static Void local unOffside ( Void ); +static Bool local canUnOffside ( Void ); -static Void local skipWhitespace Args((Void)); -static Int local yylex Args((Void)); -static Int local repeatLast Args((Void)); +static Void local skipWhitespace ( Void ); +static Int local yylex ( Void ); +static Int local repeatLast ( Void ); -static Void local parseInput Args((Int)); +static Cell local parseInput ( Int ); -static Bool local doesNotExceed Args((String,Int,Int)); -static Int local stringToInt Args((String,Int)); +static Bool local doesNotExceed ( String,Int,Int ); +static Int local stringToInt ( String,Int ); /* -------------------------------------------------------------------------- @@ -117,6 +132,10 @@ static Text textCase, textOfK, textData, textType, textIf; 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 static Text textCoco, textEq, textUpto, textAs, textLambda; static Text textBar, textMinus, textFrom, textArrow, textLazy; @@ -124,11 +143,15 @@ static Text textBang, textDot, textAll, textImplies; 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 textPrelPrim; /* PrelPrim */ Text textPrelude; /* Prelude */ Text textPlus; /* (+) */ @@ -176,7 +199,7 @@ static unsigned char ctable[NUM_CHARS]; #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 */ @@ -208,9 +231,9 @@ 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 */ @@ -229,7 +252,7 @@ static Void local initCharTab() { /* Initialize char decode table */ * * 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. * ------------------------------------------------------------------------*/ @@ -255,8 +278,6 @@ static String currentLine; /* editline or GNU readline */ 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 @@ -457,7 +478,7 @@ String line; { 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'); @@ -541,16 +562,19 @@ static Void local skip() { /* move forward one char in input */ closeAnyInput(); } else if (reading==KEYBOARD) { - allowBreak(); + /* allowBreak(); */ if (c0=='\n') 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 + 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 = ' '; } } @@ -607,7 +631,7 @@ static Void local newlineSkip() { /* skip `\n' (supports lit scripts) */ 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); @@ -703,7 +727,9 @@ static Text local readIdent() { /* read identifier */ } 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); } @@ -961,7 +987,7 @@ Bool isStrLit; { ERRMSG(row) "Illegal escape sequence" EEND; } - else if (isIn(c0,SPACE)) { + else if (isIn(c0,ZPACE)) { if (isStrLit) { skipGap(); return NIL; @@ -992,7 +1018,7 @@ static Void local skipGap() { /* skip over gap in string literal */ 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; @@ -1122,7 +1148,7 @@ String s; { /* escapes if any parts need them */ 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) { @@ -1166,7 +1192,7 @@ Char sys; { /* character for shell escape */ do { /* which is empty */ saveTokenChar(c0); skip(); - } while (c0!=EOF && !isIn(c0,SPACE)); + } while (c0!=EOF && !isIn(c0,ZPACE)); endToken(); for (; cmds->cmdString; ++cmds) @@ -1189,8 +1215,8 @@ String readFilename() { /* Read filename from input (if any)*/ return 0; startToken(); - while (c0!=EOF && !isIn(c0,SPACE)) { - if (c0=='"') { + while (c0!=EOF && !isIn(c0,ZPACE)) { + if (c0=='"') { skip(); while (c0!=EOF && c0!='\"') { Cell c = readAChar(TRUE); @@ -1237,7 +1263,7 @@ String readLine() { /* Read command line from input */ * - 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=MAXINDENT) { ERRMSG(row) "Too many levels of program nesting" EEND; @@ -1259,12 +1285,12 @@ assert(offsideON); } 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; } @@ -1278,7 +1304,7 @@ static Void local skipWhitespace() { /* Skip over whitespace/comments */ 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; @@ -1373,6 +1399,11 @@ static Int local yylex() { /* Read next input token ... */ * 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 */ @@ -1405,6 +1436,15 @@ static Int local yylex() { /* Read next input token ... */ 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 */ @@ -1473,13 +1513,21 @@ static Int local yylex() { /* Read next input token ... */ 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==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; if (it==textRepeat && reading==KEYBOARD) return repeatLast(); @@ -1547,83 +1595,58 @@ Name n; { * 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(); - if (!stackEmpty()) /* stack should now be empty */ - internal("parseInput"); -} -#ifdef HSCRIPT -static String memPrefix = "@mem@"; -static Int lenMemPrefix = 5; /* strlen(memPrefix)*/ + if (startWith==SCRIPT) pop(); /* zap spurious closing } token */ + final = pop(); -Void makeMemScript(mem,fname) -String mem; -String fname; { - strcat(fname,memPrefix); - itoa((int)mem, fname+strlen(fname), 10); + if (!stackEmpty()) /* stack should now be empty */ + internal("parseInput"); + return final; } -Bool isMemScript(fname) -String fname; { - return (strstr(fname,memPrefix) != NULL); +Void parseExp() { /* Read an expression to evaluate */ + parseInput(EXPR); + setLastExpr(inputExpr); } -String memScriptString(fname) -String fname; { - String p = strstr(fname,memPrefix); - if (p) { - return (String)atoi(p+lenMemPrefix); - } else { - return NULL; - } +#if EXPLAIN_INSTANCE_RESOLUTION +Void parseContext() { /* Read a context to prove */ + parseInput(CONTEXT); } +#endif -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 */ +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(SCRIPT); -} -#endif - -Void parseExp() { /* Read an expression to evaluate */ - parseInput(EXPR); - setLastExpr(inputExpr); + input(RESET); + Printf("Reading interface \"%s\"\n", nm ); + fileInput(nm,len); + return parseInput(INTERFACE); } -Void parseInterface(nm,len) /* Read a GHC interface file */ +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); - parseInput(INTERFACE); + return parseInput(SCRIPT); } @@ -1634,7 +1657,9 @@ Long len; { /* Used to set a target for reading */ 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"); @@ -1654,7 +1679,12 @@ Int what; { textDefault = findText("default"); textDeriving = findText("deriving"); textDo = findText("do"); + textMdo = findText("mdo"); textClass = findText("class"); +#if IPARAM + textWith = findText("with"); + textDlet = findText("dlet"); +#endif textInstance = findText("instance"); textCoco = findText("::"); textEq = findText("="); @@ -1670,6 +1700,7 @@ Int what; { textBang = findText("!"); textDot = findText("."); textImplies = findText("=>"); + textPrelPrim = findText("PrelPrim"); textPrelude = findText("Prelude"); textNum = findText("Num"); textModule = findText("module"); @@ -1677,6 +1708,8 @@ Int what; { textInstImport = findText("__instimport"); textExport = findText("export"); textDynamic = findText("dynamic"); + textCcall = findText("ccall"); + textStdcall = findText("stdcall"); textUUExport = findText("__export"); textImport = findText("import"); textHiding = findText("hiding"); @@ -1685,6 +1718,7 @@ Int what; { textWildcard = findText("_"); textAll = findText("forall"); textUUAll = findText("__forall"); + textUUUsage = findText("__u"); varMinus = mkVar(textMinus); varPlus = mkVar(textPlus); varBang = mkVar(textBang); @@ -1706,7 +1740,6 @@ Int what; { instDefns = NIL; selDefns = NIL; genDefns = NIL; - //primDefns = NIL; unqualImports= NIL; foreignImports= NIL; foreignExports= NIL; @@ -1728,7 +1761,6 @@ Int what; { mark(instDefns); mark(selDefns); mark(genDefns); - //mark(primDefns); mark(unqualImports); mark(foreignImports); mark(foreignExports);