-- File: ScriptScanImpl.mesa - last edit by
-- Karlton:	 2-Sep-82 13:43:52

DIRECTORY
  Ascii USING [NUL, SP],
  Inline USING [HighByte, LowByte],
  Real USING [StringToReal],
  ScriptHash USING [Enter, Handle, Hash, nullHash, nullVal, Val],
  ScriptParse USING [Error, Terminal, TerminalType],
  Stream USING [EndOfStream, GetChar, Handle],
  String USING [AppendChar, AppendString, StringBoundsFault, StringToLongNumber];
  
ScriptScanImpl: PROGRAM
  IMPORTS Inline, Real, ScriptHash, ScriptParse, Stream, String
  EXPORTS ScriptParse = {
  
  nullVal: ScriptHash.Val = ScriptHash.nullVal;
  
  ScanState: TYPE = {start, version, token, stop};
  ScanHandle: TYPE = LONG POINTER TO ScanObject;
  ScanObject: PUBLIC TYPE = RECORD [
    index: LONG CARDINAL _ 0,
    char: CHARACTER _ Ascii.NUL,
    eof: BOOLEAN _ FALSE,
    state: ScanState _ start,
    endScript, links, true, false: ScriptHash.Hash,
    token: LONG STRING,
    univ, id: ScriptHash.Handle,
    z: UNCOUNTED ZONE,
    stream: Stream.Handle];
  
  NextChar: PROCEDURE [s: ScanHandle] = {
    IF s.eof OR s.state = stop THEN s.char _ Ascii.NUL
    ELSE {
      DO
        s.index _ s.index + 1;
	s.char _ s.stream.GetChar[ !
          Stream.EndOfStream => {
	    s.index _ s.index - 1;
	    s.eof _ TRUE;
	    s.char _ Ascii.NUL;
	    EXIT}];
         IF s.char IN [40C..176C] THEN EXIT;
	 ENDLOOP}};
    
  AppendToToken: PROCEDURE [scan: ScanHandle] = {
    String.AppendChar[scan.token, scan.char ! String.StringBoundsFault => {
      t: LONG STRING _ scan.z.NEW[StringBody[scan.token.length + 40]];
      String.AppendString[t, scan.token];
      scan.z.FREE[@scan.token];
      scan.token _ t;
      RESUME[t]}]};
      
  NextSymbol: PUBLIC PROCEDURE [scan: ScanHandle]
    RETURNS [t: ScriptParse.Terminal] = {
    IntSequence: PROCEDURE = {
      number: CARDINAL;
      set, char: CHARACTER;
      DO
        NextChar[scan];
	SELECT scan.char FROM
	  '=, '> => EXIT;
	  IN ['0..'9] => {
	    number _ (scan.char - '0);
	    DO
	      NextChar[scan];
	      SELECT scan.char FROM
	        IN ['0..'9] => number _ (number * 10) + (scan.char - '0);
		Ascii.SP => EXIT;
		ENDCASE => ERROR ScriptParse.Error[scan, scan.index];
	      ENDLOOP};
	  IN ['A..'P] => {
	    left, right: CHARACTER;
	    left _ scan.char;
	    NextChar[scan];
	    right _ scan.char;
	    IF right ~IN ['A..'P] THEN ERROR ScriptParse.Error[scan, scan.index];
	    number _ (left - 'A)*16 + (right - 'A)};
	  ENDCASE => ERROR ScriptParse.Error[scan, scan.index];
	IF (char _ Inline.LowByte[number]) = 377C OR 
	   (set _ Inline.HighByte[number]) = 377C THEN
	  ERROR ScriptParse.Error[scan, scan.index];
	IF set # curSet THEN {
	  onlySet0 _ simpleChars _ FALSE;
	  curSet _ set;
	  {scan.char _ 377C; AppendToToken[scan]};
	  {scan.char _ set; AppendToToken[scan]}};
	scan.char _ char;
	SELECT scan.char FROM
	  '=, '> => simpleChars _ FALSE;
	  IN [40C..176C] => NULL;
	  ENDCASE => simpleChars _ FALSE;
	AppendToToken[scan];
	ENDLOOP};
    Number: PROCEDURE [neg: BOOLEAN] = {
      haveDot, haveE, okMinus: BOOLEAN _ FALSE;
      scan.token.length _ 0;
      IF neg THEN String.AppendChar[scan.token, '-];
      DO
        SELECT scan.char FROM
          IN ['0..'9] => {okMinus _ FALSE; AppendToToken[scan]};
          '. => {
	    IF haveDot THEN EXIT;
	    haveDot _ TRUE;
	    okMinus _ FALSE;
	    AppendToToken[scan]};
          'E => {
	    IF ~haveDot OR haveE THEN EXIT;
	    haveE _ TRUE;
	    okMinus _ TRUE;
	    AppendToToken[scan]};
          '- => {IF ~okMinus THEN EXIT; okMinus _ FALSE; AppendToToken[scan]};
	  ENDCASE => EXIT;
	NextChar[scan];
	ENDLOOP;
      SELECT TRUE FROM
        haveDot => t.body _ real[Real.StringToReal[scan.token]];
	~haveDot => t.body _ integer[String.StringToLongNumber[scan.token]];
	ENDCASE => ERROR};
    onlySet0, simpleChars: BOOLEAN;
    curSet: CHARACTER;
	
    SELECT scan.state FROM
      start => {scan.state _ version; RETURN[[body: start[]]]};
      version => {NextChar[scan]; scan.state _ token; RETURN[VersionID[scan]]};
      stop => RETURN[[pos: scan.index, body: stop[]]];
      ENDCASE => NULL;  -- fall through and do normal stuff
    DO
      BEGIN
      t.pos _ scan.index;
      SELECT scan.char FROM
        Ascii.NUL => {scan.state _ stop; RETURN[[pos: scan.index, body: stop[]]]};
	
        Ascii.SP, ', => GOTO tryAgain;
	
        '$ => {t.body _ dollar[]; GOTO almostDone};
        '' => {t.body _ quote[]; GOTO almostDone};
        '_ => {t.body _ leftArrow[]; GOTO almostDone};
        '% => {t.body _ percent[]; GOTO almostDone};
        '| => {t.body _ bar[]; GOTO almostDone};
        '* => {t.body _ times[]; GOTO almostDone};
        '/ => {t.body _ divide[]; GOTO almostDone};
        '+ => {t.body _ plus[]; GOTO almostDone};
        '^ => {t.body _ upArrow[]; GOTO almostDone};
        '[ => {t.body _ leftBracket[]; GOTO almostDone};
        '] => {t.body _ rightBracket[]; GOTO almostDone};
        '{ => {t.body _ leftBrace[]; GOTO almostDone};
        '} => {t.body _ rightBrace[]; GOTO almostDone};
        '( => {t.body _ leftParen[]; GOTO almostDone};
        ') => {t.body _ rightParen[]; GOTO almostDone};
        '. => {t.body _ dot[]; GOTO almostDone};
        '? => {t.body _ question[]; GOTO almostDone};
	
        ': => {  -- colonEqual
	  NextChar[scan];
	  IF scan.char # '= THEN t.body _ colon[]
	  ELSE t.body _ colonEqual[];
	  GOTO almostDone};
	
        '- => {  -- minus or comment or negative integer
	  NextChar[scan];
	  SELECT scan.char FROM
	    '- => { -- eat the comment
	      DO
	        NextChar[scan];
	        IF scan.char = '- THEN {
		  NextChar[scan]; IF scan.char = '- THEN EXIT};
	        ENDLOOP;
	      GOTO tryAgain};
	    IN ['0..'9], '. => {Number[TRUE]; GOTO done};
	    ENDCASE => {t.body _ minus[]; GOTO done}};
	
	'< =>  { -- string
	  temp: LONG STRING;
	  onlySet0 _ simpleChars _ TRUE;
	  curSet _ 0C;
	  scan.token.length _ 0;
	  DO
	    NextChar[scan];
	    SELECT scan.char FROM
	      '> => EXIT;
	      '= => {
		IntSequence[];
		SELECT scan.char FROM
		  '> => EXIT;
		  '= => NULL;
		  ENDCASE => ERROR ScriptParse.Error[scan, scan.index]};
	      ENDCASE => {
	        IF curSet # 0C THEN {
		  save: CHARACTER _ scan.char;
		  {scan.char _ 377C; AppendToToken[scan]};
		  {scan.char _ 0C; AppendToToken[scan]};
		  scan.char _ save};
		IF scan.char ~IN [40C..176C] THEN simpleChars _ FALSE;
		AppendToToken[scan]};
	    ENDLOOP;
	  temp _ scan.z.NEW[StringBody[scan.token.length]];
	  String.AppendString[temp, scan.token];
	  t.body _ string[
	    [allSet0: onlySet0, allSimple: simpleChars, string: temp]];
	  GOTO almostDone};
	    
	'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm,
        'n, 'o, 'p, 'q, 'r, 's, 't, 'u, 'v, 'w, 'x, 'u, 'z,
	'A, 'B, 'C, 'D, 'E, 'F, 'G, 'H, 'I, 'J, 'K, 'L, 'M,
	'N, 'O, 'P, 'Q, 'R, 'S, 'T, 'U, 'V, 'W, 'X, 'Y, 'Z =>  { -- id or universal
	  allCaps: BOOLEAN _ scan.char IN ['A..'Z];
	  scan.token.length _ 0;
	  AppendToToken[scan];
	  DO
	    NextChar[scan];
	    SELECT scan.char FROM
	      IN ['a..'z] => {AppendToToken[scan]; allCaps _ FALSE};
	      IN ['0..'9], IN ['A..'Z] => AppendToToken[scan];
	      ENDCASE => EXIT;
	    ENDLOOP;
	  IF allCaps THEN {
	    hash: ScriptHash.Hash = scan.univ.Enter[scan.token, nullVal];
	    SELECT hash FROM
	      scan.endScript => t.body _ stop[];
	      scan.true => t.body _ boolean[TRUE];
	      scan.false => t.body _ boolean[FALSE];
	      scan.links => t.body _ links[];
	      ENDCASE => t.body _ universal[hash]}
	  ELSE t.body _ id[scan.id.Enter[scan.token, nullVal]];
	  GOTO done};
	    
	'0, '1, '2, '3, '4, '5, '6, '7, '8, '9  => {  -- number
	  Number[FALSE];
	  GO TO done};
	  
	 ENDCASE => ERROR ScriptParse.Error[scan, scan.index];
	
      EXITS
        almostDone => {NextChar[scan]; EXIT};
        done => EXIT;
	tryAgain => {NextChar[scan]};
      END
      ENDLOOP};
  
  VersionID: PROCEDURE [scan: ScanHandle] RETURNS [t: ScriptParse.Terminal] = {
    match: STRING = "Interscript/Reference/83 "L;
    FOR i: CARDINAL IN [0..match.length) DO
      IF scan.char # match[i] THEN ERROR ScriptParse.Error[scan, i];
      NextChar[scan];
      ENDLOOP;
    scan.index _ match.length;
    RETURN[[body: versionId[]]]};
  
  InitScan: PUBLIC PROCEDURE [
    stream: Stream.Handle, univ, id: ScriptHash.Handle, z: UNCOUNTED ZONE]
    RETURNS [scan: ScanHandle] = {
    scan _ z.NEW[ScanObject _ [
      z: z, univ: univ, id: id, stream: stream,
      endScript: univ.Enter["ENDSCRIPT"L, nullVal],
      links: univ.Enter["LINKS"L, nullVal],
      true: univ.Enter["T"L, nullVal],
      false: univ.Enter["F"L, nullVal],
      token: z.NEW[StringBody[40]] ]]};
  
  FinishScan: PUBLIC PROCEDURE [scan: ScanHandle] = {
    z: UNCOUNTED ZONE = scan.z;
    z.FREE[@scan.token];
    z.FREE[@scan]};
  
  }. -- of ScriptScanImpl