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

(* File: Method.m3                                             *)
(* Last modified on Tue Jun  9 16:43:50 PDT 1992 by kalsow     *)
(*      modified on Fri Mar 22 08:34:06 1991 by muller         *)

MODULE Method;

IMPORT Value, ValueRep, Type, Scope, Expr, String, UserProc;
IMPORT Error, ProcType, MBuf, Procedure, Null;

TYPE
  T = Value.T BRANDED OBJECT
        offset    : INTEGER;
        override  : BOOLEAN;
        parent    : Type.T;
        signature : Type.T;
        dfaultE   : Expr.T;
        dfault    : Value.T;
      OVERRIDES
        typeCheck   := Check;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := ValueRep.NoLoader;
        write       := ValueRep.NoWriter;
        declare0    := Declarer;
        declare1    := Compile;
	toExpr      := ValueRep.NoExpr;
	toType      := ValueRep.NoType;
        typeOf      := TypeOf;
      END;

PROCEDURE New (name: String.T;  offset: INTEGER;  parent, signature: Type.T;
                                                    dfault: Expr.T): Value.T =
  VAR t: T;
  BEGIN
    t := NEW (T);
    ValueRep.Init (t, name);
    t.readonly   := TRUE;
    t.offset     := offset;
    t.override   := (signature = NIL);
    t.parent     := parent;
    t.signature  := signature;
    t.dfaultE    := dfault;
    t.dfault     := NIL;
    Scope.Insert (t);
    RETURN t;
  END New;

PROCEDURE Split (method: Value.T;  VAR offset: INTEGER;  VAR override: BOOLEAN;
                             VAR sig: Type.T): BOOLEAN =
  BEGIN
    TYPECASE method OF
    | NULL => RETURN FALSE;

    | T(t) => offset   := t.offset;
              override := t.override;
              sig      := t.signature;
	      RETURN TRUE;

    ELSE RETURN FALSE;
    END;
  END Split;

PROCEDURE SplitX (method: Value.T;  VAR offset: INTEGER; VAR override: BOOLEAN;
                             VAR sig: Type.T) =
  VAR b := Split (method, offset, override, sig);
  BEGIN
    <* ASSERT b *>
  END SplitX;

PROCEDURE GetDefault (method: Value.T): Value.T =
  BEGIN
    TYPECASE method OF
    | NULL => RETURN NIL;
    | T(t) => RETURN t.dfault;
    ELSE      RETURN NIL;
    END;
  END GetDefault;

PROCEDURE NoteOverride (newV, oldV: Value.T) =
  VAR new: T := newV;  old: T := oldV;
  BEGIN
    <* ASSERT new.override *>
    <* ASSERT old.signature # NIL *>
    new.signature := old.signature;
    new.offset    := old.offset;
  END NoteOverride;

PROCEDURE IsEqual (va, vb: Value.T;  x: Type.Assumption): BOOLEAN =
  VAR a: T := va;  b: T := vb;
  BEGIN
    RETURN (a # NIL) AND (b # NIL)
       AND (a.name = b.name)
       AND (a.override = b.override)
       AND Type.IsEqual (a.signature, b.signature, x)
       AND (a.dfault = b.dfault) (*CHEAT, BUG!*);
  END IsEqual;

PROCEDURE Check (t: T;  VAR cs: Value.CheckState) =
  VAR proc: Value.T;  procType: Type.T;
  BEGIN
    Type.Check (t.signature);

    IF (t.dfaultE # NIL) THEN
      Expr.TypeCheck (t.dfaultE, cs);
      IF NOT UserProc.IsProcedureLiteral (t.dfaultE, t.dfault) THEN
        IF ProcType.Is (Expr.TypeOf (t.dfaultE))
          THEN Error.Str (t.name, "default is not a procedure constant");
          ELSE Error.Str (t.name, "default is not a procedure");
        END;
      END;
    END;

    proc := t.dfault;
    IF (proc # NIL) THEN
      Value.TypeCheck (proc, cs);
      procType := Value.TypeOf (proc);
      IF (procType = Null.T) THEN
        t.dfault := NIL;
      ELSIF (Value.ClassOf (proc) # Value.Class.Procedure) THEN
        Error.Str (t.name, "default is not a procedure");
      ELSIF Procedure.IsNested (proc) THEN
        Error.Str (t.name, "default is a nested procedure");
      ELSIF NOT ProcType.IsCompatible (procType, t.parent, t.signature) THEN
        Error.Str (t.name, "default is incompatible with method type");
      END;
    END;
  END Check;

PROCEDURE TypeOf (t: T): Type.T =
  BEGIN
    RETURN t.signature;
  END TypeOf;

PROCEDURE Compile (t: T) =
  BEGIN
    Type.Compile (t.signature);
  END Compile;

PROCEDURE MyClass (<*UNUSED*> t: T): Value.Class =
  BEGIN
    RETURN Value.Class.Method;
  END MyClass;

PROCEDURE Declarer (t: T): BOOLEAN =
  BEGIN
    Error.Str (t.name, "method declaration??");
    <* ASSERT FALSE *>
    (* RETURN FALSE; *)
  END Declarer;

PROCEDURE FPrinter (t: T;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    IF (t.override)
      THEN MBuf.PutText (wr, "OVERRIDE ");
      ELSE MBuf.PutText (wr, "METHOD ");
    END;
    Type.Fingerprint (t.signature, map, wr);
    IF (t.dfault # NIL) THEN
      MBuf.PutText (wr, " := ");
      Value.Fingerprint (t.dfault, map, wr);
    END;
  END FPrinter;

BEGIN
END Method.