(* Copyright (C) 1989, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: ExprParse.m3                                          *)
(* Last Modified On Tue Apr 10 22:42:11 1990 By muller         *)
(*      Modified On Sat Feb 10 20:18:30 1990 By kalsow         *)


MODULE ExprParse;

IMPORT Token, Expr, Error, String, Type, Value, CHar, ObjectType;
IMPORT AndExpr, OrExpr, EqualExpr, CompareExpr, MultiplyExpr, DivExpr;
IMPORT DivideExpr, ModExpr, AddExpr, SubtractExpr, InExpr, PlusExpr;
IMPORT NegateExpr, NotExpr, ConcatExpr, IntegerExpr, RealExpr, LongrealExpr;
IMPORT TextExpr, DerefExpr, QualifyExpr, SubscriptExpr, TypeExpr;
IMPORT CallExpr, ConsExpr, RangeExpr, NamedExpr, KeywordExpr, EnumExpr;
FROM Scanner IMPORT Match, MatchID, GetToken, Fail, cur;

CONST
  MaxArgs = 300;

TYPE
  TK = Token.T;

PROCEDURE E0 (fail: Token.Set): Expr.T =
  VAR a: Expr.T;
  BEGIN
    fail := fail + Token.Set{TK.tOR};
    a := E1 (fail);
    WHILE (cur.token = TK.tOR) DO
      GetToken (); (* OR *)
      a := OrExpr.New (a, E1 (fail));
    END;
    RETURN a;
  END E0;

PROCEDURE E1 (fail: Token.Set): Expr.T =
  VAR a: Expr.T;
  BEGIN
    fail := fail + Token.Set{TK.tAND};
    a := E2 (fail);
    WHILE (cur.token = TK.tAND) DO
      GetToken (); (* AND *)
      a := AndExpr.New (a, E2 (fail));
    END;
    RETURN a;
  END E1;

PROCEDURE E2 (READONLY fail: Token.Set): Expr.T =
  VAR a: Expr.T;  n: INTEGER;
  BEGIN
    n := 0;
    WHILE (cur.token = TK.tNOT) DO
      GetToken (); (* NOT *)
      INC (n);
    END;
    a := E3 (fail);
    IF (n > 0) THEN
      a := NotExpr.New (a);
      IF ((n MOD 2) = 0) THEN a := NotExpr.New (a) END;
    END;
    RETURN a;
  END E2;

PROCEDURE E3 (READONLY fail: Token.Set): Expr.T =
  CONST RelOps = Token.Set {TK.tEQUAL, TK.tSHARP, TK.tLESS, TK.tLSEQUAL,
                            TK.tGREATER, TK.tGREQUAL, TK.tIN};
  VAR a, b: Expr.T;  t: Token.T;  fail2: Token.Set;
  BEGIN
    fail2 := fail + RelOps;
    a := E4 (fail2);
    WHILE (cur.token IN RelOps) DO
      t := cur.token;
      GetToken ();
      b := E4 (fail2);
      CASE t OF
      | TK.tEQUAL   => a := EqualExpr.NewEQ (a, b);
      | TK.tSHARP   => a := EqualExpr.NewNE (a, b);
      | TK.tLESS    => a := CompareExpr.NewLT (a, b);
      | TK.tLSEQUAL => a := CompareExpr.NewLE (a, b);
      | TK.tGREATER => a := CompareExpr.NewGT (a, b);
      | TK.tGREQUAL => a := CompareExpr.NewGE (a, b);
      | TK.tIN      => a := InExpr.New (a, b);
      ELSE             <*ASSERT FALSE*>
      END;
    END;
    RETURN a;
  END E3;

