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

(* File: IfStmt.m3                                             *)
(* Last modified on Sat Feb 10 20:38:45 1990 by kalsow         *)
(*      modified on Tue Oct 10 18:42:06 1989 by muller         *)

MODULE IfStmt;

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

TYPE
  P = Stmt.T OBJECT
        clauses    : Clause;
        else       : Stmt.T;
      METHODS
	bind       := Bind;
        check      := Check;
	precompile := Precompile;
	compile    := Compile;
      END;

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

VAR nextID: INTEGER := 1;

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.else := 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.else := Stmt.Parse (fail + Token.Set {TK.tEND});
    END;

    Match (TK.tEND, fail, Token.Set {});
    RETURN p;
  END Parse;

PROCEDURE Bind (p: P) =
  VAR c: Clause;
  BEGIN
    c := p.clauses;
    WHILE (c # NIL) DO
      Expr.Bind (c.cond);
      Stmt.Bind (c.body);
      c := c.next;
    END;
    Stmt.Bind (p.else);
  END Bind;

PROCEDURE Check (p: P) =
  VAR c: Clause;  t: Type.T;
  BEGIN
    c := p.clauses;
    WHILE (c # NIL) DO
      Expr.TypeCheck (c.cond);
      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);
      c := c.next;
    END;
    Stmt.TypeCheck (p.else);
  END Check;

PROCEDURE Precompile (p: P) =
  VAR c: Clause;
  BEGIN
    c := p.clauses;
    WHILE (c # NIL) DO
      Stmt.Precompile (c.body);
      c := c.next;
    END;
    Stmt.Precompile (p.else);
  END Precompile;

PROCEDURE Compile (p: P): Stmt.Outcomes =
  VAR c: Clause;  x: Temp.T;  id: INTEGER;
    oc, xc: Stmt.Outcomes;  goto: BOOLEAN;
  BEGIN
    id := nextID;  INC (nextID);
    goto := FALSE;
    c := p.clauses;
    oc := Stmt.Outcomes {};
    WHILE (c # NIL) DO
      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) THEN
        Emit.OpI ("goto if_@_end;\n", id);
	goto := TRUE;
      END;
      Emit.Op ("\002};\n");
      c := c.next;
    END;
    IF (p.else = NIL) THEN
      oc := oc + Stmt.Outcomes {Stmt.Outcome.FallThrough};
    ELSE
      Emit.Op ("\001");
      oc := oc + Stmt.Compile (p.else);
      Emit.Op ("\002");
    END;
    IF (goto) THEN Emit.OpI ("if_@_end: /**/;\n", id) END;
    RETURN oc;
  END Compile;

BEGIN
END IfStmt.