// cl_R internals

#ifndef _CL_R_H
#define _CL_R_H

#include "cl_number.h"
#include "cl_real.h"

// Type tests.
inline cl_boolean rationalp (const cl_R& x)
	{ return (cl_boolean)
		 (!x.pointer_p()
		  ? x.nonpointer_tag() == cl_FN_tag
		  : x.pointer_typetag() == cl_typetag_bignum
		    || x.pointer_typetag() == cl_typetag_ratio
		 );
	}
inline cl_boolean integerp (const cl_R& x)
	{ return (cl_boolean)
		 (!x.pointer_p()
		  ? x.nonpointer_tag() == cl_FN_tag
		  : x.pointer_typetag() == cl_typetag_bignum
		 );
	}
inline cl_boolean floatp (const cl_R& x)
	{ return (cl_boolean)
		 (!x.pointer_p()
		  ? x.nonpointer_tag() == cl_SF_tag
		  : x.pointer_typetag() != cl_typetag_bignum
		    && x.pointer_typetag() != cl_typetag_ratio
		 );
	}

// Comparison with a fixnum.
inline cl_boolean eq (const cl_R& x, sint32 y)
{
	return (cl_boolean)(x.word == cl_combine(cl_FN_tag,y));
}

inline cl_boolean exact_zerop (const cl_R& x)
{
	return eq(x,0);
}


// Macro: verteilt je nach Real-Typ eines Floats x auf 2 Statements,
// die x vom jeweiligen Real-Typ benutzen dürfen.
// realcase2(x, RA_statement,F_statement);
// x sollte eine Variable sein.
  #define realcase2(x, RA_statement,F_statement) \
    if (rationalp(x))							     \
      { var cl_RA& __tmp = *(cl_RA*)&x; var cl_RA& x = __tmp; RA_statement } \
    else								     \
      { var cl_F& __tmp = *(cl_F*)&x; var cl_F& x = __tmp; F_statement }

// Macro: verteilt je nach Real-Typ eines Floats x auf 7 Statements.
// realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
// x sollte eine Variable sein.
#ifdef CL_WIDE_POINTERS
  #define realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
    if (!(x).pointer_p())						\
      switch ((x).nonpointer_tag())					\
        { case cl_FN_tag: { FN_statement } break;			\
          case cl_SF_tag: { SF_statement } break;			\
          case cl_FF_tag: { FF_statement } break;			\
          default: NOTREACHED						\
        }								\
      else								\
      switch ((x).pointer_typetag())					\
        { case cl_typetag_bignum: { BN_statement } break;		\
          case cl_typetag_ratio:  { RT_statement } break;		\
          case cl_typetag_dfloat: { DF_statement } break;		\
          case cl_typetag_lfloat: { LF_statement } break;		\
          default: NOTREACHED						\
        }
#else
  #define realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
    if (!(x).pointer_p())						\
      switch ((x).nonpointer_tag())					\
        { case cl_FN_tag: { FN_statement } break;			\
          case cl_SF_tag: { SF_statement } break;			\
          default: NOTREACHED						\
        }								\
      else								\
      switch ((x).pointer_typetag())					\
        { case cl_typetag_bignum: { BN_statement } break;		\
          case cl_typetag_ratio:  { RT_statement } break;		\
          case cl_typetag_ffloat: { FF_statement } break;		\
          case cl_typetag_dfloat: { DF_statement } break;		\
          case cl_typetag_lfloat: { LF_statement } break;		\
          default: NOTREACHED						\
        }
#endif

// Macro: verteilt je nach Real-Typ eines Floats x auf 7 Statements,
// die x vom jeweiligen Real-Typ benutzen dürfen.
// realcase7(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
// x sollte eine Variable sein.
  #define realcase7(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
    realtypecase(x							   \
      , var cl_FN& __tmp = *(cl_FN*)&x; var cl_FN& x = __tmp; FN_statement \
      , var cl_BN& __tmp = *(cl_BN*)&x; var cl_BN& x = __tmp; BN_statement \
      , var cl_RT& __tmp = *(cl_RT*)&x; var cl_RT& x = __tmp; RT_statement \
      , var cl_SF& __tmp = *(cl_SF*)&x; var cl_SF& x = __tmp; SF_statement \
      , var cl_FF& __tmp = *(cl_FF*)&x; var cl_FF& x = __tmp; FF_statement \
      , var cl_DF& __tmp = *(cl_DF*)&x; var cl_DF& x = __tmp; DF_statement \
      , var cl_LF& __tmp = *(cl_LF*)&x; var cl_LF& x = __tmp; LF_statement \
      )

