slightly faster type checking

native/arithmetic.c

@@ -31,28 +31,37 @@ CELL to_cell(CELL x)
 	}
 }
 
-CELL upgraded_arithmetic_type(CELL type1, CELL type2)
+void primitive_arithmetic_type(void)
 {
+	CELL type2 = type_of(dpop());
+	CELL type1 = type_of(dpop());
+	CELL type;
+
 	switch(type1)
 	{
 	case FIXNUM_TYPE:
-		return type2;
+		type = type2;
+		break;
 	case BIGNUM_TYPE:
 		switch(type2)
 		{
 		case FIXNUM_TYPE:
-			return type1;
+			type = type1;
+			break;
 		default:
-			return type2;
+			type = type2;
+			break;
 		}
 	case RATIO_TYPE:
 		switch(type2)
 		{
 		case FIXNUM_TYPE:
 		case BIGNUM_TYPE:
-			return type1;
+			type = type1;
+			break;
 		default:
-			return type2;
+			type = type2;
+			break;
 		}
 	case FLOAT_TYPE:
 		switch(type2)
@@ -60,9 +69,11 @@ CELL upgraded_arithmetic_type(CELL type1, CELL type2)
 		case FIXNUM_TYPE:
 		case BIGNUM_TYPE:
 		case RATIO_TYPE:
-			return type1;
+			type = type1;
+			break;
 		default:
-			return type2;
+			type = type2;
+			break;
 		}
 	case COMPLEX_TYPE:
 		switch(type2)
@@ -71,20 +82,17 @@ CELL upgraded_arithmetic_type(CELL type1, CELL type2)
 		case BIGNUM_TYPE:
 		case RATIO_TYPE:
 		case FLOAT_TYPE:
-			return type1;
+			type = type1;
+			break;
 		default:
-			return type2;
+			type = type2;
+			break;
 		}
 	default:
-		return type1;
+		type = type1;
+		break;
 	}
-}
+	dpush(tag_fixnum(type));
-
-void primitive_arithmetic_type(void)
-{
-	CELL type2 = type_of(dpop());
-	CELL type1 = type_of(dpop());
-	dpush(tag_fixnum(upgraded_arithmetic_type(type1,type2)));
 }
 
 bool realp(CELL tagged)

native/arithmetic.h

@@ -1,6 +1,5 @@
 #include "factor.h"
 
-CELL upgraded_arithmetic_type(CELL type1, CELL type2);
 void primitive_arithmetic_type(void);
 
 CELL tag_integer(FIXNUM x);

native/complex.c

@@ -1,21 +1,5 @@
 #include "factor.h"
 
-COMPLEX* complex(CELL real, CELL imaginary)
-{
-	COMPLEX* complex = allot(sizeof(COMPLEX));
-	complex->real = real;
-	complex->imaginary = imaginary;
-	return complex;
-}
-
-CELL possibly_complex(CELL real, CELL imaginary)
-{
-	if(zerop(imaginary))
-		return real;
-	else
-		return tag_complex(complex(real,imaginary));
-}
-
 void primitive_real(void)
 {
 	switch(type_of(dpeek()))
@@ -87,5 +71,13 @@ void primitive_from_rect(void)
 	if(!realp(real))
 		type_error(REAL_TYPE,real);
 
-	dpush(possibly_complex(real,imaginary));
+	if(zerop(imaginary))
+		dpush(real);
+	else
+	{
+		COMPLEX* complex = allot(sizeof(COMPLEX));
+		complex->real = real;
+		complex->imaginary = imaginary;
+		dpush(tag_complex(complex));
+	}
 }

native/complex.h

@@ -14,21 +14,7 @@ INLINE CELL tag_complex(COMPLEX* complex)
 	return RETAG(complex,COMPLEX_TYPE);
 }
 
-COMPLEX* complex(CELL real, CELL imaginary);
-COMPLEX* to_complex(CELL x);
-CELL possibly_complex(CELL real, CELL imaginary);
-
 void primitive_real(void);
 void primitive_imaginary(void);
 void primitive_to_rect(void);
 void primitive_from_rect(void);
