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

(* File: QualifyExpr.m3                                        *)
(* Last modified on Fri Jun 29 22:26:39 1990 by muller         *)
(*      modified on Sat Feb 10 20:11:52 1990 by kalsow         *)




MODULE QualifyExpr;

IMPORT Expr, ExprRep, String, Value, ValueRep, Type, Module, Scope;
IMPORT RecordType, ObjectType, Field, Emit, Variable, VarExpr;
IMPORT EnumType, RefType, DerefExpr, Void, NamedExpr, Error, Null;
IMPORT Address, Int, ConsExpr, EnumElt, RecordExpr, TypeExpr, Wr;
IMPORT Method, NamedType, ProcExpr, Temp, NilChkExpr, OpaqueExpr;

TYPE
  Class = { cMODULE, cENUM, cOBJTYPE, cFIELD, cOBJFIELD, cMETHOD };

TYPE
  VC = Value.Class;

TYPE
  P = Expr.T OBJECT
        expr    : Expr.T;
        name    : String.T;
        obj     : Value.T;
        class   : Class;
        holder  : Type.T;
        opaque  : Type.T;
        objExpr : Expr.T;
	temp    : Temp.T;
      METHODS
        bind         := Bind;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := Writer;
        isEqual      := EqCheck;
        getBounds    := Bounder;
        isWritable   := IsWritable;
        isDesignator := IsDesignator;
	isZeroes     := ExprRep.IsNever;
	genLiteral   := ExprRep.NoLiteral;
      END;

PROCEDURE New (a: Expr.T;  id: String.T): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.expr    := a;
    p.name    := id;
    p.obj     := NIL;
    p.class   := Class.cMODULE;
    p.holder  := NIL;
    p.opaque  := NIL;
    p.objExpr := NIL;
    p.temp    := NIL;
    RETURN p;
  END New;

