-- BasicParser.mesa
-- edited by Brotz and Hilton, September 23, 1982  5:13 PM

DIRECTORY
  BasicDefs,
  BasicImpDefs,
  BasicOps,
  Inline,
  Storage,
  String;

BasicParser:  PROGRAM

IMPORTS BasicImpDefs, Inline, Storage, String
EXPORTS BasicImpDefs =

BEGIN
OPEN BasicDefs, BasicImpDefs;


ArithmeticExpression: PROCEDURE =
BEGIN
op: CHARACTER;
Term[];
IF haveToken THEN
  WHILE token[0] = '+ OR token[0] = '- DO
    op _ token[0];
    IF GetToken[] THEN
      BEGIN
      Term[];
      SELECT op FROM
        '+ => AppendByte[lineCodeCm, BasicOps.Add];
        '-  => AppendByte[lineCodeCm, BasicOps.Sub];
        ENDCASE;
      END
    ELSE ParseError["Missing term in arithmetic expression."L];
    ENDLOOP;
END;  -- of ArithmeticExpression --


Expression: PUBLIC PROCEDURE =
-- Expression is the first procedure of a recursive descent expression
--   parser.  It in turn calls procedures which parse the expression into
--   'Relation', 'ArithmeticExpression', 'Term', 'Factor' and 'Primary'. 
BEGIN
op: CHARACTER;
Relation[];
IF haveToken THEN
  WHILE token[0] = '& OR token[0] = '| DO
    op _ token[0];
    IF GetToken[] THEN
      BEGIN
      Relation[];
      SELECT op FROM
        '& => AppendByte[lineCodeCm, BasicOps.And];
        '| => AppendByte[lineCodeCm, BasicOps.Or];
        ENDCASE;
      END
    ELSE ParseError["Missing relation in logical expression."L];
    ENDLOOP;
END;  -- of Expression --


Factor: PROCEDURE =
BEGIN
Primary[];
IF haveToken THEN
  WHILE token[0] = '^ DO
    IF GetToken[] THEN
      BEGIN
      Primary[];
      AppendByte[lineCodeCm, BasicOps.Exp];
      END
    ELSE ParseError["Missing exponent."L];
    ENDLOOP;
END;  -- of Factor --


ParseConstant: PUBLIC PROCEDURE RETURNS [value: BasicValue] =
BEGIN
SELECT token[0] FROM
  IN ['0 .. '9] =>
    BEGIN
    integerPart: STRING _ [40];
    String.AppendString[integerPart, token];
    IF GetToken[] AND token[0] = '. THEN
      value _ BasicValue[real, real[realValue: GetRealNumber[integerPart]]]
    ELSE value _ BasicValue
      [integer, integer[integerValue: String.StringToLongNumber[integerPart, 10]]];
    END;
  '. => value _ BasicValue[real, real[realValue: GetRealNumber["0"L]]];
  '" =>
    BEGIN
    string: STRING _ ScanQuotedString[];
    value _ BasicValue[string, string[stringValue: string]];
    [] _ GetToken[];
    END;
  '+ =>
    IF GetToken[] THEN value _ ParseConstant[] ELSE ParseError["Missing constant!"L];
  '- =>
    IF GetToken[] THEN
      BEGIN
      value _ ParseConstant[];
      SELECT value.type FROM
        integer => value.integerValue _ -value.integerValue;
        real => value.realValue _ -value.realValue;
        ENDCASE => ParseError["Unary minus of non-numeric value!"L];
      END
    ELSE ParseError["Missing constant!"L];
  ENDCASE => ParseError["Illegal constant!"L];
END;  -- of ParseConstant --


