X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Finput.c;h=63ebe075efcdc2aa874e3e8a8d57310e33233328;hb=9aa6d18bd696e8861fb8c3e065e49a989d2d67ac;hp=3d8c30c8a17847616fd105c8cacee74ddd4b8ba1;hpb=8931116063aaf06ed2759e2b2ca2e554cfa7124f;p=ghc-hetmet.git diff --git a/ghc/interpreter/input.c b/ghc/interpreter/input.c index 3d8c30c..63ebe07 100644 --- a/ghc/interpreter/input.c +++ b/ghc/interpreter/input.c @@ -1,53 +1,71 @@ - /* -------------------------------------------------------------------------- * Input functions, lexical analysis parsing etc... * - * 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: input.c,v $ - * $Revision: 1.4 $ - * $Date: 1999/03/01 14:46:46 $ + * $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 #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 */ +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 */ @@ -59,48 +77,52 @@ 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 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 Void local goOffside Args((Int)); -static Void local unOffside Args((Void)); -static Bool local canUnOffside Args((Void)); - -static Void local skipWhitespace Args((Void)); -static Int local yylex Args((Void)); -static Int local repeatLast Args((Void)); - -static Void local parseInput Args((Int)); +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 ( 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 ( Int ); +static Void local unOffside ( Void ); +static Bool local canUnOffside ( Void ); + +static Void local skipWhitespace ( Void ); +static Int local yylex ( Void ); +static Int local repeatLast ( Void ); + +static Cell local parseInput ( Int ); + +static Bool local doesNotExceed ( String,Int,Int ); +static Int local stringToInt ( String,Int ); + /* -------------------------------------------------------------------------- * Text values for reserved words and special symbols: @@ -110,17 +132,26 @@ 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; static Text textBang, textDot, textAll, textImplies; static Text textWildcard; -static Text textModule, textImport; -static Text textHiding, textQualified, textAsMod; -static Text textExport, textUnsafe; +static Text textModule, textImport, textInterface, textInstImport; +static Text textHiding, textQualified, textAsMod, textPrivileged; +static Text textExport, textDynamic, textUUExport; +static Text textUnsafe, textUUAll, textUUUsage; + +Text textCcall; /* ccall */ +Text textStdcall; /* stdcall */ Text textNum; /* Num */ +Text textPrelPrim; /* PrelPrim */ Text textPrelude; /* Prelude */ Text textPlus; /* (+) */ @@ -168,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 */ @@ -200,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 */ @@ -221,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. * ------------------------------------------------------------------------*/ @@ -245,9 +276,8 @@ static String nextStringChar; /* next char in string buffer */ #if USE_READLINE /* for command line editors */ 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)); +#define nextConsoleChar() \ + (unsigned char)(*nextChar=='\0' ? '\n' : *nextChar++) #else #define nextConsoleChar() getc(stdin) #endif @@ -394,6 +424,35 @@ String nm; { } +Void hi_o_namesFromSrcName ( String srcName, String* hiName, String* oName ) +{ + Int len; + String dot; + len = 1 + strlen ( srcName ); + *hiName = malloc(len); + *oName = malloc(len); + if (!(*hiName && *oName)) internal("hi_o_namesFromSource"); + (*hiName)[0] = (*oName)[0] = 0; + dot = strrchr(srcName, '.'); + if (!dot) return; + if (filenamecmp(dot+1, "hs")==0 && + filenamecmp(dot+1, "lhs")==0 && + filenamecmp(dot+1, "verb")==0) return; + + strcpy(*hiName, srcName); + dot = strrchr(*hiName, '.'); + dot[1] = 'h'; + dot[2] = 'i'; + dot[3] = 0; + + strcpy(*oName, srcName); + dot = strrchr(*oName, '.'); + dot[1] = 'o'; + dot[2] = 0; +} + + + /* This code originally came from Sigbjorn Finne (sof@dcs.gla.ac.uk). * I've removed the loop (since newLineSkip contains a loop too) and * replaced the warnings with errors. ADR @@ -419,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'); @@ -445,7 +504,8 @@ static Int local nextLine() if (lineLength <= 0) { /* EOF / IO error, who knows.. */ return lineLength; } - else if (lineLength >= 2 && lineBuffer[0] == '#' && lineBuffer[1] == '!') { + else if (lineLength >= 2 && lineBuffer[0] == '#' && + lineBuffer[1] == '!') { lineBuffer[0]='\n'; /* pretend it's a blank line */ lineBuffer[1]='\0'; lineLength=1; @@ -502,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 = ' '; } } @@ -568,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); @@ -664,50 +727,69 @@ 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); +} + + +static Bool local doesNotExceed(s,radix,limit) +String s; +Int radix; +Int limit; { + Int n = 0; + Int p = 0; + while (TRUE) { + if (s[p] == 0) return TRUE; + if (overflows(n,radix,s[p]-'0',limit)) return FALSE; + n = radix*n + (s[p]-'0'); + p++; + } +} + +static Int local stringToInt(s,radix) +String s; +Int radix; { + Int n = 0; + Int p = 0; + while (TRUE) { + if (s[p] == 0) return n; + n = radix*n + (s[p]-'0'); + p++; + } } static Cell local readRadixNumber(r) /* Read literal in specified radix */ Int r; { /* from input of the form 0c{digs} */ Int d; + startToken(); skip(); /* skip leading zero */ - if ((d=readHexDigit(c1))<0 || d>=r)/* Special case; no digits, lex as */ - return mkInt(0); /* if it had been written "0 c..." */ - else { - Int n = 0; -#if BIGNUMS - Cell big = NIL; -#endif + if ((d=readHexDigit(c1))<0 || d>=r) { + /* Special case; no digits, lex as */ + /* if it had been written "0 c..." */ + saveTokenChar('0'); + } else { skip(); do { -#if BIGNUMS - if (nonNull(big)) - big = bigShift(big,d,r); - else if (overflows(n,r,d,MAXPOSINT)) - big = bigShift(bigInt(n),d,r); - else -#else - if (overflows(n,r,d,MAXPOSINT)) { - ERRMSG(row) "Integer literal out of range" - EEND; - } - else -#endif - n = r*n + d; + saveTokenChar('0'+readHexDigit(c0)); skip(); d = readHexDigit(c0); } while (d>=0 && dcmdString; ++cmds) @@ -1135,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); @@ -1183,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; @@ -1204,10 +1285,12 @@ Int col; { /* for specified column */ } static Void local unOffside() { /* leave layout rule area */ + assert(offsideON); indentDepth--; } static Bool local canUnOffside() { /* Decide if unoffside permitted */ + assert(offsideON); return indentDepth>=0 && layout[indentDepth]!=HARD; } @@ -1221,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; @@ -1279,7 +1362,7 @@ static Int local yylex() { /* Read next input token ... */ return firstTokenIs; } - if (insertOpen) { /* insert `soft' opening brace */ + if (offsideON && insertOpen) { /* insert `soft' opening brace */ insertOpen = FALSE; insertedToken = TRUE; goOffside(column); @@ -1300,7 +1383,7 @@ static Int local yylex() { /* Read next input token ... */ if (insertedToken) /* avoid inserting multiple `;'s */ insertedToken = FALSE; /* or putting `;' after `{' */ else - if (layout[indentDepth]!=HARD) { + if (offsideON && layout[indentDepth]!=HARD) { if (column"); + textPrelPrim = findText("PrelPrim"); textPrelude = findText("Prelude"); textNum = findText("Num"); textModule = findText("module"); + textInterface = findText("__interface"); + 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"); textWildcard = findText("_"); textAll = findText("forall"); + textUUAll = findText("__forall"); + textUUUsage = findText("__u"); varMinus = mkVar(textMinus); varPlus = mkVar(textPlus); varBang = mkVar(textBang); @@ -1624,7 +1740,6 @@ Int what; { instDefns = NIL; selDefns = NIL; genDefns = NIL; - //primDefns = NIL; unqualImports= NIL; foreignImports= NIL; foreignExports= NIL; @@ -1646,7 +1761,6 @@ Int what; { mark(instDefns); mark(selDefns); mark(genDefns); - //mark(primDefns); mark(unqualImports); mark(foreignImports); mark(foreignExports);