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

(* File: QualifyExpr.m3                                        *)
(* Last modified on Tue Sep  8 11:01:22 PDT 1992 by kalsow     *)
(*      modified on Tue Feb 19 01:32:23 1991 by muller         *)

MODULE QualifyExpr;

IMPORT Expr, ExprRep, String, Value, Type, Module, Scope, Target, Field;
IMPORT RecordType, ObjectType, Emit, Variable, VarExpr, OffsetExpr;
IMPORT EnumType, RefType, DerefExpr, Void, NamedExpr, Error, ProcType;
IMPORT Int, RecordExpr, TypeExpr, MBuf, MethodExpr, ProcExpr, Temp;

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

TYPE
  VC = Value.Class;

TYPE
  P = Expr.T BRANDED "QualifyExpr.T" OBJECT
        expr        : Expr.T;
        name        : String.T;
        obj         : Value.T;
        class       : Class;
        holder      : Type.T;
        objType     : Type.T;
        inFold      : BOOLEAN;
        inIsZeroes  : BOOLEAN;
        inGetBounds : BOOLEAN;
      OVERRIDES
        typeOf       := TypeOf;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := Writer;
        isEqual      := EqCheck;
        getBounds    := Bounder;
        isWritable   := IsWritable;
        isDesignator := IsDesignator;
	isZeroes     := IsZeroes;
	note_write   := NoteWrites;
	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.cUNKNOWN;
    p.holder      := NIL;
    p.objType     := NIL;
    p.inFold      := FALSE;
    p.inIsZeroes  := FALSE;
    p.inGetBounds := FALSE;
    RETURN p;
  END New;

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

PROCEDURE SplitQID (e: Expr.T; VAR module, item: String.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(p) => IF NamedExpr.SplitName (p.expr, module)
                 THEN item := p.name; RETURN TRUE;
                 ELSE RETURN FALSE;
              END;
    ELSE      RETURN FALSE;
    END;
  END SplitQID;

PROCEDURE MethodType (e: Expr.T): Type.T =
  BEGIN
    TYPECASE e OF
    | NULL => (* nothing *)
    | P(p) => Resolve (p);
              IF (p.class = Class.cMETHOD) THEN RETURN Value.TypeOf(p.obj) END;
    ELSE      (* nothing *)
    END;
    RETURN NIL;
  END MethodType;

PROCEDURE Bounder (p: P;  VAR min, max: INTEGER) =
  BEGIN
    Resolve (p);
    IF (p.inGetBounds) THEN Value.IllegalRecursion (p.obj) END;
    p.inGetBounds := TRUE;
    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                  EVAL Type.GetBounds (p.type, min, max);
    END;
    p.inGetBounds := FALSE;
  END Bounder;

PROCEDURE Resolve (p: P) =
  VAR
    t      : Type.T;
    s      : Scope.T;
    obj    : Value.T;
    name   : String.T;
  BEGIN
    IF (p.class # Class.cUNKNOWN) THEN RETURN END;

    t := Expr.TypeOf (p.expr);

    IF RefType.Is (t) THEN
      (* auto-magic dereference *)
      p.expr := DerefExpr.New (p.expr);
      t := 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) THEN
          p.objType := t;
          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 (Value.Base (obj));
          p.obj := Scope.LookUp (s, p.name, TRUE);
        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) THEN
      IF (Value.ClassOf (p.obj) = VC.Field) THEN
        p.expr := OffsetExpr.New (p.expr, p.holder, FALSE);
        p.class := Class.cOBJFIELD;
      ELSE
        p.expr := OffsetExpr.New (p.expr, p.holder, TRUE);
        p.class := Class.cMETHOD;
      END;
    END;
  END Resolve;

PROCEDURE TypeOf (p: P): Type.T =
  BEGIN
    Resolve (p);
    p.type := Value.TypeOf (p.obj);
    IF p.class = Class.cMETHOD THEN
      p.type := Void.T;
    ELSIF p.class = Class.cOBJTYPE THEN
      p.type := ProcType.MethodSigAsProcSig (p.type, p.objType);
    END;
    RETURN p.type;
  END TypeOf;

