/* -------------------------------------------------------------------------- * Input functions, lexical analysis parsing etc... * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, 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.91 $ * $Date: 2006/09/09 09:37:48 $ * ------------------------------------------------------------------------*/ #include "prelude.h"#include "storage.h"#include "connect.h"#include "command.h"#include "errors.h"#include "module.h"#include "script.h"#include "opts.h"#include "goal.h"#include "machdep.h"#include "char.h"#include <ctype.h> #if HAVE_WINDOWS_H#include <windows.h>#undef IN#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 primDefns       = NIL;             /* primitive definitions           */List unqualImports   = NIL;             /* unqualified import list         */Int  foreignCount    = 0;               /* count of foreigns in this module*/List foreignImports  = NIL;             /* foreign import declarations     */List foreignExports  = NIL;             /* foreign export declarations     */List foreignLabels   = NIL;             /* foreign label  declarations     */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  */ String repeatStr     = 0;               /* Repeat last expr                */ #if SUPPORT_PREPROCESSORString preprocessor  = 0;#endif /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ static Bool local fileInput       Args((String,Long));static Bool local literateMode    Args((String));static Bool local linecmp         Args((String,ShortChar *));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   */					  /* 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,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)); /* -------------------------------------------------------------------------- * Text values for reserved words and special symbols: * ------------------------------------------------------------------------*/ static Text textCase,    textOfK,      textData,   textType,   textIf;static Text textThen,    textElse,     textWhere,  textLet,    textIn;static Text textInfix,   textInfixl,   textInfixr, textPrim,   textNewtype;static Text textDefault, textDeriving, textDo,     textClass,  textInstance;#if IPARAMstatic Text textWith,  textDlet;#endif #if MUDOstatic Text textMDo;#endif static Text textCoco,    textEq,       textUpto,   textAs,     textLambda;static Text textBar,     textMinus,    textFrom,   textArrow,  textLazy;static Text textBang,    textDot,      textAll,	   textImplies; static Text textModule,  textImport;static Text textHiding,  textQualified, textAsMod;static Text textWildcard;static Text textNeedPrims;static Text textForeign; Text   textCCall;                       /* ccall                           */Text   textSafe;                        /* safe                            */Text   textUnsafe;                      /* unsafe                          */Text   textThreadsafe;                  /* threadsafe                      */Text   textExport;                      /* export                          */ /* Platform-specific calling conventions */#if STDCALL_SUPPORTEDText   textStdcall;                     /* stdcall                         */#endif#ifdef DOTNETText   textDotnet;                      /* dotnet                          */#endif Text   textNum;                         /* Num                             */Text   textPrelude;                     /* Prelude / Hugs.Prelude          */Text   textUserPrelude;                 /* Prelude                         */Text   textPlus;			/* (+)				   */ static Cell conMain;                    /* Main                            */static Cell varMain;                    /* main                            */ static Cell varMinus;                   /* (-)                             */static Cell varPlus;			/* (+)				   */static Cell varBang;                    /* (!)                             */static Cell varDot;			/* (.)				   */static Cell varHiding;                  /* hiding                          */static Cell varQualified;               /* qualified                       */static Cell varAsMod;                   /* as                              */ static List imps;                       /* List of imports to be chased    */ #if HERE_DOCBool hereDocs = FALSE;enum { START = 0,       KEEP_GOING,       BEGIN_VAR,       ISSUE_QUOTE,       HERE_VAR,       END_VAR,       CLOSE_PAREN };static Int hereState = START;#endif #if MULTI_LINEFEED#define FOPEN_MODE                "rb"#else#define FOPEN_MODE                "r"#endif /* -------------------------------------------------------------------------- * Single character input routines: * * 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). * The input stream is advanced by one character using the skip() function. * ------------------------------------------------------------------------*/ #define TABSIZE    8                   /* spacing between tabstops         */ #define NOTHING    0                   /* what kind of input is being read?*/#define KEYBOARD   1                   /* - keyboard/console?              */#define SCRIPTFILE 2                   /* - script file                    */#define STRING     3                   /* - string buffer?                 */#define NOKEYBOARD 4                   /* - standard input, but not a tty  */  static Int    reading   = NOTHING; static Target readSoFar;static Int    row, column, startColumn;static int    c0, c1;static FILE   *inputStream = 0;static Bool   thisLiterate;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() (*nextChar=='\0' ? '\n' : ExtractChar(nextChar))extern  Void add_history  Args((String));extern  String readline   Args((String));#else#define nextConsoleChar() FGetChar(stdin)#endif static  Int litLines;                  /* count defn lines in lit script   */#define DEFNCHAR  '>'                  /* definition lines begin with this */static  Int lastLine;                  /* records type of last line read:  */#define STARTLINE 0                    /* - at start of file, none read    */#define BLANKLINE 1                    /* - blank (may preceed definition) */#define TEXTLINE  2                    /* - text comment                   */#define DEFNLINE  3                    /* - line containing definition     */#define CODELINE  4                    /* - line inside code block         */ #define BEGINCODE "\\begin{code}"#define ENDCODE   "\\end{code}" Bool startsQual(c)Char c; {    return isIn(c,LARGE);} #define LINEBUFFER_SIZE 1000static ShortChar lineBuffer[LINEBUFFER_SIZE];static int lineLength = 0;static int inCodeBlock = FALSE; /* Inside \begin{code}..\end{code} */static int linePtr = 0; Void consoleInput(prompt)              /* prepare to input characters from */String prompt; {                       /* standard in (i.e. console/kbd)   */    reading     = KEYBOARD;            /* keyboard input is Line oriented, */    c0          =                      /* i.e. input terminated by '\n'    */    c1          = ' ';    column      = (-1);    row         = 0;#if HERE_DOC    hereState   = START;#endif #if HAVE_ISATTY && USE_READLINE    if (!isatty(fileno(stdin))) { /* not reading from a tty: */	reading = NOKEYBOARD;     /* don't try readline      */	Printf("%s",prompt);FlushStdout();	return;    }#endif#if USE_READLINE    /* Paranoid freeing code supplied by Sverker Nilsson (sverker@opq.se)      * avoids accidentally freeing currentLine twice.      */    if (currentLine) {	String oldCurrentLine = currentLine;	currentLine = 0;           /* We may lose the space of currentLine */	free(oldCurrentLine);      /* if interrupted here - unlikely       */    }    currentLine = readline(prompt);    nextChar    = currentLine;    if (currentLine) {	if (*currentLine)	    add_history(currentLine);    }    else	c0 = c1 = EOF;#else#if HUGS_FOR_WINDOWS    {    INT svColor = SetForeColor(GREEN);#endif    Printf("%s",prompt);    FlushStdout();#if HUGS_FOR_WINDOWS    SetForeColor(svColor);    }#endif#endif} #if HUGS_FOR_WINDOWS/* These variables and functions are used to save the current *//* state of the input, to implement auto load of files        */static Int    	saveReading;static int    	savec0, savec1; Void saveInputState(Void){    saveReading = reading;    savec0 = c0;    savec1 = c1;} Void restoreInputState(Void){    reading = saveReading;    c0 = savec0;    c1 = savec1;}#endif static Bool local fileInput(nm,len)     /* prepare to input characters from*/String nm;                              /* named file (specified length is */Long   len; {                           /* used to set target for reading) */#if SUPPORT_PREPROCESSOR    if (!readable(nm,FALSE)) { /* file not there */	inputStream = NULL;    } else if (preprocessor) {	Int reallen = strlen(preprocessor) + 1 + strlen(nm) + 1;	char *cmd = malloc(reallen+1);	if (cmd == NULL) {	    ERRMSG(0) "Unable to allocate memory for filter command."	    EEND_NORET;	    return FALSE;	}	if (snprintf(cmd,reallen, "%s %s", preprocessor, nm) < 0) {	    ERRMSG(0) "Unable to allocate memory for filter command."	    EEND_NORET;	    return FALSE;	} else {	    cmd[reallen] = '\0';	}	inputStream = popen(cmd,"r");	free(cmd);    } else {	inputStream = fopen(nm,FOPEN_MODE);    }#else    if (nm[0] == '\0')	inputStream = NULL;    else	inputStream = fopen(nm,FOPEN_MODE);#endif    if (inputStream) {	reading      = SCRIPTFILE;	c0           = ' ';	c1           = '\n';	column       = 1;	row          = 0; 	lastLine     = STARTLINE;       /* literate file processing */	litLines     = 0;	linePtr      = 0;	lineLength   = 0;	thisLiterate = literateMode(nm);	inCodeBlock  = FALSE; 	readSoFar    = 0;	setGoal("Parsing", (Target)len);    }    else {	ERRMSG(0) "Unable to open file \"%s\"", nm	EEND_NORET;	return FALSE;    }    return TRUE;} Void stringInput(s)             /* prepare to input characters from string */String s; {                    reading      = STRING;                c0           = EOF;    c1           = EOF;    if (*s) c0 = *s++;    if (*s) c1 = *s++;    column       = 1;    row          = 1;     nextStringChar = s;    if (!charTabBuilt)	initCharTab();} static Bool local literateMode(nm)      /* Select literate mode for file   */String nm; {    char *dot = strrchr(nm,'.');        /* look for last dot in file name  */    if (dot) {	if (filenamecmp(dot+1,"hs")==0) /* .hs files are never literate    */	    return FALSE;	if (filenamecmp(dot+1,"lhs") ==0 || /* .lhs, .verb files are always*/	    filenamecmp(dot+1,"verb")==0) /* literate scripts              */	    return TRUE;    }    return literateScripts;             /* otherwise, use the default      */}  /* 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 *//* * To deal with literate \begin{code}...\end{code} blocks, * add a line buffer that rooms the current line. The old c0 and c1   * stream pointers are used as before within that buffer -- sof * * Upon reading a new line into the line buffer, we check to see if * we're reading in a line containing \begin{code} or \end{code} and * take appropriate action.  */ static Bool local linecmp(s,line)       /* compare string with line        */String s;                               /* line may end in whitespace      */ShortChar *line; {    Int i=0;    while (s[i] != '\0' && s[i] == line[i]) {	++i;    }    /* s[0..i-1] == line[0..i-1] */    if (s[i] != '\0') {                 /* check s `isPrefixOf` line       */	return FALSE;    }    while (isIn(line[i], SPACE)) {      /* allow whitespace at end of line */	++i;    }    return (line[i] == '\0');} /* Returns line length (including \n) or 0 upon EOF. */static Int local nextLine(){    int ch;     for (lineLength = 0; lineLength < LINEBUFFER_SIZE-1; lineLength++) {        lineBuffer[lineLength] = (ch = FGetChar(inputStream));        if (ch == EOF)            break;#if MULTI_LINEFEED        if ((char)ch == '\r') {            ch = fgetc(inputStream);	    /* ToDo: verify that this behaves correctly re EOF */            if ((char)ch != '\n')                 ungetc(ch, inputStream);            lineBuffer[lineLength] = '\n';            lineLength++;            break;        } else #endif        if ((char)ch == '\n') {            lineLength++;            break;        }    }    lineBuffer[lineLength] = '\0';     if (lineLength <= 0) { /* EOF / IO error, who knows.. */	return lineLength;    }    else if (lineLength >= 2 && lineBuffer[0] == '#' && lineBuffer[1] == '!') {	lineBuffer[0]='\n'; /* pretend it's a blank line */	lineBuffer[1]='\0';	lineLength=1;    } else if (thisLiterate) {	if (linecmp(BEGINCODE, lineBuffer)) {	    if (!inCodeBlock) {             /* Entered a code block        */		inCodeBlock = TRUE;		lineBuffer[0]='\n'; /* pretend it's a blank line */		lineBuffer[1]='\0';		lineLength=1;	    }	    else {		ERRMSG(row) "\\begin{code} encountered inside code block"		EEND;	    }	}	else if (linecmp(ENDCODE, lineBuffer)) {	    if (inCodeBlock) {              /* Finished code block         */		inCodeBlock = FALSE;		lineBuffer[0]='\n'; /* pretend it's a blank line */		lineBuffer[1]='\0';		lineLength=1;	    }	    else {		ERRMSG(row) "\\end{code} encountered outside code block"		EEND;	    }	}    }    return lineLength;}    static Void local skip() {              /* move forward one char in input  */    if (c0!=EOF) {                      /* stream, updating c0, c1, ...    */	if (c0=='\n') {                 /* Adjusting cursor coords as nec. */	    row++;	    column=1;	    if (reading==SCRIPTFILE)

Lines 1–500 of 2032. Load more