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

(* File: Method.m3                                             *)
(* Last modified on Fri Apr 20 06:49:18 1990 by muller         *)
(*      modified on Sat Feb 10 20:58:28 1990 by kalsow         *)


MODULE Method;

IMPORT Value, ValueRep, Type, Scope, Expr, String;
IMPORT Error, ProcType, Temp, Wr, Procedure;

TYPE
  T = Value.T BRANDED OBJECT
        override  : BOOLEAN;
        parent    : Type.T;
        signature : Type.T;
        qid       : String.QID;
        default   : Value.T;
      METHODS
        bind        := Bind;
        typeCheck   := Check;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := ValueRep.NoLoader;
        write       := ValueRep.NoWriter;
        select      := ValueRep.NoDuplicates;
        declare0    := Declarer;
        declare1    := Compile;
        needsDecl   := ValueRep.Never;
	toExpr      := ValueRep.NoExpr;
	toType      := ValueRep.NoType;
      END;

PROCEDURE New (name: String.T;  parent, signature: Type.T;
                                          defaultM, defaultN: String.T) =
  VAR t: T;
  BEGIN
    t := NEW (T);
    ValueRep.Init (t, name);
    t.readonly   := TRUE;
    t.override   := (signature = NIL);
    t.parent     := parent;
    t.signature  := signature;
    t.qid.module := defaultM;
    t.qid.item   := defaultN;
    t.default    := NIL;
    Scope.Insert (t);
  END New;

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

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

    ELSE RETURN FALSE;
    END;
  END Split;

PROCEDURE NoteOverride (method: Value.T;  signature: Type.T) =
  VAR t: T;
  BEGIN
    t := method;
    <* ASSERT t.override *>
    t.signature := signature;
    t.type      := signature;
  END NoteOverride;

PROCEDURE Check (t: T) =
  BEGIN
    Type.Check (t.signature);
    IF (t.default # NIL) THEN
      Value.TypeCheck (t.default);
      IF (Value.ClassOf (t.default) # Value.Class.Procedure) THEN
        Error.QID (t.qid, "not a procedure");
      ELSIF Procedure.IsNested (t.default) THEN
        Error.QID (t.qid, "nested procedure");
      ELSIF NOT ProcType.IsCompatible (Value.TypeOf (t.default),
                                          t.parent, t.signature) THEN
        Error.QID (t.qid, "default is incompatible with method type");
      END;
    END;
  END Check;

PROCEDURE Bind (t: T) =
  BEGIN
    t.signature := Type.Bind (t.signature);
    IF (t.qid.item # NIL) THEN
      t.default := Scope.LookUpQID (t.qid);
      IF (t.default = NIL) THEN Error.QID (t.qid, "undefined");  END;
    END;
    Value.Bind (t.default);
    t.type := t.signature;
  END Bind;

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.Map;  wr: Wr.T) =
  BEGIN
    Wr.PutText (wr, "METHOD ");
    Type.Fingerprint (t.signature, map, wr);
    IF (t.default # NIL) THEN
      Wr.PutText (wr, " := ");
      Value.Fingerprint (t.default, map, wr);
    END;
  END FPrinter;

BEGIN
END Method.