PROCEDURE E4 (READONLY fail: Token.Set): Expr.T =
  CONST AddOps = Token.Set {TK.tPLUS, TK.tMINUS, TK.tAMPERSAND};
  VAR a, b: Expr.T;  t: Token.T;  fail2: Token.Set;
  BEGIN
    fail2 := fail + AddOps;
    a := E5 (fail2);
    WHILE (cur.token IN AddOps) DO
      t := cur.token;
      GetToken ();
      b := E5 (fail2);
      CASE t OF
      | TK.tPLUS      => a := AddExpr.New (a, b);
      | TK.tMINUS     => a := SubtractExpr.New (a, b);
      | TK.tAMPERSAND => a := ConcatExpr.New (a, b);
      ELSE               <*ASSERT FALSE*>
      END;
    END;
    RETURN a;
  END E4;

PROCEDURE E5 (READONLY fail: Token.Set): Expr.T =
  CONST MulOps = Token.Set {TK.tASTERISK, TK.tSLASH, TK.tDIV, TK.tMOD};
  VAR a, b: Expr.T;  t: Token.T;  fail2: Token.Set;
  BEGIN
    fail2 := fail + MulOps;
    a := E6 (fail2);
    WHILE (cur.token IN MulOps) DO
      t := cur.token;
      GetToken ();
      b := E6 (fail2);
      CASE t OF
      | TK.tASTERISK => a := MultiplyExpr.New (a, b);
      | TK.tSLASH    => a := DivideExpr.New (a, b);
      | TK.tDIV      => a := DivExpr.New (a, b);
      | TK.tMOD      => a := ModExpr.New (a, b);
      ELSE              <*ASSERT FALSE*>
      END;
    END;
    RETURN a;
  END E5;

CONST
  SelectStart = Token.Set {TK.tARROW, TK.tDOT, TK.tLBRACKET, TK.tLPAREN,
                           TK.tLBRACE, TK.tBRANDED, TK.tOBJECT};

PROCEDURE E6 (READONLY fail: Token.Set): Expr.T =
  VAR a: Expr.T;  p, m: INTEGER;  fail2: Token.Set;
  BEGIN
    p := 0;
    m := 0;
    LOOP
      IF    (cur.token = TK.tPLUS)  THEN  GetToken (); INC (p);
      ELSIF (cur.token = TK.tMINUS) THEN  GetToken (); INC (m);
      ELSE  EXIT;
      END;
    END;
    fail2 := fail + SelectStart;
    a := EPrimary (fail2);
    WHILE (cur.token IN SelectStart) DO a := ESelector (a, fail2) END;
    IF (p + m > 0) THEN
      IF ((m MOD 2) = 1)
        THEN a := NegateExpr.New (a);
        ELSE a := PlusExpr.New (a); (* get the typechecking *)
      END;
    END;
    RETURN a;
  END E6;

PROCEDURE EPrimary (READONLY fail: Token.Set): Expr.T =
  VAR a: Expr.T;
  BEGIN
    CASE cur.token OF
    | TK.tIDENT         => a := NamedExpr.New (cur.string);        GetToken ();
    | TK.tCARDCONST     => a := IntegerExpr.New (cur.value);       GetToken ();
    | TK.tCHARCONST     => a := EnumExpr.New (CHar.T, cur.value);  GetToken ();
    | TK.tREALCONST     => a := RealExpr.NewS (cur.string);        GetToken ();
    | TK.tLONGREALCONST => a := LongrealExpr.NewS (cur.string);    GetToken ();
    | TK.tTEXTCONST     => a := TextExpr.New (cur.string);         GetToken ();

    | TK.tLPAREN =>
        GetToken ();
        a := E0 (fail + Token.Set {TK.tRPAREN});
        Match (TK.tRPAREN, fail, Token.Set {});

    | TK.tARRAY, TK.tBITS, TK.tBRANDED, TK.tLBRACE, TK.tUNTRACED,
      TK.tOBJECT, TK.tPROCEDURE, TK.tRECORD, TK.tREF, TK.tSET, TK.tLBRACKET =>
        a := TypeExpr.New (Type.Parse (fail));

    ELSE
        Fail ("bad expression", fail); a := IntegerExpr.New (0);
    END;
    RETURN a;
  END EPrimary;