Primary: PROCEDURE =
BEGIN
varPtr: VariablePtr;
value: BasicValue;
nIndices: CARDINAL _ 0;
SELECT TRUE FROM
  charTablePtr[token[0]] = letter =>
    BEGIN
    IF IsReservedWord[token] THEN ParseError["Missing Primary"L];
    varPtr _ LookUpVariable[token];
    [] _ GetToken[];
    WITH var: varPtr SELECT FROM
      numeric =>
        BEGIN
        IF haveToken AND token[0] = '( THEN
          {nIndices _ ParseSubscripts[]; [] _ GetToken[]};
        SELECT nIndices FROM
          0 => AppendByte[lineCodeCm, BasicOps.PushVal];
          1 => AppendByte[lineCodeCm, BasicOps.Arr1Push];
          2 => AppendByte[lineCodeCm, BasicOps.Arr2Push];
          ENDCASE;
        AppendPointer[lineCodeCm, varPtr];
        END;
      string =>
        BEGIN
        IF haveToken AND token[0] = '[ THEN
          {nIndices _ ParseSubscripts[]; [] _ GetToken[]};
        SELECT nIndices FROM
          0 => AppendByte[lineCodeCm, BasicOps.PushVal];
          1 => AppendByte[lineCodeCm, BasicOps.Str1Push];
          2 => AppendByte[lineCodeCm, BasicOps.Str2Push];
          ENDCASE;
        AppendPointer[lineCodeCm, varPtr];
        END;
      builtInFunction =>
        BEGIN
        IF haveToken AND token[0] = '( THEN
          BEGIN
          IF GetToken[] THEN Expression[] ELSE ParseError["Missing parameter!"L];
          IF haveToken THEN
            SELECT token[0] FROM
              ', =>
                BEGIN
                IF GetToken[] THEN Expression[] ELSE ParseError["Missing parameter!"L];
                IF ~haveToken OR token[0] # ') THEN ParseError["Missing )!"L];
                [] _ GetToken[];
                END;
              ') =>
                BEGIN
                AppendByte[lineCodeCm, BasicOps.PushI];
                AppendByte[lineCodeCm, 0];
                [] _ GetToken[];
                END;
              ENDCASE => ParseError["Illegal parameter terminator!"L]
          ELSE ParseError["Missing )!"L];
          END
        ELSE BEGIN
          AppendByte[lineCodeCm, BasicOps.PushI];
          AppendByte[lineCodeCm, 0];
          AppendByte[lineCodeCm, BasicOps.PushI];
          AppendByte[lineCodeCm, 0];
          END;
        AppendByte[lineCodeCm, BasicOps.CallBuiltInFn];
        AppendPointer[lineCodeCm, varPtr];
        END;
      userFunction =>
        BEGIN
        IF haveToken AND token[0] = '( THEN
          BEGIN
          IF GetToken[] THEN Expression[] ELSE ParseError["Missing parameter!"L];
          IF ~haveToken OR token[0] # ') THEN ParseError["Missing )!"L];
          [] _ GetToken[];
          END
        ELSE BEGIN
          AppendByte[lineCodeCm, BasicOps.PushI];
          AppendByte[lineCodeCm, 0];
          END;
        AppendByte[lineCodeCm, BasicOps.CallUserFn];
        AppendPointer[lineCodeCm, varPtr];
        END;
      ENDCASE => ParseError["Complex primary not implemented"L];
    END;
  token[0] IN ['0 .. '9] =>
    BEGIN
    value _ ParseConstant[];
    IF value.type = integer AND value.integerValue IN [0 .. 255] THEN
      BEGIN
      AppendByte[lineCodeCm, BasicOps.PushI];
      AppendByte[lineCodeCm, Inline.LowHalf[value.integerValue]];
      END
    ELSE BEGIN
      AppendByte[lineCodeCm, BasicOps.PushVal];
      AppendPointer[lineCodeCm, AllocateConstant[value]];
      END;
    END;
  token[0] = '. =>
    BEGIN
    value _ ParseConstant[];
    AppendByte[lineCodeCm, BasicOps.PushVal];
    AppendPointer[lineCodeCm, AllocateConstant[value]];
    END;
  token[0] = '" =>
    BEGIN
    value _ ParseConstant[];
    AppendByte[lineCodeCm, BasicOps.PushVal];
    AppendPointer[lineCodeCm, AllocateConstant[value]];
    Storage.FreeString[value.stringValue];
    END;
  token[0] = '+ =>
    IF GetToken[] THEN Primary[] ELSE ParseError["Missing Primary"L];
  token[0] = '- =>
    IF GetToken[] THEN {Primary[]; AppendByte[lineCodeCm, BasicOps.UnaryMinus]}
    ELSE ParseError["Missing Primary"L];
  token[0] = '~ =>
    IF GetToken[] THEN {Primary[]; AppendByte[lineCodeCm, BasicOps.Not]}
    ELSE ParseError["Missing Primary"L];
  token[0] = '( =>
    BEGIN
    IF GetToken[] AND token[0] ~= ') THEN Expression[]
    ELSE IF token[0] = ') THEN
      ParseError["Missing argument in parenthesis."];
    IF ~haveToken OR token[0] ~= ') THEN ParseError["Missing matching )."L];
    [] _ GetToken[];
    END;
  ENDCASE  => ParseError["Illegal primary."L];
END;  -- of Primary --


Relation: PROCEDURE =
BEGIN
op: {lt, le, eq, ne, ge, gt};
ArithmeticExpression[];
IF haveToken THEN
  BEGIN
  SELECT token[0] FROM
    '<  =>
      BEGIN
      IF GetToken[] THEN
        SELECT token[0] FROM
          '=  =>  {op _ le; [] _ GetToken[];};
          '>  =>  {op _ ne; [] _ GetToken[];};
          ENDCASE  =>  op _ lt
      ELSE ParseError["Missing relation term."L];
      END;
    '=  =>  {op _ eq; [] _ GetToken[]};
    '>  =>
      BEGIN
      IF GetToken[] THEN
        SELECT token[0] FROM
          '=  =>  {op _ ge; [] _ GetToken[];};
          ENDCASE  =>  op _ gt
      ELSE ParseError["Missing relation term."L];
      END;
    ENDCASE => RETURN;
  IF haveToken THEN
    BEGIN
    ArithmeticExpression[];
    AppendByte[lineCodeCm, SELECT op FROM
      lt  => BasicOps.Lesser,
      le  => BasicOps.LE,
      eq  => BasicOps.Equal,
      ne  => BasicOps.NE,
      ge  => BasicOps.GE,
      gt  => BasicOps.Greater,
      ENDCASE => ERROR];
    END
  ELSE ParseError["Missing relation term."L];
  END;
END;  -- of Relation --


Term:  PROCEDURE =
BEGIN
op: CHARACTER;
Factor[];
IF haveToken THEN
  WHILE token[0] = '* OR token[0] = '/ DO
    op _ token[0];
    IF GetToken[] THEN
      BEGIN
      Factor[];
      SELECT op FROM
        '* => AppendByte[lineCodeCm, BasicOps.Mul];
        '/ => AppendByte[lineCodeCm, BasicOps.Div];
        ENDCASE;
      END
    ELSE ParseError["Missing a factor or divisor."L];
    ENDLOOP;
END;  -- of Term --


END.  -- of BasicParser -- 
(1792)\f1