* in the distribution for details.
*
* $RCSfile: input.c,v $
- * $Revision: 1.4 $
- * $Date: 1999/03/01 14:46:46 $
+ * $Revision: 1.6 $
+ * $Date: 1999/06/07 17:22:32 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "connect.h"
#include "command.h"
#include "errors.h"
+#include "link.h"
#include <ctype.h>
#if HAVE_GETDELIM_H
#include "getdelim.h"
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 */
String repeatStr = 0; /* Repeat last expr */
static Void local parseInput Args((Int));
+static Bool local doesNotExceed Args((String,Int,Int));
+static Int local stringToInt Args((String,Int));
+
+
/* --------------------------------------------------------------------------
* Text values for reserved words and special symbols:
* ------------------------------------------------------------------------*/
static Text textBang, textDot, textAll, textImplies;
static Text textWildcard;
-static Text textModule, textImport;
+static Text textModule, textImport, textInterface, textInstImport;
static Text textHiding, textQualified, textAsMod;
-static Text textExport, textUnsafe;
+static Text textExport, textUnsafe, text__All;
Text textNum; /* Num */
Text textPrelude; /* Prelude */
#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++)
+#define nextConsoleChar() \
+ (unsigned char)(*nextChar=='\0' ? '\n' : *nextChar++)
extern Void add_history Args((String));
extern String readline Args((String));
#else
}
+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
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;
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 && d<r);
-#if BIGNUMS
- return nonNull(big) ? big : mkInt(n);
-#else
- return mkInt(n);
-#endif
+ }
+ endToken();
+
+ if (doesNotExceed(tokenStr,r,MAXPOSINT))
+ return mkInt(stringToInt(tokenStr,r));
+ else
+ if (r == 10)
+ return stringToBignum(tokenStr);
+ else {
+ ERRMSG(row) "Hexadecimal or octal constant exceeds `Int' range"
+ EEND;
}
}
static Cell local readNumber() { /* read numeric constant */
- Int n = 0;
- Bool intTooLarge = FALSE;
if (c0=='0') {
if (c1=='x' || c1=='X') /* Maybe a hexadecimal literal? */
startToken();
do {
- if (overflows(n,10,(c0-'0'),MAXPOSINT))
- intTooLarge = TRUE;
- n = 10*n + (c0-'0');
saveTokenChar(c0);
skip();
} while (isISO(c0) && isIn(c0,DIGIT));
if (c0!='.' || !isISO(c1) || !isIn(c1,DIGIT)) {
endToken();
- if (!intTooLarge)
- return mkInt(n);
-#if BIGNUMS
- return bigStr(tokenStr);
-#else
- ERRMSG(row) "Integer literal out of range"
- EEND;
-#endif
+ if (doesNotExceed(tokenStr,10,MAXPOSINT))
+ return mkInt(stringToInt(tokenStr,10)); else
+ return stringToBignum(tokenStr);
}
saveTokenChar(c0); /* save decimal point */
return mkFloat(stringToFloat(tokenStr));
}
+
+
+
+
+
+
static Cell local readChar() { /* read character constant */
Cell charRead;
static Void local goOffside(col) /* insert offside marker */
Int col; { /* for specified column */
+assert(offsideON);
if (indentDepth>=MAXINDENT) {
ERRMSG(row) "Too many levels of program nesting"
EEND;
}
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;
}
return firstTokenIs;
}
- if (insertOpen) { /* insert `soft' opening brace */
+ if (offsideON && insertOpen) { /* insert `soft' opening brace */
insertOpen = FALSE;
insertedToken = TRUE;
goOffside(column);
if (insertedToken) /* avoid inserting multiple `;'s */
insertedToken = FALSE; /* or putting `;' after `{' */
else
- if (layout[indentDepth]!=HARD) {
+ if (offsideON && layout[indentDepth]!=HARD) {
if (column<layout[indentDepth]) {
unOffside();
return '}';
case '[' : skip(); return '[';
case ']' : skip(); return ']';
case '`' : skip(); return '`';
- case '{' : goOffside(HARD);
+ case '{' : if (offsideON) goOffside(HARD);
skip();
return '{';
- case '}' : if (indentDepth<0) {
+ case '}' : if (offsideON && indentDepth<0) {
ERRMSG(row) "Misplaced `}'"
EEND;
}
- if (layout[indentDepth]==HARD) /* skip over hard }*/
- skip();
- unOffside(); /* otherwise, we have to insert a }*/
+ if (!(offsideON && layout[indentDepth]!=HARD))
+ skip(); /* skip over hard }*/
+ if (offsideON)
+ unOffside(); /* otherwise, we have to insert a }*/
return '}'; /* to (try to) avoid an error... */
/* Character and string literals */
if (it==textClass) return TCLASS;
if (it==textInstance) return TINSTANCE;
if (it==textModule) return TMODULE;
+ if (it==textInterface) return INTERFACE;
+ if (it==textInstImport) return INSTIMPORT;
if (it==textImport) return IMPORT;
if (it==textExport) return EXPORT;
if (it==textHiding) return HIDING;
if (it==textAsMod) return ASMOD;
if (it==textWildcard) return '_';
if (it==textAll && !haskell98) return ALL;
+ if (it==text__All) return ALL;
if (it==textRepeat && reading==KEYBOARD)
return repeatLast();
return NUMLIT;
}
- ERRMSG(row) "Unrecognised character `\\%d' in column %d", ((int)c0), column
+ ERRMSG(row) "Unrecognised character `\\%d' in column %d",
+ ((int)c0), column
EEND;
return 0; /*NOTREACHED*/
}
Int startWith; { /* determining whether to read a */
firstToken = TRUE; /* script or an expression */
firstTokenIs = startWith;
+ if (startWith==INTERFACE)
+ offsideON = FALSE; else
+ offsideON = TRUE;
clearStack();
if (yyparse()) { /* This can only be parser overflow */
setLastExpr(inputExpr);
}
+Void 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 control:
* ------------------------------------------------------------------------*/
textPrelude = findText("Prelude");
textNum = findText("Num");
textModule = findText("module");
+ textInterface = findText("__interface");
+ textInstImport = findText("__instimport");
+ textExport = findText("__export");
textImport = findText("import");
textHiding = findText("hiding");
textQualified = findText("qualified");
textAsMod = findText("as");
textWildcard = findText("_");
textAll = findText("forall");
+ text__All = findText("__forall");
varMinus = mkVar(textMinus);
varPlus = mkVar(textPlus);
varBang = mkVar(textBang);
projects / ghc-hetmet.git / blobdiff