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

(* File: IfStmt.m3                                             *)
(* Last modified on Mon Feb 24 14:54:36 PST 1992 by kalsow     *)
(*      modified on Wed Feb 27 04:00:55 1991 by muller         *)

MODULE IfStmt;

IMPORT M3, Expr, Bool, Type, Error, Emit, Token, Stmt, StmtRep, Temp, Scanner;
FROM Scanner IMPORT Match, Match1, GetToken, cur;

TYPE
  P = Stmt.T OBJECT
        clauses  : Clause;
        elseBody : Stmt.T;
      OVERRIDES
        check    := Check;
	compile  := Compile;
        outcomes := GetOutcome;
      END;

TYPE
  Clause = UNTRACED REF RECORD
             next : Clause;
             cond : Expr.T;
             body : Stmt.T;
           END;

PROCEDURE Parse (READONLY fail: Token.Set): Stmt.T =
  TYPE  TK = Token.T;
  CONST Markers = Token.Set {TK.tELSIF, TK.tELSE, TK.tEND};
  VAR   p: P;  c, last: Clause;
  BEGIN
    p := NEW (P);
    StmtRep.Init (p);

    Match (TK.tIF, fail, Token.Set {TK.tTHEN} + Markers);
    c := NEW (Clause);
    c.next := NIL;
    c.cond := Expr.Parse (fail + Token.Set {TK.tTHEN} + Markers);
    Match (TK.tTHEN, fail, Markers);
    c.body := Stmt.Parse (fail + Markers);
    p.clauses := c;
    p.elseBody := NIL;
    last := c;

    WHILE (cur.token = TK.tELSIF) DO
      GetToken (); (* ELSIF *)
      c := NEW (Clause);
      c.next := NIL;
      c.cond := Expr.Parse (fail + Markers);
      Match (TK.tTHEN, fail, Markers);
      c.body := Stmt.Parse (fail + Markers);
      last.next := c;
      last := c;
    END;

    IF (cur.token = TK.tELSE) THEN
      GetToken (); (* ELSE *)
      p.elseBody := Stmt.Parse (fail + Token.Set {TK.tEND});
    END;

    Match1 (TK.tEND, fail);
    RETURN p;
  END Parse;

PROCEDURE Check (p: P;  VAR cs: Stmt.CheckState) =
  VAR c: Clause;  t: Type.T;
  BEGIN
    c := p.clauses;
    WHILE (c # NIL) DO
      Expr.TypeCheck (c.cond, cs);
      t := Expr.TypeOf (c.cond);
      IF (Type.Base (t) # Bool.T) THEN
        Error.Msg ("IF condition must be a BOOLEAN");
      END;
      Stmt.TypeCheck (c.body, cs);
      c := c.next;
    END;
    Stmt.TypeCheck (p.elseBody, cs);
  END Check;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR c: Clause;  x: Temp.T;  endLabel: INTEGER;
    oc, xc: Stmt.Outcomes;  gotoEnd: BOOLEAN;
  BEGIN
    endLabel := M3.NextLabel;  INC (M3.NextLabel);
    gotoEnd := FALSE;
    c := p.clauses;
    oc := Stmt.Outcomes {};
    WHILE (c # NIL) DO
      Scanner.offset := c.cond.origin;
      x := Expr.Compile (c.cond);
      Emit.OpT ("if (@) {\001\n", x);
      Temp.Free (x);
      xc := Stmt.Compile (c.body);
      oc := oc + xc;
      IF (Stmt.Outcome.FallThrough IN xc)
        AND ((c.next # NIL) OR (p.elseBody # NIL)) THEN
        Emit.OpL ("goto @;\n", endLabel);
	gotoEnd := TRUE;
      END;
      Emit.Op ("\002}\n");
      c := c.next;
    END;
    IF (p.elseBody = NIL) THEN
      oc := oc + Stmt.Outcomes {Stmt.Outcome.FallThrough};
    ELSE
      Emit.Op ("\001");
      oc := oc + Stmt.Compile (p.elseBody);
      Emit.Op ("\002");
    END;
    IF (gotoEnd) THEN Emit.OpL ("@:;\n", endLabel) END;
    RETURN oc;
  END Compile;

PROCEDURE GetOutcome (p: P): Stmt.Outcomes =
  VAR c: Clause;  oc := Stmt.Outcomes {};
  BEGIN
    c := p.clauses;
    WHILE (c # NIL) DO
      oc := oc + Stmt.GetOutcome (c.body);
      c := c.next;
    END;
    IF (p.elseBody = NIL)
      THEN oc := oc + Stmt.Outcomes {Stmt.Outcome.FallThrough};
      ELSE oc := oc + Stmt.GetOutcome (p.elseBody);
    END;
    RETURN oc;
  END GetOutcome;

BEGIN
END IfStmt.