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

(* File: Expr.m3                                               *)
(* Last Modified On Tue Jun 30 11:53:03 PDT 1992 By kalsow     *)
(*      Modified On Fri Dec 21 01:21:51 1990 By muller         *)

MODULE Expr EXPORTS Expr, ExprRep;

IMPORT Type, Void, MBuf, Token, Scanner, Temp, M3, ExprParse;

(********************************************************************)

PROCEDURE Parse (READONLY fail: Token.Set): T =
  BEGIN
    RETURN ExprParse.E0 (FALSE, fail);
  END Parse;

PROCEDURE Init (t: T) =
  BEGIN
    t.origin  := Scanner.offset;
    t.type    := NIL;
    t.checked := FALSE;
  END Init;

(********************************************************************)

PROCEDURE TypeOf (t: T): Type.T =
  BEGIN
    IF (t = NIL) THEN RETURN Void.T END;
    IF (t.type = NIL) THEN t.type := t.typeOf () END;
    RETURN t.type;
  END TypeOf;

PROCEDURE TypeCheck (t: T;  VAR cs: CheckState) =
  VAR save: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN END;
    IF (t.checked) THEN RETURN END;
    save := Scanner.offset;
    Scanner.offset := t.origin;
    t.check (cs);
    Scanner.offset := save;
    t.checked := TRUE;
  END TypeCheck;

(********************************************************************)

PROCEDURE ConstValue (t: T): T =
  VAR new: T;  cs: CheckState;
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    (*** <* ASSERT t.checked *> ***)
    new := t.evaluate ();
    IF (new # t) THEN
      cs := M3.OuterCheckState; (* OK since constants don't raise exceptions *)
      TypeCheck (new, cs);
    END;
    RETURN new;
  END ConstValue;

PROCEDURE GetBounds (t: T; VAR min, max: INTEGER) =
  BEGIN
    IF (t = NIL) THEN min := 0; max :=  -1; RETURN END;
    <* ASSERT t.checked *>
    t.getBounds (min, max);
  END GetBounds;

PROCEDURE IsDesignator (t: T): BOOLEAN =
  BEGIN
    IF (t = NIL) THEN RETURN TRUE END;
    <* ASSERT t.checked *>
    RETURN t.isDesignator ();
  END IsDesignator;

PROCEDURE IsWritable (t: T): BOOLEAN =
  BEGIN
    IF (t = NIL) THEN RETURN TRUE END;
    <* ASSERT t.checked *>
    RETURN t.isWritable ()
  END IsWritable;

PROCEDURE IsZeroes (t: T): BOOLEAN =
  BEGIN
    IF (t = NIL) THEN RETURN TRUE END;
    <* ASSERT t.checked *>
    RETURN t.isZeroes ()
  END IsZeroes;

(********************************************************************)

PROCEDURE Fingerprint (t: T;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    MBuf.PutText (wr, "(");
    IF (t # NIL) THEN
      <* ASSERT t.checked *>
      t.fprint (map, wr);
    END;
    MBuf.PutText (wr, ")");
  END Fingerprint;

(********************************************************************)

PROCEDURE Compile (t: T): Temp.T =
  VAR tmp: Temp.T;
  BEGIN
    IF (t = NIL) THEN RETURN Temp.FromExpr (NIL) END;
    <* ASSERT t.checked *>
    IF NOT Temp.LookUp (t, FALSE, tmp) THEN
      (*** Type.Compile (t.type); ***)
      tmp := t.compile ();
    END;
    RETURN tmp;
  END Compile;

PROCEDURE CompileLValue (t: T): Temp.T =
  VAR tmp: Temp.T;
  BEGIN
    IF (t = NIL) THEN RETURN Temp.FromExpr (NIL) END;
    <* ASSERT t.checked *>
    IF NOT Temp.LookUp (t, TRUE, tmp) THEN
      Type.Compile (t.type);
      tmp := t.compile ();
      <* ASSERT Temp.IsLValue (tmp) *>
    END;
    RETURN tmp;
  END CompileLValue;

PROCEDURE NoteWrite (t: T) =
  BEGIN
    IF (t = NIL) THEN RETURN END;
    t.note_write ();
  END NoteWrite;

PROCEDURE Write (t: T;  t1, t2: Temp.T) =
  BEGIN
    t.write (t1, t2);
  END Write;

PROCEDURE IsEqual (a, b: T): BOOLEAN =
  BEGIN
    IF (a = b) THEN RETURN TRUE END;
    IF (a = NIL) OR (b = NIL) THEN RETURN FALSE END;
    RETURN a.isEqual (b);
  END IsEqual;

PROCEDURE GenLiteral (t: T) =
  BEGIN
    IF (t = NIL) THEN RETURN END;
    <* ASSERT t.checked *>
    Type.Compile (t.type);
    t.genLiteral ();
  END GenLiteral;

(******************** default methods ************************************)

PROCEDURE NoType (<*UNUSED*> t: T): Type.T =
  BEGIN
    <* ASSERT FALSE *>
  END NoType;

PROCEDURE NoCheck (<*UNUSED*> t: T;  <*UNUSED*> VAR cs: CheckState) =
  BEGIN
  END NoCheck;

PROCEDURE NoValue (<*UNUSED*> t: T): T =
  BEGIN
    RETURN NIL;
  END NoValue;

PROCEDURE Self (t: T): T =
  BEGIN
    RETURN t;
  END Self;

PROCEDURE NoBounds (t: T; VAR min, max: INTEGER) =
  BEGIN
    EVAL Type.GetBounds (t.type, min, max);
  END NoBounds;

PROCEDURE IsNever (<*UNUSED*> t: T): BOOLEAN =
  BEGIN
    RETURN FALSE;
  END IsNever;

PROCEDURE IsAlways (<*UNUSED*> t: T): BOOLEAN =
  BEGIN
    RETURN TRUE;
  END IsAlways;

PROCEDURE NeverEq (<*UNUSED*> a, b: T): BOOLEAN =
  BEGIN
    RETURN FALSE;
  END NeverEq;

PROCEDURE NoWriter (<*UNUSED*> t: T;   <*UNUSED*> t1, t2: Temp.T) =
  BEGIN
    <* ASSERT FALSE *>
  END NoWriter;

PROCEDURE NoLiteral (<*UNUSED*> t: T) =
  BEGIN
    <* ASSERT FALSE *>
  END NoLiteral;

PROCEDURE NotWritable (<*UNUSED*> t: T) =
  BEGIN
    (* skip *)
  END NotWritable;

PROCEDURE EqCheckA (a: Ta;  e: T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL  => RETURN FALSE;
    | Ta(b) => RETURN (TYPECODE (a) = TYPECODE (e)) AND IsEqual (a.a, b.a);
    ELSE       RETURN FALSE;
    END;
  END EqCheckA;

PROCEDURE EqCheckAB (a: Tab;  e: T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL   => RETURN FALSE;
    | Tab(b) => RETURN (TYPECODE (a) = TYPECODE (b)) AND
                       IsEqual (a.a, b.a) AND IsEqual (a.b, b.b);
    ELSE        RETURN FALSE;
    END;
  END EqCheckAB;

BEGIN
END Expr.