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

(* File: WithStmt.m3                                           *)
(* Last modified on Tue Jun 26 08:01:23 1990 by muller         *)
(*      modified on Mon Feb 12 08:48:37 1990 by kalsow         *)



MODULE WithStmt;

IMPORT Expr, Scope, String, Value, Variable, Emit, ArrayType;
IMPORT Type, Temp, Stmt, StmtRep, Token, Error, ProcType, Target;
FROM Scanner IMPORT Match, 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;
      METHODS
	bind       := Bind;
        check      := Check;
	precompile := Precompile;
	compile    := Compile;
      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;
  BEGIN
    p := NEW (P);
    StmtRep.Init (p);
    fail2 := fail + Token.Set {TK.tDO, TK.tCOMMA, TK.tEND};
    id := MatchID (fail2, Token.Set {TK.tEQUAL});
    p.var := Variable.New (id, FALSE);
    Match (TK.tEQUAL, fail2, Token.Set {});
    p.expr := Expr.Parse (fail2);
    p.scope := Scope.New1 (p.var);
    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});
      Match (TK.tEND, fail, Token.Set {});
    END;
    Scope.PopNew ();
    RETURN p;
  END ParseTail;

PROCEDURE Bind (p: P) =
  VAR t: Type.T;
  BEGIN
    Expr.Bind (p.expr);
    t := Expr.TypeOf (p.expr);
    IF Expr.IsDesignator (p.expr) THEN
      IF ArrayType.OpenDepth (t) = 0 THEN p.kind := Kind.designator;
      ELSE                                p.kind := Kind.openarray; END;
    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.Push (p.scope);
      Scope.Bind (p.scope, TRUE);
      Stmt.Bind (p.body);
    Scope.Pop ();
  END Bind;

PROCEDURE Check (p: P) =
  BEGIN
    Expr.TypeCheck (p.expr);
    Scope.TypeCheck (p.scope, TRUE);
    Scope.Push (p.scope);
      Stmt.TypeCheck (p.body);
    Scope.Pop ();
  END Check;

PROCEDURE Precompile (p: P) =
  BEGIN
    Scope.Push (p.scope);
      Stmt.Precompile (p.body);
    Scope.Pop ();
  END Precompile;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR x: Temp.T;  oc: Stmt.Outcomes;  t: Type.T;
  BEGIN
    t := Value.TypeOf (p.var);

    Emit.OpI ("{\001\nt@ ", Type.Name (t));
    
    CASE p.kind OF
    | Kind.designator, Kind.openarray =>
        Emit.Op ("*with;\n");
        x := Expr.CompileLValue (p.expr);
        Emit.OpT ("with = &@;\n", x);
    | Kind.largeresult =>
        Emit.Op ("*with;\n");
        x := Expr.Compile (p.expr);
        Emit.OpT ("with = &@;\n", x);
    ELSE
        Emit.Op ("with;\n");
        x := Expr.Compile (p.expr);
        Emit.OpT ("with = @;\n", x);
    END;
    Temp.Free (x);

    Scope.Push (p.scope);
      Scope.Enter (p.scope);
      CASE p.kind OF
      | Kind.designator =>
          Variable.LoadLValue (p.var);
          Emit.Op (" = with;\n");
      | Kind.openarray =>
          Emit.OpV ("COPY (with, &@, ", p.var);
          Emit.OpI ("sizeof (t@));\n", Type.Name (t));
      | Kind.largeresult =>
          Emit.OpV ("COPY (with, &@, ", p.var);
          Emit.OpI ("@);\n", 
                    Type.Size (Expr.TypeOf (p.expr)) DIV Target.CHARSIZE);
      ELSE
          Emit.OpV ("@ = with;\n", p.var);
      END;
      oc := Stmt.Compile (p.body);
      Scope.Exit (p.scope);
    Scope.Pop ();
    Emit.Op ("\002};\n");
    RETURN oc;
  END Compile;

BEGIN
END WithStmt.