-CELL number_eq_complex(COMPLEX* x, COMPLEX* y);
-CELL add_complex(COMPLEX* x, COMPLEX* y);
-CELL subtract_complex(COMPLEX* x, COMPLEX* y);
-CELL multiply_complex(COMPLEX* x, COMPLEX* y);
-CELL divide_complex(COMPLEX* x, COMPLEX* y);
-CELL divfloat_complex(COMPLEX* x, COMPLEX* y);
-CELL less_complex(COMPLEX* x, COMPLEX* y);
-CELL lesseq_complex(COMPLEX* x, COMPLEX* y);
-CELL greater_complex(COMPLEX* x, COMPLEX* y);
-CELL greatereq_complex(COMPLEX* x, COMPLEX* y);

native/ratio.c

@@ -1,13 +1,5 @@
 #include "factor.h"
 
-RATIO* ratio(CELL numerator, CELL denominator)
-{
-	RATIO* ratio = allot(sizeof(RATIO));
-	ratio->numerator = numerator;
-	ratio->denominator = denominator;
-	return ratio;
-}
-
 /* Does not reduce to lowest terms, so should only be used by math
 library implementation, to avoid breaking invariants. */
 void primitive_from_fraction(void)
@@ -19,7 +11,12 @@ void primitive_from_fraction(void)
 	if(onep(denominator))
 		dpush(numerator);
 	else
-		dpush(tag_ratio(ratio(numerator,denominator)));
+	{
+		RATIO* ratio = allot(sizeof(RATIO));
+		ratio->numerator = numerator;
+		ratio->denominator = denominator;
+		dpush(tag_ratio(ratio));
+	}
 }
 
 void primitive_to_fraction(void)

native/ratio.h

@@ -14,20 +14,7 @@ INLINE CELL tag_ratio(RATIO* ratio)
 	return RETAG(ratio,RATIO_TYPE);
 }
 
-RATIO* ratio(CELL numerator, CELL denominator);
-RATIO* to_ratio(CELL x);
-
 void primitive_numerator(void);
 void primitive_denominator(void);
 void primitive_from_fraction(void);
 void primitive_to_fraction(void);
-CELL number_eq_ratio(RATIO* x, RATIO* y);
-CELL add_ratio(RATIO* x, RATIO* y);
-CELL subtract_ratio(RATIO* x, RATIO* y);
-CELL multiply_ratio(RATIO* x, RATIO* y);
-CELL divide_ratio(RATIO* x, RATIO* y);
-CELL divfloat_ratio(RATIO* x, RATIO* y);
-CELL less_ratio(RATIO* x, RATIO* y);
-CELL lesseq_ratio(RATIO* x, RATIO* y);
-CELL greater_ratio(RATIO* x, RATIO* y);
-CELL greatereq_ratio(RATIO* x, RATIO* y);

native/types.c

@@ -19,12 +19,6 @@ bool typep(CELL type, CELL tagged)
 	return type_of(tagged) == type;
 }
 
-void type_check(CELL type, CELL tagged)
-{
-	if(type_of(tagged) != type)
-		type_error(type,tagged);
-}
-
 /*
  * It is up to the caller to fill in the object's fields in a meaningful
  * fashion!

native/types.h

@@ -42,7 +42,6 @@ CELL T;
 
 CELL type_of(CELL tagged);
 bool typep(CELL type, CELL tagged);
-void type_check(CELL type, CELL tagged);
 
 INLINE CELL tag_boolean(CELL untagged)
 {
@@ -79,6 +78,17 @@ INLINE CELL object_type(CELL tagged)
 	return untag_header(get(UNTAG(tagged)));
 }
 
+INLINE void type_check(CELL type, CELL tagged)
+{
+	if(type < HEADER_TYPE)
+	{
+		if(TAG(tagged) != type)
+			type_error(type,tagged);
+	}
+	else if(object_type(tagged) != type)
+		type_error(type,tagged);
+}
+
 void* allot_object(CELL type, CELL length);
 CELL untagged_object_size(CELL pointer);
 CELL object_size(CELL pointer);