PROCEDURE Split (e: Expr.T;  VAR obj: Value.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(p) => obj := p.obj;  RETURN TRUE;
    ELSE      RETURN FALSE;
    END;
  END Split;

PROCEDURE PassObject (e: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => (* nothing *)
    | P(p) => IF (p.class = Class.cMETHOD) THEN
                Emit.OpT ("@", p.temp);
		RETURN TRUE;
              END;
    ELSE      (* nothing *)
    END;
    RETURN FALSE;
  END PassObject;

PROCEDURE Bind (p: P) =
  VAR
    t    : Type.T;
    s    : Scope.T;
    obj  : Value.T;
    name : String.T;
  BEGIN
    Expr.Bind (p.expr);
    t := Type.Base (Expr.TypeOf (p.expr));

    IF RefType.Is (t) THEN
      (* auto-magic dereference *)
      p.expr := DerefExpr.New (p.expr);
      Expr.Bind (p.expr);
      t := Type.Base (Expr.TypeOf (p.expr));
    END;

    p.holder := t;
    p.obj := NIL;

    IF ((t = NIL) OR (t = Void.T)) THEN
      (* a module or type *)
      IF TypeExpr.Split (p.expr, t) THEN
        IF EnumType.LookUp (t, p.name, p.obj) THEN
          p.class := Class.cENUM;
        ELSIF ObjectType.LookUp (t, p.name, p.obj, p.holder, p.opaque) THEN
          p.class := Class.cOBJTYPE;
        END;
      ELSIF NamedExpr.Split (p.expr, name, obj) THEN
        IF (Value.ClassOf (obj) = VC.Module) THEN
          p.class := Class.cMODULE;
          s := Module.ExportScope (obj);
          p.obj := Scope.LookUpInScope (s, p.name);
        END;
      END;

    ELSIF RecordType.LookUp (t, p.name, p.obj) THEN
      DerefExpr.SetOffset (p.expr, Type.Size (t));
      p.class := Class.cFIELD;

    ELSIF ObjectType.LookUp (t, p.name, p.obj, p.holder, p.opaque) THEN
      IF (Value.ClassOf (p.obj) = VC.Field) THEN
        p.expr := NilChkExpr.New (p.expr);
        NilChkExpr.SetOffset (p.expr, ObjectType.ObjectSize (t));
        p.class := Class.cOBJFIELD;
        p.expr := OpaqueExpr.NewDataOffset (p.expr, p.opaque);
      ELSE
        p.expr := NilChkExpr.New (p.expr);
        NilChkExpr.SetOffset (p.expr, 0);
        p.class := Class.cMETHOD;
        p.objExpr := p.expr; (* save the object for the call *)
        p.expr := OpaqueExpr.NewMethodOffset (p.expr, p.opaque);
      END;
      Expr.Bind (p.expr);
    END;

    IF (p.obj = NIL) THEN
      Error.Str (p.name, "unknown qualification \'.\'");
      p.obj := VarExpr.Obj (VarExpr.New (Int.T, p.name));
      p.class := Class.cMODULE;
    END;

    Value.Bind (p.obj);
    p.type := Value.TypeOf (p.obj);
  END Bind;

PROCEDURE Bounder (p: P;  VAR min, max: INTEGER) =
  BEGIN
    CASE Value.ClassOf (p.obj) OF
    | Value.Class.Expr => Expr.GetBounds (Value.ToExpr (p.obj), min, max);
    | Value.Class.Var  => Variable.GetBounds (p.obj, min, max);
    ELSE                  Type.GetBounds (p.type, min, max);
    END;
  END Bounder;

PROCEDURE Check (p: P) =
  BEGIN
    Expr.TypeCheck (p.expr);
    Value.TypeCheck (p.obj);
  END Check;

PROCEDURE EqCheck (a: P;  e: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(b) => RETURN (a.obj = b.obj)
                 AND (a.class = b.class)
                 AND Expr.IsEqual (a.expr, b.expr);
    ELSE      RETURN FALSE;
    END;
  END EqCheck;

PROCEDURE Compile (p: P): Temp.T =
  VAR t1, t2, t3: Temp.T;
  BEGIN
    CASE p.class OF
    | Class.cMODULE, Class.cENUM =>
        t1 := Value.Load (p.obj);
    | Class.cOBJTYPE =>
        t1 := Temp.AllocMacro (p);
    | Class.cFIELD =>
        t2 := Expr.Compile (p.expr);
        t1 := Temp.AllocMacro (p, TRUE);
	Temp.Depend (t1, t2);
    | Class.cOBJFIELD =>
        t2 := Expr.Compile (p.expr);
        t1 := Temp.AllocMacro (p, TRUE);
	Temp.Depend (t1, t2);
    | Class.cMETHOD =>
        t3 := Expr.Compile (p.objExpr);
        t2 := Expr.Compile (p.expr);
        t1 := Temp.Alloc (p);
        Emit.OpT ("@ = ", t1);
        Emit.OpIT ("((t@_methods*) (@+(", Type.Name (p.holder), t2);
        ObjectType.EmitOffsets (p.holder, p.opaque, TRUE);
        Emit.OpS (")))->_@;\n", p.name);
        Temp.Free (t2);   (* this free has to be after the compile above
                             so that the common subexpression is detected *)
	p.temp := t3;
	Temp.Depend (t1, t3);
    END;
    RETURN t1;
  END Compile;

PROCEDURE Writer (p: P;  t1: Temp.T;  <*UNUSED*> t2: Temp.T) =
  BEGIN
    CASE p.class OF
    | Class.cMODULE, Class.cENUM =>
        <* ASSERT FALSE *>
    | Class.cOBJTYPE =>
        Emit.OpI ("(((t@_methods*)", Type.Name (p.holder));
        Emit.OpI ("((t@_TC->defaultMethods) + (", Type.Name (p.holder));
        ObjectType.EmitOffsets (p.holder, p.opaque, TRUE);
        Emit.OpS (")))->_@)", p.name);
    | Class.cFIELD =>
        Emit.OpT ("(@", t1);
        Emit.OpS  ("._@)", p.name);
    | Class.cOBJFIELD =>
        Emit.OpI ("(((t@_fields*)", Type.Name (p.holder));
        Emit.OpT ("(@+(", t1);
        ObjectType.EmitOffsets (p.holder, p.opaque, FALSE);
        Emit.OpS (")))->_@)", p.name);
    | Class.cMETHOD =>
        <* ASSERT FALSE *>
    END;
  END Writer;

TYPE
  Kind = {Value, Expr, Type};
  LHS = RECORD
          kind  : Kind;
          value : Value.T;
          expr  : Expr.T;
          type  : Type.T;
        END;

PROCEDURE Fold (p: P): Expr.T =
  VAR lhs: LHS;  e: Expr.T;  t: Type.T;  v: Value.T;  b: BOOLEAN;  i: INTEGER;
  BEGIN
    (* evaluate the qualified expression *)
    lhs.kind := Kind.Expr;
    lhs.expr := p.expr;
    DoQualify (lhs, p.name);

    (* finally, simplify the result to an Expr.T if possible *)
    CASE lhs.kind OF
    | Kind.Expr =>
        RETURN Expr.ConstValue (lhs.expr);
    | Kind.Type =>
        RETURN TypeExpr.New (lhs.type);
    | Kind.Value =>
        CASE Value.ClassOf (lhs.value) OF
        | VC.Expr =>
            RETURN Expr.ConstValue (Value.ToExpr (lhs.value));
        | VC.Type =>
            RETURN TypeExpr.New (Value.ToType (lhs.value));
        | VC.Procedure =>
            RETURN ProcExpr.New (lhs.value);
            (* lhs.value is a procedure *)
        | VC.Field =>
            VAR b: BOOLEAN := Field.Split (lhs.value, i, t, e);
            BEGIN <* ASSERT b *> END;
            RETURN Expr.ConstValue (e);
        | VC.Method =>
            VAR bb: BOOLEAN := Method.Split (lhs.value, b, t, v);
            BEGIN <* ASSERT bb *> END;
            IF v = NIL THEN RETURN Null.Nil;
            ELSE            RETURN ProcExpr.New (v); 
            END;
            (* v = procedure that is default method *)
        ELSE (* not possible to convert to an expression *)
            RETURN NIL;
        END;
    END;
  END Fold;

PROCEDURE DoQualify (VAR lhs: LHS;  name: String.T) =
  VAR
    e: Expr.T;
    v: Value.T;
    i: INTEGER;
    b: BOOLEAN;
    p: P;
    s: Scope.T;
    t, t1, t2: Type.T;
    n: String.T;
  BEGIN
    CASE lhs.kind OF
    | Kind.Expr =>
        IF lhs.expr = NIL THEN
          (* do nothing *)
        ELSIF (TYPECODE (lhs.expr) = TYPECODE (P)) THEN
          p := lhs.expr;
          lhs.kind  := Kind.Expr;
          lhs.expr  := p.expr;
          DoQualify (lhs, p.name);
          DoQualify (lhs, name);
        ELSIF TypeExpr.Split (lhs.expr, t) THEN
          lhs.kind  := Kind.Type;
          lhs.type  := t;
          DoQualify (lhs, name);
        ELSIF NamedExpr.Split (lhs.expr, n, v) THEN
          lhs.kind  := Kind.Value;
          lhs.value := v;
          DoQualify (lhs, name);
        ELSIF RecordExpr.Qualify (lhs.expr, name, e) THEN
          lhs.kind  := Kind.Expr;
          lhs.expr  := e;
        ELSE
          lhs.kind  := Kind.Expr;
          lhs.expr  := Expr.ConstValue (lhs.expr);
          DoQualify (lhs, name);
        END;
    | Kind.Type =>
        t := NamedType.Strip (lhs.type);
        IF EnumType.LookUp (t, name, v) THEN
          lhs.kind  := Kind.Expr;
          lhs.expr  := Value.ToExpr (v);
        ELSIF ObjectType.LookUp (t, name, v, t1, t2) THEN
          lhs.kind  := Kind.Value;
          lhs.value := v;
        ELSIF RecordType.LookUp (t, name, v) THEN
          lhs.kind  := Kind.Value;
          lhs.value := v;
        ELSE (* type that can't be qualified *)
          lhs.kind  := Kind.Expr;
          lhs.expr  := NIL;
        END;
    | Kind.Value =>
        CASE Value.ClassOf (lhs.value) OF
        | VC.Expr =>
            lhs.kind  := Kind.Expr;
            lhs.expr  := Value.ToExpr (lhs.value);
            DoQualify (lhs, name);
        | VC.Type =>
            lhs.kind  := Kind.Type;
            lhs.type  := Value.ToType (lhs.value);
            DoQualify (lhs, name);
        | VC.Module =>
            s := Module.ExportScope (lhs.value);
            lhs.kind  := Kind.Value;
            lhs.value := Scope.LookUpInScope (s, name);
        | VC.Field =>
            VAR b: BOOLEAN := Field.Split (lhs.value, i, t, e);
            BEGIN <* ASSERT b *> END;
            lhs.kind  := Kind.Expr;
            lhs.expr  := e;
            DoQualify (lhs, name);
        | VC.Method =>
            VAR bb: BOOLEAN := Method.Split (lhs.value, b, t, v);
            BEGIN <* ASSERT bb *> END;
            lhs.kind  := Kind.Value;
            lhs.value := v;
            DoQualify (lhs, name);
        ELSE (* can't qualify this kind of value *)
            lhs.kind  := Kind.Expr;
            lhs.expr  := NIL;
        END;
    END;
  END DoQualify;

PROCEDURE IsDesignator (p: P): BOOLEAN =
  BEGIN
    CASE p.class OF
    | Class.cMODULE   => RETURN (Value.ClassOf (p.obj) = VC.Var);
    | Class.cENUM     => RETURN FALSE;
    | Class.cOBJTYPE  => RETURN FALSE;
    | Class.cFIELD    => RETURN Expr.IsDesignator (p.expr);
    | Class.cOBJFIELD => RETURN TRUE;
    | Class.cMETHOD   => RETURN FALSE;
    END;
  END IsDesignator;

PROCEDURE IsWritable (p: P): BOOLEAN =
  BEGIN
    CASE p.class OF
    | Class.cMODULE   => RETURN NOT p.obj.readonly;
    | Class.cENUM     => RETURN FALSE;
    | Class.cOBJTYPE  => RETURN FALSE;
    | Class.cFIELD    => RETURN Expr.IsWritable (p.expr);
    | Class.cOBJFIELD => RETURN TRUE;
    | Class.cMETHOD   => RETURN FALSE;
    END;
  END IsWritable;

PROCEDURE FPrinter (p: P;  map: Type.Map;  wr: Wr.T) =
  BEGIN
    Expr.Fingerprint (p.expr, map, wr);
    Wr.PutText (wr, ".");
    String.Put (wr, p.name);
  END FPrinter;

BEGIN
END QualifyExpr.