From 62d849396725d34beebd97ac6df79787b8ae327c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 7 Aug 2004 23:59:54 +0000 Subject: [PATCH] fix some compile warnings --- TODO.FACTOR.txt | 7 +- doc/devel-guide.lyx | 103 +++++++++++++++++++---- library/test/math/float.factor | 4 + native/arithmetic.c | 85 ++++++++++++++----- native/arithmetic.h | 144 ++++++++++----------------------- native/float.c | 4 +- 6 files changed, 203 insertions(+), 144 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index c237dd7224..a47e837929 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -10,6 +10,8 @@ - FactorLib.equal() not very good - test substitute, set-nth, remove-nth - do nset-nth, nremove-nth, nsubstitute, ninject +- IN: format base: work with all types of numbers +- native float>bits - tail call optimization broken again - rethink strhead/strtail&co @@ -23,7 +25,6 @@ + native: -- native float>bits - do something about "base" variable -- too fragile ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ] - errors: don't show .factor-rc @@ -44,10 +45,6 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable - inspector links when describe called without object path - 'cascading' styles -+ math: - -- IN: format base: work with all types of numbers - + compiler: - don't compile inline words diff --git a/doc/devel-guide.lyx b/doc/devel-guide.lyx index cf20c4c80d..7f35525fa9 100644 --- a/doc/devel-guide.lyx +++ b/doc/devel-guide.lyx @@ -3412,7 +3412,7 @@ list>vector . \layout Subsection -Vector manipulation +Working with vectors \layout Standard @@ -3970,7 +3970,7 @@ CHAR: A 1 + CHAR: B = . t \layout Subsection -String manipulation +Working with strings \layout Standard String words are found in the @@ -3980,6 +3980,15 @@ strings vocabulary. String manipulation words always return a new copy of a string rather than modifying the string in-place. + Notice the absence of words such as +\family typewriter +set-str-nth +\family default + and +\family typewriter +set-str-length +\family default +. Unlike lists, for which both constructive and destuctive manipulation words are provided, destructive string operations are only done with a distinct string buffer type, which is described in the next section. @@ -4034,23 +4043,87 @@ str-nth ( n str -- ch ) 32 \layout Standard -Notice the lack of operations such as + \family typewriter -set-str-nth +index-of ( str substr -- n ) \family default - and -\family typewriter -set-str-length -\family default -. - Instead, strings can be sliced using words such as -\family typewriter -substring -\family default -, and concatenated together using an intermediate string buffer. + searches a string for the first occurrence of a substring or character. + If an occurrence was found, its index is pushed. + Otherwise, -1 is pushed: +\layout LyX-Code + + +\begin_inset Quotes eld +\end_inset + +www.sun.com +\begin_inset Quotes erd +\end_inset + + CHAR: . + index-of . +\layout LyX-Code + + +\emph on +3 +\layout LyX-Code + + +\begin_inset Quotes eld +\end_inset + +mailto:billg@microsoft.com +\begin_inset Quotes erd +\end_inset + + CHAR: / index-of . +\layout LyX-Code + + +\emph on +-1 +\layout LyX-Code + + +\begin_inset Quotes eld +\end_inset + +www.lispworks.com +\begin_inset Quotes erd +\end_inset + + +\begin_inset Quotes eld +\end_inset + +.com +\begin_inset Quotes erd +\end_inset + + index-of . +\layout LyX-Code + + +\emph on +13 \layout Standard -index-of, substring, cat2/3/4/5, cat + +\family typewriter +index-of* ( n str substr -- n ) +\family default + works like index-of, except it takes a start index as an argument. +\layout Standard + + +\family typewriter +substring ( start end str -- substr ) +\family default + extracts a range of characters from a string into a new string. +\layout Standard + +cat2/3/4/5, cat \layout Subsection String buffers diff --git a/library/test/math/float.factor b/library/test/math/float.factor index 4b4d4b2fb1..6830e1306d 100644 --- a/library/test/math/float.factor +++ b/library/test/math/float.factor @@ -30,3 +30,7 @@ USE: test [ t ] [ pi 3 > ] unit-test [ f ] [ e 2 <= ] unit-test + +[ 4607182418800017408 ] [ 1.0 float>bits ] unit-test +[ 4614256656552045848 ] [ pi float>bits ] unit-test +[ 4613303445314885481 ] [ e float>bits ] unit-test diff --git a/native/arithmetic.c b/native/arithmetic.c index b3cca3ff2b..7ddd6c5638 100644 --- a/native/arithmetic.c +++ b/native/arithmetic.c @@ -110,23 +110,68 @@ CELL number_eq_anytype(CELL x, CELL y) return F; } - /* op */ /* anytype */ /* integer only */ -BINARY_OP(number_eq, true, false) -BINARY_OP(add, false, false) -BINARY_OP(subtract, false, false) -BINARY_OP(multiply, false, false) -BINARY_OP(divide, false, false) -BINARY_OP(divint, false, true) -BINARY_OP(divfloat, false, false) -BINARY_OP(divmod, false, true) -BINARY_OP(mod, false, true) -BINARY_OP(and, false, true) -BINARY_OP(or, false, true) -BINARY_OP(xor, false, true) -BINARY_OP(shiftleft, false, true) -BINARY_OP(shiftright,false, true) -BINARY_OP(less, false, false) -BINARY_OP(lesseq, false, false) -BINARY_OP(greater, false, false) -BINARY_OP(greatereq, false, false) -BINARY_OP(gcd, false, true) + +BINARY_OP(number_eq) + +BINARY_OP_NUMBER_ONLY(add) +BINARY_OP(add) + +BINARY_OP_NUMBER_ONLY(subtract) +BINARY_OP(subtract) + +BINARY_OP_NUMBER_ONLY(multiply) +BINARY_OP(multiply) + +BINARY_OP_NUMBER_ONLY(divide) +BINARY_OP(divide) + +BINARY_OP_INTEGER_ONLY(divint) +BINARY_OP_NUMBER_ONLY(divint) +BINARY_OP(divint) + +BINARY_OP_NUMBER_ONLY(divfloat) +BINARY_OP(divfloat) + +BINARY_OP_INTEGER_ONLY(divmod) +BINARY_OP_NUMBER_ONLY(divmod) +BINARY_OP(divmod) + +BINARY_OP_INTEGER_ONLY(mod) +BINARY_OP_NUMBER_ONLY(mod) +BINARY_OP(mod) + +BINARY_OP_INTEGER_ONLY(and) +BINARY_OP_NUMBER_ONLY(and) +BINARY_OP(and) + +BINARY_OP_INTEGER_ONLY(or) +BINARY_OP_NUMBER_ONLY(or) +BINARY_OP(or) + +BINARY_OP_INTEGER_ONLY(xor) +BINARY_OP_NUMBER_ONLY(xor) +BINARY_OP(xor) + +BINARY_OP_INTEGER_ONLY(shiftleft) +BINARY_OP_NUMBER_ONLY(shiftleft) +BINARY_OP(shiftleft) + +BINARY_OP_INTEGER_ONLY(shiftright) +BINARY_OP_NUMBER_ONLY(shiftright) +BINARY_OP(shiftright) + +BINARY_OP_NUMBER_ONLY(less) +BINARY_OP(less) + +BINARY_OP_NUMBER_ONLY(lesseq) +BINARY_OP(lesseq) + +BINARY_OP_NUMBER_ONLY(greater) +BINARY_OP(greater) + +BINARY_OP_NUMBER_ONLY(greatereq) +BINARY_OP(greatereq) + +BINARY_OP_INTEGER_ONLY(gcd) +BINARY_OP_NUMBER_ONLY(gcd) +BINARY_OP(gcd) diff --git a/native/arithmetic.h b/native/arithmetic.h index 7954a48f23..c055c33290 100644 --- a/native/arithmetic.h +++ b/native/arithmetic.h @@ -22,7 +22,7 @@ FLOAT* ratio_to_float(CELL n); else \ return tag_fixnum(_result); -#define BINARY_OP(OP,anytype,integerOnly) \ +#define BINARY_OP(OP) \ CELL OP(CELL x, CELL y) \ { \ switch(type_of(x)) \ @@ -34,48 +34,18 @@ CELL OP(CELL x, CELL y) \ case FIXNUM_TYPE: \ return OP##_fixnum(x,y); \ case RATIO_TYPE: \ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,y); \ - return F; \ - } \ - else \ - return OP##_ratio((CELL)fixnum_to_ratio(x),y); \ + return OP##_ratio((CELL)fixnum_to_ratio(x),y); \ case COMPLEX_TYPE: \ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,y); \ - return F; \ - } \ - else \ - return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \ + return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \ case BIGNUM_TYPE: \ return OP##_bignum((CELL)fixnum_to_bignum(x),y); \ case FLOAT_TYPE: \ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,y); \ - return F; \ - } \ - else \ - return OP##_float((CELL)fixnum_to_float(x),y); \ + return OP##_float((CELL)fixnum_to_float(x),y); \ default: \ - if(anytype) \ - return OP##_anytype(x,y); \ - else \ - { \ - type_error(NUMBER_TYPE,x); \ - return F; \ - } \ + return OP##_anytype(x,y); \ } \ \ case RATIO_TYPE: \ -\ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,x); \ - return F; \ - } \ \ switch(type_of(y)) \ { \ @@ -90,22 +60,10 @@ CELL OP(CELL x, CELL y) \ case FLOAT_TYPE: \ return OP##_float((CELL)ratio_to_float(x),y); \ default: \ - if(anytype) \ - return OP##_anytype(x,y); \ - else \ - { \ - type_error(NUMBER_TYPE,x); \ - return F; \ - } \ + return OP##_anytype(x,y); \ } \ \ case COMPLEX_TYPE: \ -\ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,x); \ - return F; \ - } \ \ switch(type_of(y)) \ { \ @@ -120,13 +78,7 @@ CELL OP(CELL x, CELL y) \ case FLOAT_TYPE: \ return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \ default: \ - if(anytype) \ - return OP##_anytype(x,y); \ - else \ - { \ - type_error(NUMBER_TYPE,x); \ - return F; \ - } \ + return OP##_anytype(x,y); \ } \ \ case BIGNUM_TYPE: \ @@ -136,48 +88,18 @@ CELL OP(CELL x, CELL y) \ case FIXNUM_TYPE: \ return OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \ case RATIO_TYPE: \ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,y); \ - return F; \ - } \ - else \ - return OP##_ratio((CELL)bignum_to_ratio(x),y); \ + return OP##_ratio((CELL)bignum_to_ratio(x),y); \ case COMPLEX_TYPE: \ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,y); \ - return F; \ - } \ - else \ - return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \ + return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \ case BIGNUM_TYPE: \ return OP##_bignum(x,y); \ case FLOAT_TYPE: \ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,y); \ - return F; \ - } \ - else \ - return OP##_float((CELL)bignum_to_float(x),y); \ + return OP##_float((CELL)bignum_to_float(x),y); \ default: \ - if(anytype) \ - return OP##_anytype(x,y); \ - else \ - { \ - type_error(NUMBER_TYPE,x); \ - return F; \ - } \ + return OP##_anytype(x,y); \ } \ \ case FLOAT_TYPE: \ -\ - if(integerOnly) \ - { \ - type_error(INTEGER_TYPE,x); \ - return F; \ - } \ \ switch(type_of(y)) \ { \ @@ -192,24 +114,12 @@ CELL OP(CELL x, CELL y) \ case FLOAT_TYPE: \ return OP##_float(x,y); \ default: \ - if(anytype) \ - return OP##_anytype(x,y); \ - else \ - { \ - type_error(NUMBER_TYPE,x); \ - return F; \ - } \ + return OP##_anytype(x,y); \ } \ \ default: \ \ - if(anytype) \ - return OP##_anytype(x,y); \ - else \ - { \ - type_error(NUMBER_TYPE,x); \ - return F; \ - } \ + return OP##_anytype(x,y); \ } \ } \ \ @@ -219,6 +129,34 @@ void primitive_##OP(void) \ env.dt = OP(x,y); \ } +#define BINARY_OP_INTEGER_ONLY(OP) \ +\ +CELL OP##_ratio(CELL x, CELL y) \ +{ \ + type_error(INTEGER_TYPE,x); \ + return F; \ +} \ +\ +CELL OP##_complex(CELL x, CELL y) \ +{ \ + type_error(INTEGER_TYPE,x); \ + return F; \ +} \ +\ +CELL OP##_float(CELL x, CELL y) \ +{ \ + type_error(INTEGER_TYPE,x); \ + return F; \ +} + +#define BINARY_OP_NUMBER_ONLY(OP) \ +\ +CELL OP##_anytype(CELL x, CELL y) \ +{ \ + type_error(NUMBER_TYPE,x); \ + return F; \ +} + #define UNARY_OP(OP,anytype,integerOnly) \ CELL OP(CELL x) \ { \ diff --git a/native/float.c b/native/float.c index 48aefb8244..40121498b0 100644 --- a/native/float.c +++ b/native/float.c @@ -50,7 +50,9 @@ void primitive_float_to_str(void) void primitive_float_to_bits(void) { - /* FIXME */ + double f = untag_float(env.dt); + BIGNUM_2 f_raw = *(BIGNUM_2*)&f; + env.dt = tag_object(bignum(f_raw)); } CELL number_eq_float(CELL x, CELL y)