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

(* File: WithStmt.m3                                           *)
(* Last modified on Tue Jun 30 10:47:17 PDT 1992 by kalsow     *)
(*      modified on Tue Jun 26 08:01:23 1990 by muller         *)

MODULE WithStmt;

IMPORT Expr, Scope, String, Value, Variable, Emit, OpenArrayType, Addr;
IMPORT Type, Temp, Stmt, StmtRep, Token, ProcType, Target, Frame, Tracer;
FROM Scanner IMPORT Match, Match1, MatchID, GetToken, cur;

TYPE
  Kind = {designator, openarray, largeresult, other};

  P = Stmt.T OBJECT
        var     : Variable.T;
        expr    : Expr.T;
        scope   : Scope.T;
        body    : Stmt.T;
	kind    : Kind;
      OVERRIDES
        check    := Check;
	compile  := Compile;
        outcomes := GetOutcome;
      END;

PROCEDURE Parse (READONLY fail: Token.Set): Stmt.T =
  TYPE TK = Token.T;
  BEGIN
    Match (TK.tWITH, fail, Token.Set {TK.tIDENT, TK.tEQUAL, TK.tDO, TK.tEND});
    RETURN ParseTail (fail);
  END Parse;

PROCEDURE ParseTail (READONLY fail: Token.Set): Stmt.T =
  TYPE TK = Token.T;
  VAR p: P;  fail2: Token.Set;  id: String.T;  trace: Tracer.T;
  BEGIN
    p := NEW (P);
    StmtRep.Init (p);
    fail2 := fail + Token.Set {TK.tDO, TK.tCOMMA, TK.tEND};
    id := MatchID (fail2, Token.Set {TK.tEQUAL});
    trace := Variable.ParseTrace (fail2 + Token.Set {TK.tEQUAL});
    p.var := Variable.New (id, FALSE);
    Match1 (TK.tEQUAL, fail2);
    p.expr := Expr.Parse (fail2);
    p.scope := Scope.New1 (p.var);
    Variable.BindTrace (p.var, trace);
    IF (cur.token = TK.tCOMMA) THEN
      GetToken (); (* , *)
      p.body := ParseTail (fail);
    ELSE
      Match (TK.tDO, fail, Token.Set {TK.tEND});
      p.body := Stmt.Parse (fail + Token.Set {TK.tEND});
      Match1 (TK.tEND, fail);
    END;
    Scope.PopNew ();
    RETURN p;
  END ParseTail;

PROCEDURE Check (p: P;  VAR cs: Stmt.CheckState) =
  VAR t: Type.T;  zz: Scope.T;
  BEGIN
    Expr.TypeCheck (p.expr, cs);
    t := Expr.TypeOf (p.expr);

    IF OpenArrayType.Is (t) THEN
      p.kind := Kind.openarray;
    ELSIF Expr.IsDesignator (p.expr) THEN
      p.kind := Kind.designator;
    ELSIF ProcType.LargeResult (t) THEN
      p.kind := Kind.largeresult;
    ELSE
      p.kind := Kind.other;
    END;
      
    Variable.BindType (p.var, t, p.kind = Kind.designator,
                       NOT Expr.IsWritable (p.expr), TRUE);

    Scope.TypeCheck (p.scope, cs);
    zz := Scope.Push (p.scope);
      Stmt.TypeCheck (p.body, cs);
    Scope.Pop (zz);
  END Check;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR
    x, with: Temp.T;
    oc: Stmt.Outcomes;
    t: Type.T;
    zz: Scope.T;
    block: INTEGER;
  BEGIN
    t := Value.TypeOf (p.var);

    (* evaluate the expr outside the new scope and capture its value *)    
    CASE p.kind OF
    | Kind.designator =>
        x := Expr.CompileLValue (p.expr);
        with := Temp.AllocEmpty (Addr.T);
        Emit.OpTT ("@ = (_ADDRESS) & @;\n", with, x);
    | Kind.largeresult, Kind.openarray =>
        x := Expr.Compile (p.expr);
        with := Temp.AllocEmpty (Addr.T);
        Emit.OpTT ("@ = (_ADDRESS) & @;\n", with, x);
    ELSE
        x := Expr.Compile (p.expr);
        with := Temp.AllocEmpty (Type.Base (t));
        Emit.OpTT ("@ = @;\n", with, x);
    END;
    Temp.Free (x);

    (* open the new scope *)
    zz := Scope.Push (p.scope);
    Frame.PushBlock (block, 0);
      Scope.Enter (p.scope);

      (* initialize the new value *)
      CASE p.kind OF
      | Kind.designator =>
          Variable.LoadLValue (p.var);
          Emit.OpFT (" = (@*) @;\n", t, with);
          Scope.InitValues (p.scope);
      | Kind.openarray =>
          Scope.InitValues (p.scope);
          Emit.OpT ("_COPY (@, ", with);
          Emit.OpV ("&@, ", p.var);
          Emit.OpF ("sizeof (@));\n", t);
      | Kind.largeresult =>
          Scope.InitValues (p.scope);
          Emit.OpT ("_COPY (@, ", with);
          Emit.OpV ("&@, ", p.var);
          Emit.OpI ("@);\n", Type.Size (t) DIV Target.CHARSIZE);
      ELSE
          Scope.InitValues (p.scope);
          Emit.OpV  ("@ = ", p.var);
          Emit.OpFT ("(@) @;\n", t, with);
      END;
      Temp.Free (with);
      Variable.ScheduleTrace (p.var);

      oc := Stmt.Compile (p.body);
      Scope.Exit (p.scope);
    Frame.PopBlock (block);
    Scope.Pop (zz);
    RETURN oc;
  END Compile;

PROCEDURE GetOutcome (p: P): Stmt.Outcomes =
  BEGIN
    RETURN Stmt.GetOutcome (p.body);
  END GetOutcome;

BEGIN
END WithStmt.