PROCEDURE Check (p: P;  VAR cs: Expr.CheckState) =
  VAR nErrs0, nErrs1, nWarns: INTEGER;
  BEGIN
    Error.Count (nErrs0, nWarns);
      Expr.TypeCheck (p.expr, cs);
      Resolve (p);
      Expr.TypeCheck (p.expr, cs);
    Error.Count (nErrs1, nWarns);

    IF (p.obj = NIL) THEN
      IF (nErrs0 = nErrs1) THEN
        Error.Str (p.name, "unknown qualification \'.\'");
      END;
      p.obj := VarExpr.Obj (VarExpr.New (Int.T, p.name));
      p.class := Class.cMODULE;
    ELSIF (p.class = Class.cOBJTYPE)
      AND (Value.ClassOf (p.obj) # VC.Method) THEN
      Error.Str (p.name, "doesn\'t name a method");
    END;

    Value.TypeCheck (p.obj, cs);
    EVAL TypeOf (p);
    Type.Check (p.type);
  END Check;

PROCEDURE EqCheck (a: P;  e: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(b) => Resolve (a);  Resolve (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 CompileProc (e: Expr.T;  VAR obj: Temp.T): Temp.T =
  VAR t1, t2: Temp.T;
  BEGIN
    obj := NIL;
    TYPECASE e OF
    | NULL => t1 := Expr.Compile (e);
    | P(p) => IF (p.class = Class.cMETHOD) THEN
                t2 := OffsetExpr.CompileMethod (p.expr, obj);
                t1 := Temp.AllocMacro (p, FALSE);
                Temp.Depend (t1, t2);
              ELSE
                t1 := Expr.Compile (p);
              END;
    ELSE      t1 := Expr.Compile (e);
    END;
    RETURN t1;
  END CompileProc;

PROCEDURE Compile (p: P): Temp.T =
  VAR t1, t2: Temp.T;
  BEGIN
    CASE p.class OF
    | Class.cMODULE, Class.cENUM =>
        t1 := Value.Load (p.obj);
    | Class.cOBJTYPE =>
        Type.Compile (p.holder);
        Type.Compile (p.objType);
        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 =>
        t2 := Expr.Compile (p.expr);
        t1 := Temp.AllocMacro (p, FALSE);
        Temp.Depend (t1, t2);
    | Class.cUNKNOWN =>
        <* ASSERT FALSE *>
    END;
    RETURN t1; 
 END Compile;

PROCEDURE Writer (p: P;  t1: Temp.T;  <*UNUSED*> t2: Temp.T) =
  VAR x: INTEGER;  name := Value.CName (p.obj);
  BEGIN
    CASE p.class OF
    | Class.cMODULE, Class.cENUM =>
        <* ASSERT FALSE *>
    | Class.cOBJTYPE =>
        x := ObjectType.MethodOffset (p.holder);
        Emit.OpF ("(((@_methods*)", p.holder);
        Emit.OpF ("(@_TC->defaultMethods + ", p.objType);
        IF (x < 0)
          THEN Emit.OpF ("@_TC->methodOffset", p.holder);
          ELSE Emit.OpI ("@", x DIV Target.CHARSIZE);
        END;
        Emit.OpS ("))->@)", name);
    | Class.cFIELD =>
        IF Field.NeedsSignExtension (p.obj) THEN
          (******** doesn't work when the field is lhs in an assignment
          Emit.OpT ("((signed_int)(@", t1);
          Emit.OpS (".@))", name);
          *******************************************************)
          Emit.OpT ("(@", t1);
          Emit.OpS (".@)", name);
        ELSE
          Emit.OpT ("(@", t1);
          Emit.OpS (".@)", name);
        END;
    | Class.cOBJFIELD =>
        Emit.OpT ("(@", t1);
        Emit.OpS ("->@)", name);
    | Class.cMETHOD =>
        Emit.OpT ("(@", t1);
        Emit.OpS ("->@)", name);
    | Class.cUNKNOWN =>
        <* ASSERT FALSE *>
    END;
  END Writer;

TYPE
  Kind = {Value, Expr, Type, None};
  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;
  BEGIN
    IF (p.inFold) THEN Value.IllegalRecursion (p.obj); RETURN NIL END;
    p.inFold := TRUE;

    (* 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.None =>
        e := NIL;
    | Kind.Expr =>
        e := Expr.ConstValue (lhs.expr);
    | Kind.Type =>
        e := TypeExpr.New (lhs.type);
    | Kind.Value =>
        CASE Value.ClassOf (lhs.value) OF
        | VC.Expr =>
            e := Expr.ConstValue (Value.ToExpr (lhs.value));
        | VC.Type =>
            e := TypeExpr.New (Value.ToType (lhs.value));
        | VC.Procedure =>
            e := ProcExpr.New (lhs.value);
            (* lhs.value is a procedure *)
        ELSE (* not possible to convert to an expression *)
            e := NIL;
        END;
    END;

    p.inFold := FALSE;
    RETURN e;
  END Fold;

PROCEDURE DoQualify (VAR lhs: LHS;  name: String.T) =
  VAR
    e: Expr.T;
    v: Value.T;
    p: P;
    s: Scope.T;
    t, t1: Type.T;
    n: String.T;
  BEGIN
    CASE lhs.kind OF
    | Kind.None =>
        (* don't even try *)
    | Kind.Expr =>
        IF lhs.expr = NIL THEN
          lhs.kind := Kind.None; (*FINAL*)
        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;  (*FINAL*)
          lhs.expr  := e;
        ELSE
          lhs.kind  := Kind.Expr;
          lhs.expr  := Expr.ConstValue (lhs.expr);
          DoQualify (lhs, name);
        END;
    | Kind.Type =>
        t := Type.Strip (lhs.type);
        IF EnumType.LookUp (t, name, v) THEN
          lhs.kind  := Kind.Expr;  (*FINAL*)
          lhs.expr  := Value.ToExpr (v);
        ELSIF ObjectType.LookUp (t, name, v, t1)
          AND (Value.ClassOf (v) = VC.Method) THEN
          lhs.kind  := Kind.Expr;  (*FINAL*)
          lhs.expr  := MethodExpr.New (t, name, v, t1);
        ELSE (* type that can't be qualified *)
          lhs.kind  := Kind.None;  (*FINAL*)
        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 (Value.Base (lhs.value));
            lhs.kind  := Kind.Value;   (*FINAL*)
            lhs.value := Scope.LookUp (s, name, TRUE);
        ELSE (* can't qualify this kind of value *)
            lhs.kind  := Kind.None;  (*FINAL*)
        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;
    | Class.cUNKNOWN  => RETURN FALSE;
    END;
  END IsDesignator;

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

PROCEDURE IsZeroes (p: P): BOOLEAN =
  VAR lhs: LHS;  b: BOOLEAN;
  BEGIN
    IF (p.inIsZeroes) THEN Value.IllegalRecursion (p.obj); RETURN FALSE END;
    p.inIsZeroes := TRUE;

    (* 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.None =>
        b := FALSE;
    | Kind.Expr =>
        b := Expr.IsZeroes (lhs.expr);
    | Kind.Type =>
        b := FALSE;
    | Kind.Value =>
        b := (Value.ClassOf (lhs.value) = VC.Expr)
              AND Expr.IsZeroes (Value.ToExpr (lhs.value));
    END;

    p.inIsZeroes := FALSE;
    RETURN b;
  END IsZeroes;

PROCEDURE NoteWrites (p: P) =
  BEGIN
    CASE p.class OF
    | Class.cENUM     => (*skip*)
    | Class.cOBJTYPE  => (*skip*)
    | Class.cMETHOD   => (*skip*)
    | Class.cUNKNOWN  => (*skip*)
    | Class.cFIELD    => Expr.NoteWrite (p.expr);
    | Class.cOBJFIELD => Expr.NoteWrite (p.expr);
    | Class.cMODULE   => IF (Value.ClassOf (p.obj) = VC.Var) THEN
                           Variable.ScheduleTrace (Value.Base (p.obj));
                         END;
    END;
  END NoteWrites;

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

BEGIN
END QualifyExpr.