MODULE M3Builtin;

IMPORT M3Const, M3Type, Target, TInt, TFloat;

TYPE
  Desc = RECORD
    proc     : Proc;
    min_args : CARDINAL;
    max_args : CARDINAL;
    is_const : BOOLEAN;
  END;

CONST
  PDesc = ARRAY Proc OF Desc {
    Desc{Proc.Abs,             1, 1, TRUE },
    Desc{Proc.Adr,             1, 1, FALSE },
    Desc{Proc.AdrSize,         1, 1, TRUE },
    Desc{Proc.BitSize,         1, 1, TRUE },
    Desc{Proc.ByteSize,        1, 1, TRUE },
    Desc{Proc.Ceiling,         1, 1, TRUE },
    Desc{Proc.Dec,             1, 2, FALSE },
    Desc{Proc.Dispose,         1, 1, FALSE },
    Desc{Proc.First,           1, 1, TRUE },
    Desc{Proc.Float,           1, 2, TRUE },
    Desc{Proc.Floor,           1, 1, TRUE },
    Desc{Proc.Inc,             1, 2, FALSE },
    Desc{Proc.IsType,          2, 2, TRUE },
    Desc{Proc.Last,            1, 1, TRUE },
    Desc{Proc.Loophole,        2, 2, FALSE },
    Desc{Proc.Max,             2, 2, TRUE },
    Desc{Proc.Min,             2, 2, TRUE },
    Desc{Proc.Narrow,          2, 2, TRUE },
    Desc{Proc.New,             1, 99999, FALSE },
    Desc{Proc.Number,          1, 1, TRUE },
    Desc{Proc.Ord,             1, 1, TRUE },
    Desc{Proc.Round,           1, 1, TRUE },
    Desc{Proc.Subarray,        3, 3, TRUE },
    Desc{Proc.Trunc,           1, 1, TRUE },
    Desc{Proc.Typecode,        1, 1, FALSE },
    Desc{Proc.Val,             2, 2, TRUE },
    Desc{Proc.WordPlus,        2, 2, TRUE },
    Desc{Proc.WordTimes,       2, 2, TRUE },
    Desc{Proc.WordMinus,       2, 2, TRUE },
    Desc{Proc.WordDivide,      2, 2, TRUE },
    Desc{Proc.WordMod,         2, 2, TRUE },
    Desc{Proc.WordLT,          2, 2, TRUE },
    Desc{Proc.WordLE,          2, 2, TRUE },
    Desc{Proc.WordGT,          2, 2, TRUE },
    Desc{Proc.WordGE,          2, 2, TRUE },
    Desc{Proc.WordAnd,         2, 2, TRUE },
    Desc{Proc.WordOr,          2, 2, TRUE },
    Desc{Proc.WordXor,         2, 2, TRUE },
    Desc{Proc.WordNot,         1, 1, TRUE },
    Desc{Proc.WordShift,       2, 2, TRUE },
    Desc{Proc.WordLeftShift,   2, 2, TRUE },
    Desc{Proc.WordRightShift,  2, 2, TRUE },
    Desc{Proc.WordRotate,      2, 2, TRUE },
    Desc{Proc.WordLeftRotate,  2, 2, TRUE },
    Desc{Proc.WordRightRotate, 2, 2, TRUE },
    Desc{Proc.WordExtract,     3, 3, TRUE },
    Desc{Proc.WordInsert,      4, 4, TRUE }
  };

