home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacGofer 0.22d / MacGofer Sources / input.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-11  |  40.3 KB  |  1,422 lines  |  [TEXT/MPS ]
  1. /* --------------------------------------------------------------------------
  2.  * input.c:     Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *              Gofer version 2.28 January 1993
  5.  *
  6.  *        Added check for literate scripts etc. on Mac. KH (10/1/93)
  7.  *
  8.  *        Added '\r' == '\n' for Macs, Vaxes etc.
  9.  *
  10.  *        Added some missing checks for c0 == EOF 
  11.  *        -- this could bite if the last character in the
  12.  *                 input file was not a newline!   KH (9/4/92)
  13.  *
  14.  *        Restored Unix command handling a la MS -- KH 
  15.  *
  16.  *
  17.  * Input functions, lexical analysis parsing etc...
  18.  * ------------------------------------------------------------------------*/
  19.  
  20. #include "prelude.h"
  21. #include "storage.h"
  22. #include "connect.h"
  23. #include "command.h"
  24. #include "errors.h"
  25.  
  26. #if MPW
  27. #include "mac_ctype.h"    /* The standard ctype table is replaced by a special one for the Mac */
  28. #pragma segment Input
  29.  
  30. #else
  31. #include <ctype.h>
  32. #endif
  33.  
  34.  
  35. /* --------------------------------------------------------------------------
  36.  * Global data:
  37.  * ------------------------------------------------------------------------*/
  38.  
  39. List tyconDefns         = NIL;        /* type constructor definitions       */
  40. List typeInDefns     = NIL;        /* type synonym restrictions        */
  41. List valDefns         = NIL;        /* value definitions in script       */
  42. List opDefns         = NIL;        /* operator defns in script       */
  43. List classDefns      = NIL;        /* class defns in script        */
  44. List instDefns       = NIL;        /* instance defns in script       */
  45. List overDefns         = NIL;        /* overloaded implementation names */
  46.  
  47. Cell inputExpr         = NIL;        /* input expression           */
  48. Bool literateScripts = FALSE;        /* TRUE => default to lit scripts  */
  49. Bool literateErrors  = TRUE;        /* TRUE => report errs in lit scrs */
  50.  
  51. String repeatStr     = 0;        /* Repeat last expr           */
  52.  
  53. /* --------------------------------------------------------------------------
  54.  * Local function prototypes:
  55.  * ------------------------------------------------------------------------*/
  56.  
  57. static Void local fileInput      Args((String,Long));
  58. static Bool local literateMode      Args((String));
  59. static Void local skip          Args((Void));
  60. static Void local thisLineIs      Args((Int));
  61. static Void local newlineSkip      Args((Void));
  62. static Void local closeAnyInput   Args((Void));
  63.  
  64.        Int  yyparse        Args((Void)); /* can't stop yacc making this   */
  65.                       /* public, but don't advertise   */
  66.                       /* it in a header file.       */
  67.  
  68. static Void local endToken      Args((Void));
  69. static Text local readOperator      Args((Void));
  70. static Text local readIdent      Args((Void));
  71. static Cell local readNumber      Args((Void));
  72. static Cell local readChar      Args((Void));
  73. static Cell local readString      Args((Void));
  74. static Void local saveStrChr      Args((Char));
  75. static Cell local readAChar      Args((Bool));
  76.  
  77. static Bool local lazyReadMatches Args((String));
  78. static Cell local readEscapeChar  Args((Bool));
  79. static Void local skipGap      Args((Void));
  80. static Cell local readCtrlChar      Args((Void));
  81. static Cell local readOctChar      Args((Void));
  82. static Int  local readOctDigit      Args((Void));
  83. static Cell local readHexChar      Args((Void));
  84. static Int  local readHexDigit      Args((Void));
  85. static Cell local readDecChar      Args((Void));
  86.  
  87. static Void local goOffside      Args((Int));
  88. static Void local unOffside      Args((Void));
  89. static Bool local canUnOffside      Args((Void));
  90.  
  91. static Void local skipWhitespace  Args((Void));
  92. static Int  local yylex       Args((Void));
  93. static Int  local repeatLast      Args((Void));
  94.  
  95. static Void local parseInput      Args((Int));
  96.  
  97. /* --------------------------------------------------------------------------
  98.  * Text values for reserved words and special symbols:
  99.  * ------------------------------------------------------------------------*/
  100.  
  101. static Text textCase,    textOfK,    textData,    textType,   textIf;
  102. static Text textThen,    textElse,   textWhere,    textLet,    textIn;
  103. static Text textInfix,  textInfixl, textInfixr, textPrim;
  104.  
  105. static Text textCoco,    textEq,     textUpto,    textAs,     textLambda;
  106. static Text textBar,    textMinus,  textFrom,    textArrow,  textLazy;
  107.  
  108. static Text textClass,  textImplies,textInstance;
  109.   
  110. static Text textDefault, textDeriving, textHiding, textInterface;
  111. static Text textImport,  textModule,   textTo,     textRenaming;
  112.  
  113. /* DO_COMPS */
  114. static Text textDo,    textEnd;
  115.  
  116. static Cell varMinus;            /* (-)                   */
  117. static Cell varNegate;            /* negate               */
  118. static Cell varFlip;            /* flip                   */
  119. static Cell varFrom;            /* [_..]               */
  120. static Cell varFromTo;            /* [_.._]               */
  121. static Cell varFromThen;        /* [_,_..]               */
  122. static Cell varFromThenTo;        /* [_,_.._]               */
  123.  
  124. Text   textPlus;            /* (+)                   */
  125. Text   textMult;            /* (*)                   */
  126.  
  127. /* --------------------------------------------------------------------------
  128.  * Single character input routines:
  129.  *
  130.  * At the lowest level of input, characters are read one at a time, with the
  131.  * current character held in c0 and the following (lookahead) character in
  132.  * c1.    The corrdinates of c0 within the file are held in (column,row).
  133.  * The input stream is advanced by one character using the skip() function.
  134.  * ------------------------------------------------------------------------*/
  135.  
  136. #define TABSIZE    8               /* spacing between tabstops       */
  137.  
  138. #define NOTHING    0               /* what kind of input is being read?*/
  139. #define KEYBOARD   1               /* - keyboard/console?           */
  140. #define SCRIPTFILE 2               /* - script file            */
  141. #define PROJFILE   3               /* - project file           */
  142.  
  143. static Int    reading    = NOTHING;
  144.  
  145. static Target readSoFar;
  146. static Int    row, column, startColumn;
  147. static int    c0, c1;
  148. static FILE   *inputStream;
  149. static Bool   thisLiterate;
  150.  
  151. #if     USE_READLINE            /* for command line editors       */
  152. static  String currentLine;        /* editline or GNU readline       */
  153. static  String nextChar;
  154. #define nextConsoleChar()   (*nextChar=='\0' ? '\n' : *nextChar++)
  155. extern  Void add_history    Args((String));
  156. extern  String readline        Args((String));
  157.  
  158. #define PROMPTMAX        20        /* max chars in a sensible prompt  */
  159. static  String addSpace(str)        /* add trailing space to prompt       */
  160. String str; {
  161.     static char promptBuf[PROMPTMAX+2];
  162.     if (strlen(str)>PROMPTMAX)
  163.     return str;
  164.     strcpy(promptBuf,str);
  165.     strcat(promptBuf," ");
  166.     return promptBuf;
  167. }
  168. #else
  169. #define nextConsoleChar()   getc(stdin)
  170. #endif
  171.  
  172. static    Int litLines;               /* count defn lines in lit script   */
  173. #define DEFNCHAR  '>'               /* definition lines begin with this */
  174. static    Int lastLine;               /* records type of last line read:  */
  175. #define STARTLINE 0               /* - at start of file, none read    */
  176. #define BLANKLINE 1               /* - blank (may preceed definition) */
  177. #define TEXTLINE  2               /* - text comment           */
  178. #define DEFNLINE  3               /* - line containing definition       */
  179.  
  180. Void consoleInput(prompt)        /* prepare to input characters from*/
  181. String prompt; {            /* standard in (i.e. console/kbd)  */
  182.     reading    = KEYBOARD;        /* keyboard input is Line oriented,*/
  183.     c0        =            /* i.e. input terminated by '\n'   */
  184.     c1        = ' ';
  185.     column    = (-1);
  186.     row     = 0;
  187.  
  188. #if USE_READLINE
  189.     if (currentLine)
  190.     free(currentLine);
  191.     currentLine = readline(addSpace(prompt));
  192.     nextChar    = currentLine;
  193.     if (currentLine) {
  194.     if (*currentLine)
  195.         add_history(currentLine);
  196.     }
  197.     else
  198.     c0 = c1 = EOF;
  199. #else
  200.  
  201. #if !MAC                   /* This is done automatically on the Mac. */
  202.     fputs(prompt,stdout);            /* A little more efficient than printf!  KH */
  203. #if MPW
  204.     putchar('\n');               /* It's convenient to have the prompt on a different line -- KH */
  205. #else
  206.     putchar(' ');
  207. #endif
  208.     fflush(stdout);
  209. #endif
  210. #endif
  211. }
  212.  
  213. #if MAC
  214. static int save_c0, save_c1, save_col, save_row;
  215.  
  216. Void saveConsoleState()
  217. {
  218.   save_c0  = c0;
  219.   save_c1  = c1;
  220.   save_col = column;
  221.   save_row = row;
  222.   reading = NOTHING;  /* So Gofer doesn't throw away the console input */
  223. }
  224.  
  225. Void restoreConsoleState()
  226. {
  227.   c0     = save_c0;
  228.   c1     = save_c1;
  229.   column = save_col;
  230.   row    = save_row;
  231.   reading = KEYBOARD;
  232. }
  233. #endif
  234.  
  235. Void projInput(nm)               /* prepare to input characters from */
  236. String nm; {                   /* from named project file       */
  237.     if (inputStream = fopen(nm,"r")) {
  238.     reading = PROJFILE;
  239.     c0      = ' ';
  240.         c1      = '\n';
  241.         column  = 1;
  242.         row     = 0;
  243.     }
  244.     else {
  245.     ERROR(0) "Unable to open project file \"%s\"", nm
  246.     EEND;
  247.     }
  248. }
  249.  
  250. static Void local fileInput(nm,len)    /* prepare to input characters from*/
  251. String nm;                /* named file (specified length is */
  252. Long   len; {                /* used to set target for reading) */
  253. #if MAC
  254.     extern Bool literateModule;
  255. #endif
  256.     if (inputStream = fopen(nm,"r")) {
  257.     reading      = SCRIPTFILE;
  258.     c0         = ' ';
  259.     c1         = '\n';
  260.     column         = 1;
  261.     row         = 0;
  262.     readSoFar    = 0;
  263.     lastLine     = STARTLINE;
  264.     litLines     = 0;
  265.     
  266.     /*
  267.        On the Mac, pick up *either* Unix-named literate files, or those
  268.        we know are literate.  KH
  269.     */
  270. #if MAC
  271.     thisLiterate = literateModule || literateMode(nm);
  272. #else
  273.     thisLiterate = literateMode(nm);
  274. #endif
  275.     setGoal("Parsing", (Target)len);
  276.     }
  277.     else {
  278.     ERROR(0) "Unable to open file"
  279.     EEND;
  280.     }
  281. }
  282.  
  283. static Bool local literateMode(nm)    /* selecte literate mode for file  */
  284. String nm; {
  285. #if !RISCOS
  286.     String dot = 0;
  287.  
  288.     for (; *nm; ++nm)            /* look for last dot in file name  */
  289.     if (*nm == '.')
  290.         dot = nm+1;
  291.  
  292.     if (dot) {
  293.     if (strcmp(dot,"hs")==0   ||    /* .hs, .gs, .has, .gof files are  */
  294.         strcmp(dot,"gs")==0   ||    /* never literate scripts       */
  295.         strcmp(dot,"gof")==0  ||
  296.         strcmp(dot,"has")==0  ||
  297.         strcmp(dot,"prelude")==0)    /* special suffix for prelude files*/
  298.         return FALSE;
  299.  
  300.     if (strcmp(dot,"lhs")==0  ||    /* .lhs, .lgs, .verb, .lit scripts */
  301.         strcmp(dot,"lgs")==0  ||    /* are always literate scripts       */
  302.         strcmp(dot,"verb")==0 ||
  303.         strcmp(dot,"lit")==0)
  304.         return TRUE;
  305.     }
  306. #endif
  307.     return literateScripts;        /* otherwise, use the default       */
  308. }
  309.  
  310. static Void local skip() {        /* move forward one char in input  */
  311.     if (c0!=EOF) {            /* stream, updating c0, c1, ...       */
  312.     if (c0=='\n') {            /* Adjusting cursor coords as nec. */
  313.         row++;
  314.         column=1;
  315.         if (reading==SCRIPTFILE)
  316.         soFar(readSoFar);
  317.     }
  318.     else if (c0=='\t')
  319.         column += TABSIZE - ((column-1)%TABSIZE);
  320.     else
  321.         column++;
  322.  
  323.     c0 = c1;
  324.     readSoFar++;
  325.  
  326.     if (c0==EOF) {
  327.         column = 0;
  328.         if (reading==SCRIPTFILE)
  329.         done();
  330.         closeAnyInput();
  331.     }
  332.     else if (reading==KEYBOARD) {
  333.         if (c0=='\n')
  334.         c1 = EOF;
  335.         else
  336.         c1 = nextConsoleChar();
  337.     }
  338.     else
  339.         c1 = getc(inputStream);
  340.  
  341.       /* Treat CR/LF identically -- KH */
  342.       if(c1=='\r') c1 = '\n';
  343.     }
  344. }
  345.  
  346. static Void local thisLineIs(kind)    /* register kind of current line   */
  347. Int kind; {                /* & check for literate script errs*/
  348.     if (literateErrors && ((kind==DEFNLINE && lastLine==TEXTLINE) ||
  349.                (kind==TEXTLINE && lastLine==DEFNLINE))) {
  350.     ERROR(row) "Program line next to comment"
  351.     EEND;
  352.     }
  353.     lastLine = kind;
  354. }
  355.  
  356. static Void local newlineSkip() {      /* skip `\n' (supports lit scripts) */
  357.     if (reading==SCRIPTFILE && thisLiterate) {
  358.     do {
  359.         skip();
  360.         if (c0==DEFNCHAR) {        /* pass chars on definition lines   */
  361.         thisLineIs(DEFNLINE);  /* to lexer (w/o leading DEFNCHAR)  */
  362.         skip();
  363.         litLines++;
  364.         return;
  365.         }
  366.         while (c0==' ' || c0=='\t')/* maybe line is blank?           */
  367.         skip();
  368.         if (c0=='\n' || c0==EOF)
  369.         thisLineIs(BLANKLINE);
  370.         else {
  371.         thisLineIs(TEXTLINE);  /* otherwise it must be a comment   */
  372.         while (c0!='\n' && c0!=EOF)
  373.             skip();
  374.         }                   /* by now, c0=='\n' or c0==EOF       */
  375.     } while (c0!=EOF);           /* if new line, start again       */
  376.  
  377.     if (litLines==0 && literateErrors) {
  378.         ERROR(row) "Empty script - perhaps you forgot the `%c's?",
  379.                DEFNCHAR
  380.         EEND;
  381.     }
  382.     return;
  383.     }
  384.     skip();
  385. }
  386.  
  387. static Void local closeAnyInput() {    /* close input stream, if open      */
  388.     if (reading==SCRIPTFILE || reading==PROJFILE)
  389.     fclose(inputStream);
  390.     else if (reading==KEYBOARD)        /* or skip to end of console line  */
  391. #if 1 /* Looks like a bug -- KH */
  392.         while (c0!=EOF)
  393.         skip();
  394. #else
  395.         {
  396.           while (c0!=EOF && c0 != '\n' && c0 != '\r')
  397.         skip();
  398.       if(c0 != EOF)
  399.         skip();
  400.     }
  401. #endif
  402.     reading=NOTHING;
  403. }
  404.  
  405. /* --------------------------------------------------------------------------
  406.  * Parser: Uses table driven parser generated from parser.y using yacc
  407.  * ------------------------------------------------------------------------*/
  408.  
  409. /****************************************************************************
  410.  
  411.     Beware of the Yacc-generated parser which uses Shorts: on the Mac these
  412.     take 2 bytes of stack rather than 4 and therefore destroy GC.
  413.     I have tried to make sure that an even number of Short values are 
  414.     pushed by undefining the register directive -- with luck this will 
  415.     align the stack properly during parsing.
  416.  
  417.     I'm reluctant to redefine short as int, since this would double the
  418.     parse-stack requirements for these values, and stack is already in 
  419.     short supply!  You may need to do something similar for non-Mac
  420.     systems.
  421.  
  422.     KH
  423.  
  424. ***************************************************************************/
  425.  
  426. #if MPW
  427. #define register
  428. #endif
  429.  
  430. #include "parser.c"
  431.  
  432. #if MPW
  433. #undef register
  434. #endif
  435.  
  436.  
  437. /* --------------------------------------------------------------------------
  438.  * Single token input routines:
  439.  *
  440.  * The following routines read the values of particular kinds of token given
  441.  * that the first character of the token has already been located in c0 on
  442.  * entry to the routine.
  443.  * ------------------------------------------------------------------------*/
  444.  
  445. #define MAX_TOKEN        250
  446. #define startToken()        tokPos = 0
  447. #define saveTokenChar(c)    if (tokPos<MAX_TOKEN) saveChar(c); else ++tokPos
  448. #define saveChar(c)        tokenStr[tokPos++]=(c)
  449. #define SPECIALS        "(),;[]_{}"
  450.  
  451. /* On the Mac, we use a special character table to give the class of a character */
  452. #if !MPW
  453. #define SYMBOLS         ":!#$%&*+./<=>?@\\^|-" /* For Haskell 1.1: `-' */
  454. #define    DIACRITS        ""
  455. #define issymb(c)        isoneof(c,SYMBOLS)
  456. #endif
  457.  
  458. #define PRESYMBOLS         "~"               /* should be a PRESYMBOL*/
  459.                                                    /* but including it here*/
  460.                                                    /* means we lose eg <- */
  461.  
  462. #define isoneof(c,cs)        (strchr(cs,c)!=(char *)0)
  463. #define overflows(num,base,dig,max)  \
  464.     ((unsigned)(num) > ((unsigned)((unsigned)(max)-(unsigned)(dig)))/(unsigned)(base))
  465.  
  466. #if MPW
  467. /*
  468.     A character classification table.
  469.     This replaces the standard one for isalpha etc.
  470.     
  471.         _C    Control character
  472.         _S    Space
  473.         _P    Punctuation
  474.         _N    Digit
  475.         _X    Hex Digit
  476.         _L    Lowercase character (extended with Mac diacriticals)
  477.         _U    Uppercase character (-- " --)
  478.         _Y    Gofer symbolic character [NEW]
  479. */
  480.  
  481. char _ctype[] =
  482. {
  483.      0,    /* Dummy character */
  484.     _C, _C, _C, _C, _C, _C, _C, _C, _C, _S, _S, _C, _S, _S, _C, _C,
  485.     _C, _C, _C, _C, _C, _C, _C, _C, _C, _C, _C, _C, _C, _C, _C, _C,
  486.     _S, _Y, _P, _Y, _Y, _Y, _Y, _P, _P, _P, _Y, _Y, _P, _Y, _Y, _Y,
  487.     _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X ,_N|_X, _N|_X, _N|_X, _N|_X,
  488.     _Y, _P, _Y, _Y, _Y, _Y, _Y, 
  489.     _U|_X, _U|_X, _U|_X, _U|_X, _U|_X, _U|_X,
  490.     _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U,
  491.     _P, _Y, _P, _Y, _P, _P,
  492.     _L|_X, _L|_X, _L|_X, _L|_X, _L|_X, _L|_X,
  493.     _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L,
  494.     _P, _Y, _P, _P, _P,
  495.     _U, _U, _U, _U, _U, _U, _U,
  496.     _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L, _L,
  497.     _L, _L, _L, _L, _L,
  498.     _Y, _Y, _Y, _Y, _Y, _Y, _Y, _L, _Y, _Y, _L, _P, _P, _Y, _U, _U, _Y, _Y,
  499.     _Y, _Y, _Y, _L, _L, _U, _U, _L, _Y, _P, _P, _U, _L, _L, _Y, _Y, _P, _P,
  500.     _Y, _U, _U, _U, _U, _U, _U, _U, _U, _U, _U, _Y, _U, _U, _U, _U, _L,
  501.     _P, _P, _P, _P, _P, _P, _P, _P, _P, _P
  502. };
  503.  
  504. #endif
  505.  
  506.  
  507. static char tokenStr[MAX_TOKEN+1];    /* token buffer               */
  508. static Int  tokPos;            /* input position in buffer       */
  509. static Int  identType;            /* identifier type: CONID / VARID  */
  510. static Int  opType;            /* operator type  : CONOP / VAROP  */
  511.  
  512. static Void local endToken() {        /* check for token overflow       */
  513.     if (tokPos>MAX_TOKEN) {
  514.     ERROR(row) "Maximum token length (%d) exceeded", MAX_TOKEN
  515.     EEND;
  516.     }
  517.     tokenStr[tokPos] = '\0';
  518. }
  519.  
  520. static Text local readOperator() {    /* read operator symbol           */
  521.     startToken();
  522.     do {
  523.     saveTokenChar(c0);
  524.     skip();
  525.     } while (c0 != EOF && isascii(c0) && issymb(c0));
  526.     opType = (tokenStr[0]==':' ? CONOP : VAROP);
  527.     endToken();
  528.     return findText(tokenStr);
  529. }
  530.  
  531. static Text local readIdent() {        /* read identifier           */
  532.     startToken();
  533.     do {
  534.     saveTokenChar(c0);
  535.     skip();
  536.     } while (c0 != EOF && (isascii(c0) && isalnum(c0)) || c0=='_' || c0=='\'');
  537.     endToken();
  538.     identType = isupper(tokenStr[0]) ? CONID : VARID;
  539.     return findText(tokenStr);
  540. }
  541.  
  542. static Cell local readNumber() {       /* read numeric constant        */
  543.     unsigned   n      = 0;
  544.     unsigned   d      = 0;
  545.     Bool  intTooLarge = FALSE;
  546.  
  547.     startToken();
  548.     
  549.     /* Read Hex numbers -- KH */
  550.     if( c0 == '0' && c1 == 'x')
  551.       {
  552.         skip();
  553.     
  554.     /* If we have just "0x", this is treated as two symbols "0" and "x" */
  555.         if(c1 != EOF && isascii(c1) && isxdigit(c1))
  556.       {
  557.         skip();
  558.             do {
  559.             d = c0 - (isdigit(c0)? '0': ((islower(c0)? 'a': 'A')-10));
  560.                 if(overflows(n,(unsigned)16,d,(unsigned)MAXUNSIGNEDINT))
  561.                intTooLarge = TRUE;
  562.             else
  563.            n  = 16*n  + d;
  564.             saveTokenChar(c0);
  565.             skip();
  566.             } while (c0 != EOF && isascii(c0) && isxdigit(c0));
  567.       }
  568.      endToken();
  569.     if (!intTooLarge)
  570.         return mkInt(n);
  571.        ERROR(row) "Hexadecimal literal out of range"
  572.        EEND;
  573.      }
  574.  
  575.     /* Read Decimal numbers */
  576.     else do {
  577.      if (overflows(n,10,(c0-'0'),MAXPOSINT))
  578.         intTooLarge = TRUE;
  579.     n  = 10*n  + (c0-'0');
  580.     saveTokenChar(c0);
  581.     skip();
  582.       } while (c0 != EOF && isascii(c0) && isdigit(c0));
  583.  
  584.     if (c0!='.' || !isascii(c1) || !isdigit(c1)) {
  585.     endToken();
  586.     if (!intTooLarge)
  587.         return mkInt(n);
  588. #if HAS_FLOATS
  589.     if (intTooLarge)
  590.         return mkFloatFromStr(tokenStr);
  591. #endif
  592.        ERROR(row) "Integer literal out of range"
  593.        EEND;
  594.     }
  595.  
  596.     saveTokenChar(c0);                /* save decimal point           */
  597.     skip();
  598.     do {                /* process fractional part ...       */
  599.     saveTokenChar(c0);
  600.     skip();
  601.     } while (c0 != EOF && isascii(c0) && isdigit(c0));
  602.  
  603.     if (c0=='e' || c0=='E') {        /* look for exponent part...       */
  604.     saveTokenChar('e');
  605.     skip();
  606.     if (c0=='-') {
  607.         saveTokenChar('-');
  608.         skip();
  609.     }
  610.     else if (c0=='+')
  611.         skip();
  612.  
  613.     if (!isascii(c0) || !isdigit(c0)) {
  614.         ERROR(row) "Missing digits in exponent"
  615.         EEND;
  616.     }
  617.     else {
  618.         do {
  619.         saveTokenChar(c0);
  620.         skip();
  621.         } while (c0 != EOF && isascii(c0) && isdigit(c0));
  622.     }
  623.     }
  624.  
  625.     endToken();
  626. #if !HAS_FLOATS
  627.     ERROR(row) "No floating point numbers in this implementation"
  628.     EEND;
  629. #endif
  630.  
  631.     return mkFloatFromStr(tokenStr);
  632. }
  633.  
  634. static Cell local readChar() {           /* read character constant       */
  635.     Cell charRead;
  636.  
  637.     skip(/* '\'' */);
  638.     if (c0=='\'' || c0=='\n' || c0==EOF) {
  639.     ERROR(row) "Illegal character constant"
  640.     EEND;
  641.     }
  642.  
  643.     charRead = readAChar(FALSE);
  644.  
  645.     if (c0=='\'')
  646.     skip(/* '\'' */);
  647.     else {
  648.     ERROR(row) "Improperly terminated character constant"
  649.     EEND;
  650.     }
  651.     return charRead;
  652. }
  653.  
  654. static Cell local readString() {       /* read string literal           */
  655.     Cell c;
  656.  
  657.     startToken();
  658.     skip(/* '\"' */);
  659.     while (c0!='\"' && c0!='\n' && c0!=EOF) {
  660.     c = readAChar(TRUE);
  661.     if (nonNull(c))
  662.         saveStrChr(charOf(c));
  663.     }
  664.  
  665.     if (c0=='\"')
  666.     skip(/* '\"' */);
  667.     else {
  668.     ERROR(row) "improperly terminated string"
  669.     EEND;
  670.     }
  671.     endToken();
  672.     return mkStr(findText(tokenStr));
  673. }
  674.  
  675. static Void local saveStrChr(c)        /* save character in string       */
  676. Char c; {
  677.     if (c!='\0' && c!='\\') {           /* save non null char as single char*/
  678.     saveTokenChar(c);
  679.     }
  680.     else {                   /* save null char as TWO null chars */
  681.     if (tokPos+1<MAX_TOKEN) {
  682.         saveChar('\\');
  683.         if (c=='\\')
  684.         saveChar('\\');
  685.         else
  686.         saveChar('0');
  687.     }
  688.     }
  689. }
  690.  
  691. static Cell local readAChar(allowEmpty)/* read single char constant       */
  692. Bool allowEmpty; {               /* TRUE => enable use of \& and gaps*/
  693.     Cell c = mkChar(c0);
  694.  
  695.     if (c0=='\\')               /* escape character?           */
  696.     return readEscapeChar(allowEmpty);
  697.     if (!isprint(c0)) {
  698.     ERROR(row) "Non printable character '\\%d' in constant", (int) c0
  699.     EEND;
  700.     }
  701.     skip();                   /* normal character?           */
  702.     return c;
  703. }
  704.  
  705. /* --------------------------------------------------------------------------
  706.  * Character escape code sequences:
  707.  * ------------------------------------------------------------------------*/
  708.  
  709. static struct {                /* table of special escape codes    */
  710.     char *codename;
  711.     int  codenumber;
  712. } escapes[] = {
  713.    {"a",    7}, {"b",     8}, {"f",   12},        /* common escapes  */
  714. #if MPW
  715.    {"n",   13},                        /* NL and CR are identical */
  716. #else
  717.    {"n",   10},
  718. #endif
  719.    {"r",   13}, {"t",     9}, {"\\",'\\'}, {"\"",'\"'},
  720.    {"\'",'\''}, {"v",    11},
  721.    {"NUL",  0}, {"SOH",  1}, {"STX",  2}, {"ETX",  3},    /* ascii codenames */
  722.    {"EOT",  4}, {"ENQ",  5}, {"ACK",  6}, {"BEL",  7},
  723.    {"BS",   8}, {"HT",     9}, {"LF",  10}, {"VT",  11},
  724.    {"FF",  12}, {"CR",    13}, {"SO",  14}, {"SI",  15},
  725.    {"DLE", 16}, {"DC1", 17}, {"DC2", 18}, {"DC3", 19},
  726.    {"DC4", 20}, {"NAK", 21}, {"SYN", 22}, {"ETB", 23},
  727.    {"CAN", 24}, {"EM",    25}, {"SUB", 26}, {"ESC", 27},
  728.    {"FS",  28}, {"GS",    29}, {"RS",  30}, {"US",  31},
  729.    {"SP",  32}, {"DEL", 127},
  730.    {0,0}
  731. };
  732.  
  733. static Int  alreadyMatched;           /* Record portion of input stream   */
  734. static char alreadyRead[10];           /* that has been read w/o a match   */
  735.  
  736. static Bool local lazyReadMatches(s)   /* compare input stream with string */
  737. String s; {                   /* possibly using characters that   */
  738.     int i;                   /* have already been read       */
  739.  
  740.     for (i=0; i<alreadyMatched; ++i)
  741.     if (alreadyRead[i]!=s[i])
  742.         return FALSE;
  743.  
  744.     while (s[i] && s[i]==c0) {
  745.     alreadyRead[alreadyMatched++]=c0;
  746.     skip();
  747.     i++;
  748.     }
  749.  
  750.     return s[i]=='\0';
  751. }
  752.  
  753. static Cell local readEscapeChar(allowEmpty) /* read escape character       */
  754. Bool allowEmpty; {
  755.     int i=0;
  756.  
  757.     skip(/* '\\' */);
  758.     switch (c0) {
  759.     case '&'  : if (allowEmpty) {
  760.             skip();
  761.             return NIL;
  762.             }
  763.             ERROR(row) "Illegal use of \\& in character constant"
  764.             EEND;
  765.             break;/*NOTREACHED*/
  766.     case ' '  :
  767.     case '\n' :
  768.     case '\t' : if (allowEmpty) {
  769.             skipGap();
  770.             return NIL;
  771.             }
  772.             ERROR(row) "Illegal use of gap in character constant"
  773.             EEND;
  774.             break;
  775.     case '^'  : return readCtrlChar();
  776.     case 'o'  : return readOctChar();
  777.     case 'x'  : return readHexChar();
  778.     default   : if (isdigit(c0))
  779.             return readDecChar();
  780.     }
  781.  
  782.     for (alreadyMatched=0; escapes[i].codename; i++)
  783.     if (lazyReadMatches(escapes[i].codename))
  784.         return mkChar(escapes[i].codenumber);
  785.  
  786.     alreadyRead[alreadyMatched++] = c0;
  787.     alreadyRead[alreadyMatched++] = '\0';
  788.     ERROR(row) "Illegal character escape sequence \"\\%s\"",
  789.            alreadyRead
  790.     EEND;
  791.     return NIL;/*NOTREACHED*/
  792. }
  793.  
  794. static Void local skipGap() {        /* skip over gap in string literal */
  795.     do                    /* (simplified in Haskell 1.1)       */
  796.         if(c0=='\n')
  797.           newlineSkip();
  798.     else
  799.       skip();
  800.      while (c0==' ' || c0=='\t' || c0=='\n');
  801.     if (c0!='\\') {
  802.     ERROR(row) "Missing `\\' terminating string literal gap"
  803.     EEND;
  804.     }
  805.     skip(/* '\\' */);
  806. }
  807.  
  808. static Cell local readCtrlChar() {     /* read escape sequence \^x       */
  809.     static String controls = "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
  810.     String which;
  811.  
  812.     skip(/* '^' */);
  813.     if ((which = strchr(controls,c0))==NULL) {
  814.     ERROR(row) "Unrecognised escape sequence `\\^%c'", c0
  815.     EEND;
  816.     }
  817.     skip();
  818.     return mkChar(which-controls);
  819. }
  820.  
  821. static Cell local readOctChar() {      /* read octal character constant    */
  822.     Int n = 0;
  823.     Int d;
  824.  
  825.     skip(/* 'o' */);
  826.     if ((d = readOctDigit())<0) {
  827.     ERROR(row) "Empty octal character escape"
  828.     EEND;
  829.     }
  830.     do {
  831.     if (overflows(n,8,d,MAXCHARVAL)) {
  832.         ERROR(row) "Octal character escape out of range"
  833.         EEND;
  834.     }
  835.     n = 8*n + d;
  836.     skip();
  837.     } while ((d = readOctDigit())>=0);
  838.  
  839.     return mkChar(n);
  840. }
  841.  
  842. static Int local readOctDigit() {      /* read single octal digit       */
  843.     if ('0'<=c0 && c0<='7')
  844.     return c0-'0';
  845.     return -1;
  846. }
  847.  
  848. static Cell local readHexChar() {      /* read hex character constant       */
  849.     Int n = 0;
  850.     Int d;
  851.  
  852.     skip(/* 'x' */);
  853.     if ((d = readHexDigit())<0) {
  854.     ERROR(row) "Empty hexadecimal character escape"
  855.     EEND;
  856.     }
  857.     do {
  858.     if (overflows(n,16,d,MAXCHARVAL)) {
  859.         ERROR(row) "Hexadecimal character escape out of range"
  860.         EEND;
  861.     }
  862.     n = 16*n + d;
  863.     skip();
  864.     } while ((d = readHexDigit())>=0);
  865.  
  866.     return mkChar(n);
  867. }
  868.  
  869. static Int local readHexDigit() {      /* read single hex digit        */
  870.     if ('0'<=c0 && c0<='9')
  871.     return c0-'0';
  872.     if ('A'<=c0 && c0<='F')
  873.     return 10 + (c0-'A');
  874.     if ('a'<=c0 && c0<='f')
  875.     return 10 + (c0-'a');
  876.     return -1;
  877. }
  878.  
  879. static Cell local readDecChar() {      /* read decimal character constant  */
  880.     Int n = 0;
  881.  
  882.     do {
  883.     if (overflows(n,10,(c0-'0'),MAXCHARVAL)) {
  884.         ERROR(row) "Decimal character escape out of range"
  885.         EEND;
  886.     }
  887.     n = 10*n + (c0-'0');
  888.     skip();
  889.      } while (c0 != EOF && isascii(c0) && isdigit(c0));
  890.  
  891.     return mkChar(n);
  892. }
  893.  
  894. /* --------------------------------------------------------------------------
  895.  * Produce printable representation of character:
  896.  * ------------------------------------------------------------------------*/
  897.  
  898. String unlexChar(c,quote)        /* return string representation of */
  899. Char c;                    /* character...               */
  900. Char quote; {                /* protect quote character       */
  901.     static char buffer[12];
  902.  
  903.     if (c<0)                /* deal with sign extended chars.. */
  904.     c += NUM_CHARS;
  905.  
  906.     if (isascii(c) && isprint(c)) {    /* normal printable character       */
  907.     if (c==quote) {            /* look for quote of approp. kind  */
  908.         buffer[0] = '\\';        
  909.         buffer[1] = c;
  910.         buffer[2] = '\0';
  911.     }
  912.     else {
  913.             buffer[0] = c;
  914.             buffer[1] = '\0';
  915.     }
  916.     }
  917.     else {                /* look for escape code           */
  918.         Int escs;
  919.         for (escs=0; escapes[escs].codename; escs++)
  920.         if (escapes[escs].codenumber==c) {
  921.         sprintf(buffer,"\\%s",escapes[escs].codename);
  922.         return buffer;
  923.         }
  924.         sprintf(buffer,"\\%d",c);    /* otherwise use numeric escape       */
  925.     }
  926.     return buffer;
  927. }
  928.  
  929. /* --------------------------------------------------------------------------
  930.  * Handle special types of input for use in interpreter:
  931.  * ------------------------------------------------------------------------*/
  932.  
  933. Command readCommand(cmds,start,sys)    /* read command at start of input  */
  934. struct cmd *cmds;            /* line in interpreter           */
  935. Char   start;                /* characters introducing a cmd    */
  936. Char   sys; {                /* character for shell escape       */
  937.     while (c0==' ' || c0 =='\t')
  938.     skip();
  939.  
  940.     if (c0=='\n')                   /* look for blank command lines     */
  941.     return NOCMD;
  942.     if (c0==EOF)            /* look for end of input stream       */
  943.     return QUIT;
  944. #if !MAC
  945.     if (c0==sys) {            /* single character system escape  */
  946.     skip();
  947.     return SYSTEM;
  948.     }
  949.     if (c0==start && c1==sys) {        /* two character system escape       */
  950.     skip();
  951.     skip();
  952.     return SYSTEM;
  953.     }
  954. #endif
  955.  
  956.     startToken();            /* All cmds start with start       */
  957.     if (c0==start)            /* except default (usually EVAL)   */
  958.     do {                /* which is empty           */
  959.         saveTokenChar(c0);
  960.         skip();
  961.     } while (c0!=' ' && c0!='\t' && c0!='\n' && c0!=EOF);
  962.     endToken();
  963.  
  964.     for (; cmds->cmdString; ++cmds)
  965.     if (strcmp((cmds->cmdString),tokenStr)==0 ||
  966.             (tokenStr[0]==start &&
  967.              tokenStr[1]==(cmds->cmdString)[1] &&
  968.              tokenStr[2]=='\0'))
  969.         return (cmds->cmdCode);
  970.     return BADCMD;
  971. }
  972.  
  973. String readFilename() {            /* Read filename from input (if any)*/
  974.     if (reading==PROJFILE)
  975.     skipWhitespace();
  976.     else
  977.     while (c0==' ' || c0=='\t')
  978.         skip();
  979.  
  980.     if (c0=='\n' || c0==EOF)  /* return null string at end of line*/
  981.     return 0;
  982.  
  983.     startToken();
  984.     while (c0!=' ' && c0!='\t' && c0!='\n' && c0!=EOF) {
  985.     saveTokenChar(c0);
  986.     skip();
  987.     }
  988.     endToken();
  989.  
  990.     return tokenStr;
  991. }
  992.  
  993. String readLine() {            /* Read command line from input       */
  994.     while (c0==' ' || c0=='\t')        /* skip leading whitespace       */
  995.     skip();
  996.  
  997.     startToken();
  998.     while (c0!='\n' && c0!=EOF) {
  999.     saveTokenChar(c0);
  1000.     skip();
  1001.     }
  1002.     endToken();
  1003.  
  1004.     return tokenStr;
  1005. }
  1006.  
  1007. /* --------------------------------------------------------------------------
  1008.  * This lexer supports the Haskell layout rule:
  1009.  *
  1010.  * - Layout area bounded by { ... }, with `;'s in between.
  1011.  * - A `{' is a HARD indentation and can only be matched by a corresponding
  1012.  *   HARD '}'
  1013.  * - Otherwise, if no `{' follows the keywords WHERE/LET or OF, a SOFT `{'
  1014.  *   is inserted with the column number of the first token after the
  1015.  *   WHERE/LET/OF keyword.
  1016.  * - When a soft indentation is uppermost on the indetation stack with
  1017.  *   column col' we insert:
  1018.  *    `}'  in front of token with column<col' and pop indentation off stack,
  1019.  *    `;'  in front of token with column==col'.
  1020.  * ------------------------------------------------------------------------*/
  1021.  
  1022. #define MAXINDENT  100               /* maximum nesting of layout rule   */
  1023. static    Int       layout[MAXINDENT+1];/* indentation stack           */
  1024. #define HARD       (-1)            /* indicates hard indentation       */
  1025. static    Int       indentDepth = (-1); /* current indentation nesting       */
  1026.  
  1027. static Void local goOffside(col)       /* insert offside marker        */
  1028. Int col; {                   /* for specified column           */
  1029.     if (indentDepth>=MAXINDENT) {
  1030.     ERROR(row) "Too many levels of program nesting"
  1031.     EEND;
  1032.     }
  1033.     layout[++indentDepth] = col;
  1034. }
  1035.  
  1036. static Void local unOffside() {        /* leave layout rule area       */
  1037.     indentDepth--;
  1038. }
  1039.  
  1040. static Bool local canUnOffside() {     /* Decide if unoffside permitted    */
  1041.     return indentDepth>=0 && layout[indentDepth]!=HARD;
  1042. }
  1043.  
  1044. /* --------------------------------------------------------------------------
  1045.  * Main tokeniser:
  1046.  * ------------------------------------------------------------------------*/
  1047.  
  1048. static Void local skipWhitespace() {   /* skip over whitespace/comments    */
  1049.  
  1050. ws: while (c0==' ' || c0=='\t' || c0=='\r' || c0=='\f')
  1051.     skip();
  1052.  
  1053.     if (c0=='\n') {        /* skip newline characters       */
  1054.     newlineSkip();
  1055.     goto ws;
  1056.     }
  1057.  
  1058.     if (c0=='{' && c1=='-') {           /* (potentially) nested comment       */
  1059.     Int nesting = 1;
  1060.     Int origRow = row;           /* save original row number       */
  1061.  
  1062.         skip();
  1063.         skip();
  1064.     while (nesting>0 && c0!=EOF) {
  1065.         if (c0=='{' && c1=='-') {
  1066.         skip();
  1067.         nesting++;
  1068.         }
  1069.         else if (c0=='-' && c1=='}') {
  1070.         skip();
  1071.         nesting--;
  1072.         }
  1073.  
  1074.         if (c0=='\n')
  1075.         newlineSkip();
  1076.         else
  1077.         skip();
  1078.     }
  1079.     if (nesting>0) {
  1080.         ERROR(origRow) "Unterminated nested comment {- ..."
  1081.         EEND;
  1082.     }
  1083.     goto ws;
  1084.     }
  1085.  
  1086.     if (c0=='-' && c1=='-') {           /* one line comment           */
  1087.     do
  1088.         skip();
  1089.     while (c0!='\n' && c0!=EOF);
  1090.  
  1091.     if (c0!=EOF)
  1092.         newlineSkip();
  1093.     goto ws;
  1094.     }
  1095. }
  1096.  
  1097. static Bool firstToken;            /* Set to TRUE for first token       */
  1098. static Int  firstTokenIs;           /* ... with token value stored here */
  1099.  
  1100. static Int local yylex() {           /* Read next input token ...       */
  1101.     static Bool insertOpen    = FALSE;
  1102.     static Bool insertedToken = FALSE;
  1103.     static Text textRepeat;
  1104.  
  1105. #define lookAhead(t) {skipWhitespace(); insertOpen = (c0!='{'); return t;}
  1106.  
  1107.     if (firstToken) {               /* Special case for first token       */
  1108.     indentDepth   = (-1);
  1109.     firstToken    = FALSE;
  1110.     insertOpen    = FALSE;
  1111.     insertedToken = FALSE;
  1112.     if (reading==KEYBOARD)
  1113.         textRepeat = findText(repeatStr);
  1114.     return firstTokenIs;
  1115.     }
  1116.  
  1117.     if (insertOpen) {               /* insert `soft' opening brace       */
  1118.     insertOpen    = FALSE;
  1119.     insertedToken = TRUE;
  1120.     goOffside(column);
  1121.     push(yylval = mkInt(row));
  1122.     return '{';
  1123.     }
  1124.  
  1125.     /* ----------------------------------------------------------------------
  1126.      * Skip white space, and insert tokens to support layout rules as reqd.
  1127.      * --------------------------------------------------------------------*/
  1128.  
  1129.     skipWhitespace();
  1130.     startColumn = column;
  1131.     push(yylval = mkInt(row));           /* default token value is line no.  */
  1132.     /* subsequent changes to yylval must also set top() to the same value  */
  1133.  
  1134.     if (indentDepth>=0)            /* layout rule(s) active ?       */
  1135.         if (insertedToken)           /* avoid inserting multiple `;'s    */
  1136.         insertedToken = FALSE;     /* or putting `;' after `{'       */
  1137.         else if (layout[indentDepth]!=HARD)
  1138.         if (column<layout[indentDepth]) {
  1139.         unOffside();
  1140.         return '}';
  1141.             }
  1142.             else if (column==layout[indentDepth] && c0!=EOF) {
  1143.                 insertedToken = TRUE;
  1144.                 return ';';
  1145.             }
  1146.  
  1147.     /* ----------------------------------------------------------------------
  1148.      * Now try to identify token type as one of:
  1149.      * - end of file character
  1150.      * - Special character:  ( ) , ; [ ] _ { } `
  1151.      * - Character constant
  1152.      * - String Constant
  1153.      * - Integer literal
  1154.      * - Alphanum: reservedid, VARID or CONID
  1155.      * - operator: reservedop, VAROP or CONOP
  1156.      * --------------------------------------------------------------------*/
  1157.  
  1158.     switch (c0) {
  1159.     case EOF  : return 0;
  1160.  
  1161.     case '('  : skip();
  1162.             return '(';
  1163.  
  1164.     case ')'  : skip();
  1165.             return ')';
  1166.  
  1167.     case ','  : skip();
  1168.             return ',';
  1169.  
  1170.     case ';'  : skip();
  1171.             return ';';
  1172.  
  1173.     case '['  : skip();
  1174.             return '[';
  1175.  
  1176.     case ']'  : skip();
  1177.             return ']';
  1178.  
  1179.     case '_'  : skip();
  1180.             return '_';
  1181.  
  1182.     case '{'  : goOffside(HARD);
  1183.             skip();
  1184.             return '{';
  1185.  
  1186.     case '}'  : if (indentDepth<0) {
  1187.             ERROR(row) "Misplaced `}'"
  1188.             EEND;
  1189.             }
  1190.             if (layout[indentDepth]==HARD)    /* skip over hard } */
  1191.             skip();
  1192.             unOffside();    /* otherwise, we have to insert a } */
  1193.             return '}';        /* to (try to) avoid an error...    */
  1194.  
  1195.     case '\'' : top() = yylval = readChar();
  1196.             return CHARLIT;
  1197.  
  1198.     case '\"' : top() = yylval = readString();
  1199.             return STRINGLIT;
  1200.  
  1201.     case '`'  : skip();
  1202.             return '`';
  1203.     }
  1204.  
  1205. /* All characters are printable on the Mac! KH */
  1206. #if !MAC
  1207.     if (!(isascii(c0) && isprint(c0))) {
  1208.     ERROR(row) "Unrecognised character '\\%d' in column %d", (int) c0, column
  1209.     EEND;
  1210.     }
  1211. #endif
  1212.  
  1213.     if (isalpha(c0)) {
  1214.     Text it = readIdent();
  1215.  
  1216.     if (it==textCase)              return CASEXP;
  1217.     if (it==textOfK)               lookAhead(OF);
  1218.     if (it==textData)           return DATA;
  1219.     if (it==textType)           return TYPE;
  1220.     if (it==textIf)            return IF;
  1221.     if (it==textThen)           return THEN;
  1222.     if (it==textElse)           return ELSE;
  1223.     if (it==textWhere)             lookAhead(WHERE);
  1224.         if (it==textLet)               lookAhead(LET);
  1225.         if (it==textIn)                return IN;
  1226.     if (it==textInfix)           return INFIX;
  1227.     if (it==textInfixl)           return INFIXL;
  1228.     if (it==textInfixr)           return INFIXR;
  1229.     if (it==textPrim)              return PRIMITIVE;
  1230.     if (it==textClass)           return TCLASS;
  1231.     if (it==textInstance)           return TINSTANCE;
  1232.     if (it==textDeriving)           return DERIVING;
  1233.     if (it==textDefault)           return DEFAULT;
  1234.     if (it==textHiding)           return HIDING;
  1235.     if (it==textImport)           return IMPORT;
  1236.     if (it==textInterface)           return INTERFACE;
  1237.     if (it==textModule)           return MODULE;
  1238.     if (it==textTo)               return TO;
  1239.     if (it==textRenaming)           return RENAMING;
  1240.     if (it==textRepeat && reading==KEYBOARD)
  1241.         return repeatLast();
  1242.     
  1243.     if(it==textDo)        lookAhead(DO);
  1244.     if(it==textEnd)        lookAhead(END);
  1245.  
  1246.     top() = yylval = ap((identType==CONID ? CONIDCELL : VARIDCELL),it);
  1247.     return identType;
  1248.     }
  1249.  
  1250.     if (issymb(c0) || isoneof(c0,PRESYMBOLS)) {
  1251.     Text it = readOperator();
  1252.  
  1253.     if (it==textCoco)    return COCO;
  1254.     if (it==textEq)      return '=';
  1255.     if (it==textUpto)    return UPTO;
  1256.     if (it==textAs)      return '@';
  1257.     if (it==textLambda)  return '\\';
  1258.     if (it==textBar)     return '|';
  1259.     if (it==textFrom)    return FROM;/*relies on notElem '-' PRESYMBOLS*/
  1260.     if (it==textMinus)   return '-';
  1261.     if (it==textArrow)   return FUNARROW;
  1262.     if (it==textLazy)    return '~';
  1263.     if (it==textImplies) return IMPLIES;
  1264.     if (it==textRepeat && reading==KEYBOARD)
  1265.         return repeatLast();
  1266.  
  1267.     top() = yylval = ap((opType==CONOP ? CONOPCELL : VAROPCELL),it);
  1268.     return opType;
  1269.     }
  1270.  
  1271.     if (isdigit(c0)) {
  1272.     top() = yylval = readNumber();
  1273.     return NUMLIT;
  1274.     }
  1275.  
  1276.     ERROR(row) "Unrecognised token '\\%d' in column %d", (int) c0, column
  1277.     EEND;
  1278.     return 0; /*NOTREACHED*/
  1279. }
  1280.  
  1281. static Int local repeatLast() {        /* obtain last expression entered  */
  1282.     if (isNull(yylval=getLastExpr())) {
  1283.     ERROR(row) "Cannot use %s without any previous input", repeatStr
  1284.     EEND;
  1285.     }
  1286.     return REPEAT;
  1287. }
  1288.  
  1289. Syntax defaultSyntax(t)            /* find default syntax of var named */
  1290. Text t; {                   /* by t ...               */
  1291.     String s = textToStr(t);
  1292.     if ((isascii(s[0]) && isalpha(s[0])) || s[0]=='_' || strcmp(s,"[]")==0)
  1293.     return APPLIC;
  1294.     else
  1295.     return DEF_OPSYNTAX;
  1296. }
  1297.  
  1298. /* --------------------------------------------------------------------------
  1299.  * main entry points to parser/lexer:
  1300.  * ------------------------------------------------------------------------*/
  1301.  
  1302. static Void local parseInput(startWith)/* parse input with given first tok,*/
  1303. Int startWith; {               /* determining whether to read a    */
  1304.     firstToken     = TRUE;           /* script or an expression       */
  1305.     firstTokenIs = startWith;
  1306.  
  1307.     clearStack();
  1308.     if (yyparse()) {               /* This can only be parser overflow */
  1309.     ERROR(row) "Parser overflow"   /* as all syntax errors are caught  */
  1310.     EEND;                   /* in the parser...           */
  1311.     }
  1312.     drop();
  1313.     if (!stackEmpty())               /* stack should now be empty       */
  1314.     internal("parseInput");
  1315. }
  1316.  
  1317. Void parseScript(nm,len)           /* Read a script: sets valDefns and */
  1318. String nm;                   /*                tyconDefns       */
  1319. Long   len; {                   /* used to set a target for reading)*/
  1320.     input(RESET);
  1321.     fileInput(nm,len);
  1322.     parseInput(SCRIPT);
  1323. }
  1324.  
  1325. Void parseExp() {               /* read an expression to evaluate   */
  1326.     parseInput(EVALEX);
  1327.     setLastExpr(inputExpr);
  1328. }
  1329.  
  1330. /* --------------------------------------------------------------------------
  1331.  * Input control:
  1332.  * ------------------------------------------------------------------------*/
  1333.  
  1334. Void input(what)
  1335. Int what; {
  1336.     switch (what) {
  1337.     case RESET   : tyconDefns  = NIL;
  1338.                typeInDefns = NIL;
  1339.                valDefns    = NIL;
  1340.                opDefns       = NIL;
  1341.                classDefns  = NIL;
  1342.                        instDefns   = NIL;
  1343.                overDefns   = NIL;
  1344.                inputExpr   = NIL;
  1345.                closeAnyInput();
  1346.                break;
  1347.  
  1348.     case BREAK   : if (reading==KEYBOARD)
  1349.                c0 = EOF;
  1350.                break;
  1351.  
  1352.     case MARK    : mark(tyconDefns);
  1353.                mark(typeInDefns);
  1354.                mark(valDefns);
  1355.                mark(opDefns);
  1356.                mark(classDefns);
  1357.                        mark(instDefns);
  1358.                mark(overDefns);
  1359.                mark(inputExpr);
  1360.                mark(varNegate);
  1361.                mark(varFlip);
  1362.                mark(varMinus);
  1363.                mark(varFrom);
  1364.                mark(varFromTo);
  1365.                mark(varFromThen);
  1366.                mark(varFromThenTo);
  1367.                break;
  1368.  
  1369.     case INSTALL : input(RESET);
  1370.                textCase       = findText("case");
  1371.                textOfK          = findText("of");
  1372.                textData       = findText("data");
  1373.                textType       = findText("type");
  1374.                textIf          = findText("if");
  1375.                textThen       = findText("then");
  1376.                textElse       = findText("else");
  1377.                textWhere      = findText("where");
  1378.                        textLet        = findText("let");
  1379.                        textIn         = findText("in");
  1380.                textInfix      = findText("infix");
  1381.                textInfixl     = findText("infixl");
  1382.                textInfixr     = findText("infixr");
  1383.                textPrim       = findText("primitive");
  1384.                textCoco       = findText("::");
  1385.                textEq          = findText("=");
  1386.                textUpto       = findText("..");
  1387.                textAs          = findText("@");
  1388.                textLambda     = findText("\\");
  1389.                textBar          = findText("|");
  1390.                textMinus      = findText("-");
  1391.                textFrom       = findText("<-");
  1392.                textArrow      = findText("->");
  1393.                textLazy       = findText("~");
  1394.                textClass      = findText("class");
  1395.                textInstance   = findText("instance");
  1396.                textImplies    = findText("=>");
  1397.                textPlus          = findText("+");
  1398.                textMult          = findText("*");
  1399.                textDefault    = findText("default");
  1400.                textDeriving   = findText("deriving");
  1401.                textHiding     = findText("hiding");
  1402.                textInterface  = findText("interface");
  1403.                textImport     = findText("import");
  1404.                textModule     = findText("module");
  1405.                textTo         = findText("to");
  1406.                textRenaming   = findText("renaming");
  1407.                textDo         = findText("do");
  1408.                textEnd        = findText("end");
  1409.  
  1410.                varMinus          = mkVar(findText("-"));
  1411.                varNegate      = mkVar(findText("negate"));
  1412.                varFlip          = mkVar(findText("flip"));
  1413.                varFrom          = mkVar(findText("enumFrom"));
  1414.                varFromTo      = mkVar(findText("enumFromTo"));
  1415.                varFromThen    = mkVar(findText("enumFromThen"));
  1416.                varFromThenTo  = mkVar(findText("enumFromThenTo"));
  1417.                break;
  1418.     }
  1419. }
  1420.  
  1421. /*-------------------------------------------------------------------------*/
  1422.