// Macro: verteilt je nach Real-Typ eines Floats x auf 6 Statements,
// die x vom jeweiligen Real-Typ benutzen dürfen.
// realcase6(x, I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
// x sollte eine Variable sein.
  #define realcase6(x, I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
    realcase7(x, I_statement,I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement)

// contagion(x,y) liefert eine reelle Zahl, die so ungenau ist wie die
// ungenauere der beiden reellen Zahlen x und y.
extern cl_R contagion (const cl_R& x, const cl_R& y);
// ?? Lieber ein uintL (0, SF_mant_len+1, FF_mant_len+1, DF_mant_len+1, intDsize*len liefern, weniger Kopieraufwand!

// GEN_R_OP1_2(arg1,R_OP,ergebnis_zuweisung)
// generates the body of a real operation with one argument.
// Distinguish two cases (rational/float) only.
#define GEN_R_OP1_2(arg1,R_OP,ergebnis_zuweisung)  \
{									\
	realcase2(arg1							\
	, ergebnis_zuweisung R_OP(arg1);				\
	, ergebnis_zuweisung R_OP(arg1);				\
	);								\
}

// GEN_R_OP1_7(arg1,R_OP,ergebnis_zuweisung)
// generates the body of a real operation with one argument.
// Full type dispatch, faster than GEN_R_OP1_2.
#define GEN_R_OP1_7(arg1,R_OP,ergebnis_zuweisung)  \
{									\
	realcase7(arg1							\
	, ergebnis_zuweisung R_OP(arg1);				\
	, ergebnis_zuweisung R_OP(arg1);				\
	, ergebnis_zuweisung R_OP(arg1);				\
	, ergebnis_zuweisung R_OP(arg1);				\
	, ergebnis_zuweisung R_OP(arg1);				\
	, ergebnis_zuweisung R_OP(arg1);				\
	, ergebnis_zuweisung R_OP(arg1);				\
	);								\
}

// GEN_R_OP2_2(arg1,arg2,R_OP,ergebnis_zuweisung)
// generates the body of a real operation with two arguments.
// Distinguish two cases (rational/float) only.
#define GEN_R_OP2_2(arg1,arg2,R_OP,ergebnis_zuweisung)  \
{									\
	realcase2(arg1							\
	,	realcase2(arg2						\
		,	/* beides rationale Zahlen */			\
			ergebnis_zuweisung R_OP(arg1,arg2);		\
		,	/* arg1 rational, arg2 Float -> arg1 in Float umwandeln */ \
			ergebnis_zuweisung R_OP(cl_float(arg1,arg2),arg2); \
		);							\
	,	realcase2(arg2						\
		,	/* arg1 Float, arg2 rational -> arg2 in Float umwandeln */ \
			ergebnis_zuweisung R_OP(arg1,cl_float(arg2,arg1)); \
		,	/* beides Floats */				\
			ergebnis_zuweisung R_OP(arg1,arg2);		\
		);							\
	);								\
}

// cl_somefloat(x,y) wandelt eine reelle Zahl x in ein Float-Format um
// (das von y, falls x rational ist) und rundet dabei nötigenfalls.
// > x: eine reelle Zahl
// > y: ein Float
// < ergebnis: x als Float
inline cl_F cl_somefloat (const cl_R& x, const cl_F& y)
{
	if (rationalp(x)) {
		DeclareType(cl_RA,x);
		return cl_float(x,y);
	} else {
		DeclareType(cl_F,x);
		return x;
	}
}

#endif /* _CL_R_H */