PROCEDURE Eval (p: Proc;  READONLY args: ARRAY OF M3Const.T;
                VAR(*OUT*) val: M3Const.T)
  RAISES {M3Const.Error} =
  VAR n_args := NUMBER (args);  zero: Target.Float;
  BEGIN
    MustBe (PDesc[p].is_const);
    IF (n_args < PDesc[p].min_args) OR (PDesc[p].max_args < n_args) THEN
      RAISE M3Const.Error ("wrong number of arguments");
    END;

    CASE p OF
    | Proc.Abs =>
        WITH z = args[0] DO
          IF z.class = M3Const.Class.Integer THEN
            val.class := z.class;
            val.type  := z.type;
            IF TInt.LT (z.int, TInt.Zero)
              THEN MustBe (TInt.Subtract (TInt.Zero, z.int, val.int));
              ELSE val.int := z.int;
            END;
          ELSIF z.class = M3Const.Class.Float THEN
            IF    (z.float.pre = Target.Precision.Short) THEN zero := TFloat.ZeroR;
            ELSIF (z.float.pre = Target.Precision.Long) THEN  zero := TFloat.ZeroL;
            ELSE                                              zero := TFloat.ZeroX;
            END;
            val.class := z.class;
            val.type  := z.type;
            IF TFloat.LT (z.float, zero)
              THEN MustBe (TFloat.Subtract (zero, z.float, val.float));
              ELSE val.float := z.float;
            END;
          ELSE
            MustBe (FALSE);
          END;
        END;

    | Proc.AdrSize => NotImpl ("ADRSIZE");
    | Proc.BitSize => NotImpl ("BITSIZE");

    | Proc.ByteSize =>
        WITH z = args[0] DO
          IF z.class = M3Const.Class.Type THEN
            VAR info: M3Type.Info; BEGIN
              M3Type.GetInfo (z.type, info);
              val.type  := M3Type.Integer;
              val.class := M3Const.Class.Integer;
              MustBe (info.size >= 0);
              MustBe (TInt.FromInt (info.size, Target.Integer.bytes, val.int));
            END;
          ELSE
            NotImpl ("BYTESIZE(expr)");
          END;
        END;

    | Proc.Ceiling => NotImpl ("CEILING");
    | Proc.First => NotImpl ("FIRST");
    | Proc.Float => NotImpl ("FLOAT");
    | Proc.Floor => NotImpl ("FLOOR");
    | Proc.IsType => NotImpl ("ISTYPE");
    | Proc.Last => NotImpl ("LAST");

    | Proc.Max =>
        WITH a = args[0], b = args[0] DO
          MustBe (a.class = b.class);
          IF a.class = M3Const.Class.Integer THEN
            MustBe (a.type = b.type);
            val.class := a.class;
            val.type  := a.type;
            IF TInt.LT (a.int, b.int)
              THEN val.int := b.int
              ELSE val.int := a.int;
            END;
          ELSIF a.class = M3Const.Class.Enum THEN
            val.class := a.class;
            val.info  := MAX (a.info, b.info);
            val.type  := a.type;
          ELSIF a.class = M3Const.Class.Float THEN
            MustBe (a.float.pre = b.float.pre);
            val.class := a.class;
            val.type  := a.type;
            IF TFloat.LT (a.float, b.float)
              THEN val.float := b.float;
              ELSE val.float := a.float;
            END;
          ELSE
            MustBe (FALSE);
          END;
        END;

    | Proc.Min =>
        WITH a = args[0], b = args[0] DO
          MustBe (a.class = b.class);
          IF a.class = M3Const.Class.Integer THEN
            MustBe (a.type = b.type);
            val.class := a.class;
            val.type  := a.type;
            IF TInt.LT (a.int, b.int)
              THEN val.int := a.int
              ELSE val.int := b.int;
            END;
          ELSIF a.class = M3Const.Class.Enum THEN
            val.class := a.class;
            val.info  := MIN (a.info, b.info);
            val.type  := a.type;
          ELSIF a.class = M3Const.Class.Float THEN
            MustBe (a.float.pre = b.float.pre);
            val.class := a.class;
            val.type  := a.type;
            IF TFloat.LT (a.float, b.float)
              THEN val.float := a.float;
              ELSE val.float := b.float;
            END;
          ELSE
            MustBe (FALSE);
          END;
        END;

    | Proc.Narrow => NotImpl ("NARROW");
    | Proc.Number => NotImpl ("NUMBER");
    | Proc.Ord => NotImpl ("ORD");
    | Proc.Round => NotImpl ("ROUND");
    | Proc.Subarray => NotImpl ("SUBARRAY");
    | Proc.Trunc => NotImpl ("TRUNC");
    | Proc.Val => NotImpl ("VAL");
    | Proc.WordPlus => NotImpl ("Word.Plus");
    | Proc.WordTimes => NotImpl ("Word.Times");
    | Proc.WordMinus => NotImpl ("Word.Minus");
    | Proc.WordDivide => NotImpl ("Word.Divide");
    | Proc.WordMod => NotImpl ("Word.Mod");
    | Proc.WordLT => NotImpl ("Word.LT");
    | Proc.WordLE => NotImpl ("Word.LE");
    | Proc.WordGT => NotImpl ("Word.GT");
    | Proc.WordGE => NotImpl ("Word.GE");
    | Proc.WordAnd => NotImpl ("Word.And");
    | Proc.WordOr => NotImpl ("Word.Or");
    | Proc.WordXor => NotImpl ("Word.Xor");
    | Proc.WordNot => NotImpl ("Word.Not");
    | Proc.WordShift => NotImpl ("Word.Shift");
    | Proc.WordLeftShift => NotImpl ("Word.LeftShift");
    | Proc.WordRightShift => NotImpl ("Word.RightShift");
    | Proc.WordRotate => NotImpl ("Word.Rotate");
    | Proc.WordLeftRotate => NotImpl ("Word.LeftRotate");
    | Proc.WordRightRotate => NotImpl ("Word.RightRotate");
    | Proc.WordExtract => NotImpl ("Word.Extract");
    | Proc.WordInsert => NotImpl ("Word.Insert");
    ELSE <* ASSERT FALSE *>  (* ==> NOT PDesc[i].is_const *)
    END;
  END Eval;

PROCEDURE NotImpl (func: TEXT) RAISES {M3Const.Error} =
  BEGIN
    RAISE M3Const.Error ("cannot evaluate builtin function " & func & " yet.");
  END NotImpl;

PROCEDURE MustBe (b: BOOLEAN) RAISES {M3Const.Error} =
  BEGIN
    IF NOT b THEN RAISE M3Const.Error ("not a constant") END;
  END MustBe;

BEGIN
  FOR p := FIRST (PDesc) TO LAST (PDesc) DO
    <*ASSERT PDesc[p].proc = p *>
  END;
END M3Builtin.