PROCEDURE ESelector (a: Expr.T;  READONLY fail: Token.Set): Expr.T =
  VAR
    i: INTEGER;
    args: ARRAY [0..MaxArgs] OF Expr.T;
    argList: Expr.List;
    t: Type.T;
    open: BOOLEAN;
  BEGIN
    CASE cur.token OF
    | TK.tARROW =>
        GetToken (); (* ^ *)
        a := DerefExpr.New (a);
    | TK.tDOT =>
        GetToken (); (* . *)
        a := QualifyExpr.New (a, MatchID (fail, SelectStart));
    | TK.tLBRACKET =>
        GetToken (); (* [ *)
        LOOP
          a := SubscriptExpr.New (a,
                E0 (fail + Token.Set {TK.tRBRACKET, TK.tCOMMA}));
          IF (cur.token # TK.tCOMMA) THEN EXIT END;
          GetToken (); (* , *)
        END;
        Match (TK.tRBRACKET, fail, Token.Set {});
    | TK.tLPAREN =>
        GetToken (); (* ( *)
        i := 0;
        IF (cur.token # TK.tRPAREN) THEN
          LOOP
            args[i] := EActual (fail + Token.Set {TK.tRPAREN, TK.tCOMMA});
            INC (i);
            IF (cur.token # TK.tCOMMA) THEN EXIT END;
            GetToken (); (* , *)
          END;
        END;
        Match (TK.tRPAREN, fail, Token.Set {});
        argList := NEW (Expr.List, i);
        FOR j := 0 TO i - 1 DO argList[j] := args[j] END;
        a := CallExpr.New (a, argList);
    | TK.tLBRACE =>
        GetToken (); (* { *)
        i := 0;
	open := FALSE;
        IF (cur.token # TK.tRBRACE) THEN
          LOOP
	    IF (cur.token = TK.tDOTDOT) THEN
	      (* must be the end of an array constructor *)
	      IF (i = 0) THEN Error.Msg("array constructor has no values") END;
	      open := TRUE;
	      GetToken (); (* .. *)
	      EXIT;
	    END;
            args[i] := EConstructor (fail + Token.Set {TK.tRBRACE, TK.tCOMMA});
            INC (i);
            IF (cur.token # TK.tCOMMA) THEN EXIT END;
            GetToken (); (* , *)
          END;
        END;
        Match (TK.tRBRACE, fail, Token.Set {});
        argList := NEW (Expr.List, i);
        FOR j := 0 TO i - 1 DO argList[j] := args[j] END;
        a := ConsExpr.New (a, argList, open);
    | TK.tBRANDED, TK.tOBJECT =>
        t := Type.Parse (fail);
        ObjectType.SetSuper (t, a);
        a := TypeExpr.New (t);
    ELSE Fail ("bad selector", fail);
    END;
    RETURN a;
  END ESelector;

PROCEDURE EActual (READONLY fail: Token.Set): Expr.T =
  VAR a: Expr.T;  name: String.T;  obj: Value.T;
  BEGIN
    a := E0 (fail + Token.Set {TK.tASSIGN});
    IF (cur.token = TK.tASSIGN) THEN
      GetToken (); (* := *)
      IF NamedExpr.Split (a, name, obj)
        THEN a := KeywordExpr.New (name, E0 (fail));
        ELSE Error.Msg ("syntax error: expected \'keyword := value\'");
      END;
    END;
    RETURN a;
  END EActual;

PROCEDURE EConstructor (READONLY fail: Token.Set): Expr.T =
  VAR a: Expr.T;  name: String.T;  obj: Value.T;
  BEGIN
    a := E0 (fail + Token.Set {TK.tDOTDOT, TK.tASSIGN});
    IF (cur.token = TK.tDOTDOT) THEN
      GetToken (); (* .. *)
      a := RangeExpr.New (a, E0 (fail));
    ELSIF (cur.token = TK.tASSIGN) THEN
      GetToken (); (* := *)
      IF NamedExpr.Split (a, name, obj)
        THEN a := KeywordExpr.New (name, E0 (fail));
        ELSE Error.Msg ("syntax error: expected \'keyword := value\'");
      END;
    END;
    RETURN a;
  END EConstructor;

BEGIN
END ExprParse.