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

(* File: BlockStmt.m3                                          *)
(* Last modified on Mon Jun 29 17:01:22 PDT 1992 by kalsow     *)
(*      modified on Fri Feb 23 07:15:45 1990 by muller         *)

MODULE BlockStmt;

IMPORT Scope, Token, Stmt, StmtRep, Scanner, Decl, ESet, Frame, Tracer;
FROM Scanner IMPORT Match, Match1, cur;

TYPE TK = Token.T;

TYPE
  P = Stmt.T OBJECT
	scope   : Scope.T;
        body    : Stmt.T;
        fails   : ESet.T;
        trace   : TraceNode;
      OVERRIDES
        check    := Check;
	compile  := Compile;
        outcomes := GetOutcome;
      END;

PROCEDURE Parse (READONLY fail: Token.Set;  needScope: BOOLEAN): Stmt.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    StmtRep.Init (p);
    p.fails := NIL;

    IF (needScope)
      THEN p.scope := Scope.PushNew (TRUE, NIL);
      ELSE p.scope := NIL;
    END;

    WHILE (cur.token IN Token.DeclStart) DO
      Decl.Parse (fail + Token.Set {TK.tBEGIN, TK.tEND} + Token.DeclStart,
                  FALSE, FALSE, p.fails);
    END;

    Match (TK.tBEGIN, fail, Token.Set {TK.tEND});
      p.trace := ParseTrace (fail + Token.Set {TK.tEND});
      p.body := Stmt.Parse (fail + Token.Set {TK.tEND});
    Match1 (TK.tEND, fail);

    IF (needScope) THEN Scope.PopNew () END;
    RETURN p;
  END Parse;

PROCEDURE ExtractFails (t: Stmt.T): ESet.T =
  VAR x: ESet.T;
  BEGIN
    TYPECASE t OF
    | NULL =>  RETURN NIL;
    | P(p) =>  x := p.fails;  p.fails := NIL;  RETURN x;
    ELSE       RETURN NIL;
    END;
  END ExtractFails;

PROCEDURE BodyOffset (t: Stmt.T): INTEGER =
  BEGIN
    TYPECASE t OF
    | NULL =>  RETURN Scanner.offset;
    | P(p) =>  IF (p.body # NIL)
                 THEN RETURN p.body.origin;
                 ELSE RETURN Scanner.offset;
               END;
    ELSE       RETURN Scanner.offset;
    END;
  END BodyOffset;

PROCEDURE Check (p: P;  VAR cs: Stmt.CheckState) =
  VAR old, new: Scope.T;
  BEGIN
    new := p.scope;
    IF (new # NIL) THEN old := Scope.Push (new) END;
    ESet.TypeCheck (p.fails);
    ESet.Push (cs, NIL, p.fails, stop := FALSE);
      IF (new # NIL) THEN Scope.TypeCheck (new, cs) END;
      IF (p.trace # NIL) THEN Stmt.TypeCheck (p.trace.body, cs) END;
      Stmt.TypeCheck (p.body, cs);
      IF (new # NIL) THEN Scope.WarnUnused (new) END;
    ESet.Pop (cs, NIL, p.fails, stop := FALSE);
    IF (new # NIL) THEN Scope.Pop (old) END;
  END Check;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR oc: Stmt.Outcomes;  zz: Scope.T;  block: INTEGER;
  BEGIN
    IF (p.scope # NIL) THEN
      zz := Scope.Push (p.scope);
      Frame.PushBlock (block, 0);
      Scope.Enter (p.scope);
      Scope.InitValues (p.scope);
    END;

    Tracer.Push (p.trace);
    oc := Stmt.Compile (p.body);
    Tracer.Pop (p.trace);

    IF (p.scope # NIL) THEN
      Scope.Exit (p.scope);
      Frame.PopBlock (block);
      Scope.Pop (zz);
    END;

    RETURN oc;
  END Compile;

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

(*------------------------------------------------------- tracing support ---*)

TYPE TraceNode = Tracer.T OBJECT body: Stmt.T OVERRIDES apply := DoTrace END;

PROCEDURE ParseTrace (READONLY fail: Token.Set): Tracer.T =
  VAR s: Stmt.T;
  BEGIN
    IF (cur.token # TK.tTRACE) THEN RETURN NIL END;
    Match1 (TK.tTRACE, fail);
    s := Stmt.Parse (fail + Token.Set {TK.tENDPRAGMA});
    Match1 (TK.tENDPRAGMA, fail);
    IF (s = NIL) THEN RETURN NIL END;
    RETURN NEW (TraceNode, body := s);
  END ParseTrace;

PROCEDURE DoTrace (x: TraceNode) =
  BEGIN
    EVAL Stmt.Compile (x.body);
  END DoTrace;

PROCEDURE CheckTrace (tt: Tracer.T;  VAR cs: Stmt.CheckState) =
  VAR x: TraceNode := tt;
  BEGIN
    IF (tt = NIL) THEN RETURN END;
    Stmt.TypeCheck (x.body, cs);
  END CheckTrace;

BEGIN
END BlockStmt.