before generic arithmetic cleanup

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index f94c01716673ba661792f635c0bdf62a33c90214..6edc64e24d21b54d823617ed8aa77369eac91bd2 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,6 +1,7 @@
 [error] SideKick$BufferChangeHandler: We have cplusplus.xml (/home/slava/jEdit/modes/) but got event for DefaultInputHandler.java (/home/slava/jEdit/org/gjt/sp/jedit/gui/)\r
 [error] SideKick$BufferChangeHandler: We have cplusplus.xml (/home/slava/jEdit/modes/) but got event for DefaultInputHandler.java (/home/slava/jEdit/org/gjt/sp/jedit/gui/)\r
 \r
+- buffer change handler in sidekick is screwed\r
 - dec> bin> oct> hex> throw errors\r
 - parse-number doesn't\r
 - eval with multilien strings and #!\r

diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor
index 0db105185e465b739adb730c42494966f86e7141..75df9e61c97c8f2e4baa88c8f9d2278e67984c6b 100644 (file)
--- a/library/cross-compiler.factor
+++ b/library/cross-compiler.factor
@@ -78,7 +78,6 @@ DEFER: cwd
 DEFER: cd
 
 IN: io-internals
-DEFER: port?
 DEFER: open-file
 DEFER: client-socket
 DEFER: server-socket
@@ -100,7 +99,8 @@ DEFER: next-io-task
 
 IN: math
 DEFER: number=
-DEFER: /i
+DEFER: >fraction
+DEFER: fraction>
 
 IN: parser
 DEFER: str>float
@@ -139,19 +139,16 @@ IN: image
         execute
         call
         ifte
-        cons?
         cons
         car
         cdr
         set-car
         set-cdr
-        vector?
         <vector>
         vector-length
         set-vector-length
         vector-nth
         set-vector-nth
-        string?
         str-length
         str-nth
         str-compare
@@ -160,7 +157,6 @@ IN: image
         index-of*
         substring
         str-reverse
-        sbuf?
         <sbuf>
         sbuf-length
         set-sbuf-length
@@ -176,16 +172,13 @@ IN: image
         >bignum
         >float
         number=
-        fixnum?
-        bignum?
-        ratio?
         numerator
         denominator
-        float?
+        >fraction
+        fraction>
         str>float
         unparse-float
         float>bits
-        complex?
         real
         imaginary
         >rect
@@ -219,7 +212,6 @@ IN: image
         fsin
         fsinh
         fsqrt
-        word?
         <word>
         word-hashcode
         word-xt
@@ -252,7 +244,6 @@ IN: image
         callstack
         set-datastack
         set-callstack
-        port?
         exit*
         client-socket
         server-socket

diff --git a/library/math/constants.factor b/library/math/constants.factor
index 36fd30b0a3c428ffc2e8d6b9653fc062aab8fbde..9b68d43ec647959ca371d120fea9fe31e1e6eebc 100644 (file)
--- a/library/math/constants.factor
+++ b/library/math/constants.factor
@@ -35,3 +35,6 @@ USE: kernel
 : e 2.7182818284590452354 ; inline
 : pi 3.14159265358979323846 ; inline
 : pi/2 1.5707963267948966 ; inline
+
+: deg>rad pi * 180 / ;
+: rad>deg 180 * pi / ;

diff --git a/library/math/trig-hyp.factor b/library/math/trig-hyp.factor
index 02936dd0f2e6ff64453505f65c61672af0b0fc7d..e7509f127ce37dbe2ebe9999a6c165d61dc6139b 100644 (file)
--- a/library/math/trig-hyp.factor
+++ b/library/math/trig-hyp.factor
@@ -38,9 +38,6 @@ USE: stack
 ! Hyperbolic functions:
 !    cosh sech sinh cosech tanh coth
 
-: deg>rad pi * 180 / ;
-: rad>deg 180 * pi / ;
-
 : cos ( z -- cos )
     >rect 2dup
     fcosh swap fcos * -rot

diff --git a/library/platform/jvm/boot-mini.factor b/library/platform/jvm/boot-mini.factor
index 741420eea1bd0e268c5864075f730602048964db..8dce73547698b7f071bad402011cbd147a8c09fa 100644 (file)
--- a/library/platform/jvm/boot-mini.factor
+++ b/library/platform/jvm/boot-mini.factor
@@ -75,11 +75,13 @@ USE: parser
 
 !!! Math library.
 "/library/platform/jvm/real-math.factor" run-resource ! real-math
+"/library/math/constants.factor"         run-resource ! math
 "/library/math/math.factor"              run-resource ! math
 "/library/math/pow.factor"               run-resource ! math
 "/library/math/list-math.factor"         run-resource ! math
 
 !!! Development tools.
+"/library/platform/jvm/processes.factor"   run-resource ! processes
 "/library/vocabulary-style.factor"         run-resource ! style
 "/library/prettyprint.factor"              run-resource ! prettyprint
 "/library/platform/jvm/prettyprint.factor" run-resource ! prettyprint

diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor
index 0018cfcae5d43edd6003dc8ace45e023e80d91e4..ed112c4d3b7cb35ccec699917ac443821773d7f5 100644 (file)
--- a/library/platform/native/boot.factor
+++ b/library/platform/native/boot.factor
@@ -32,6 +32,7 @@ primitives,
 [
     "/library/platform/native/kernel.factor"
     "/library/platform/native/stack.factor"
+    "/library/platform/native/types.factor"
     "/library/cons.factor"
     "/library/combinators.factor"
     "/library/logic.factor"

diff --git a/library/platform/native/math.factor b/library/platform/native/math.factor
index 3dbaa5343c51225239f601b4c9c52297d716929f..fc626d085bd6781d783c2aa48dd55144fb2e6574 100644 (file)
--- a/library/platform/native/math.factor
+++ b/library/platform/native/math.factor
@@ -30,9 +30,6 @@ USE: combinators
 USE: kernel
 USE: stack
 
-: bignum? ( obj -- ? ) type-of 13 eq? ;
-: complex? ( obj -- ? ) type-of 5 eq? ;
-
 : (gcd) ( x y -- z )
     dup 0 = [ drop ] [ tuck mod (gcd) ] ifte ;
 

diff --git a/library/platform/native/primitives.factor b/library/platform/native/primitives.factor
index 875b1d00747fdf91004bac8ae824d852f7fb4f7f..6fadf81d87be6405385a31616b702b5028fb2b21 100644 (file)
--- a/library/platform/native/primitives.factor
+++ b/library/platform/native/primitives.factor
@@ -47,19 +47,16 @@ USE: words
     [ execute                | " word -- " ]
     [ call                   | " quot -- " ]
     [ ifte                   | " cond true false -- " ]
-    [ cons?                  | " obj -- ? " ]
     [ cons                   | " car cdr -- [ car | cdr ] " ]
     [ car                    | " [ car | cdr ] -- car " ]
     [ cdr                    | " [ car | cdr ] -- cdr " ]
     [ set-car                | " car cons -- " ]
     [ set-cdr                | " cdr cons -- " ]
-    [ vector?                | " obj -- ? " ]
     [ <vector>               | " capacity -- vector" ]
     [ vector-length          | " vector -- n " ]
     [ set-vector-length      | " n vector -- " ]
     [ vector-nth             | " n vector -- obj " ]
     [ set-vector-nth         | " obj n vector -- " ]
-    [ string?                | " obj -- ? " ]
     [ str-length             | " str -- n " ]
     [ str-nth                | " n str -- ch " ]
     [ str-compare            | " str str -- -1/0/1 " ]
@@ -67,7 +64,6 @@ USE: words
     [ str-hashcode           | " str -- n " ]
     [ index-of*              | " n str/ch str -- n " ]
     [ substring              | " start end str -- str "]
-    [ sbuf?                  | " obj -- ? " ]
     [ <sbuf>                 | " capacity -- sbuf " ]
     [ sbuf-length            | " sbuf -- n " ]
     [ set-sbuf-length        | " n sbuf -- " ]
@@ -83,12 +79,10 @@ USE: words
     [ >bignum                | " n -- bignum " ]
     [ >float                 | " n -- float " ]
     [ number=                | " n n -- ? " ]
-    [ fixnum?                | " obj -- ? " ]
-    [ bignum?                | " obj -- ? " ]
-    [ ratio?                 | " obj -- ? " ]
     [ numerator              | " a/b -- a " ]
     [ denominator            | " a/b -- b " ]
-    [ float?                 | " obj -- ? " ]
+    [ >fraction              | " a/b -- a b " ]
+    [ fraction>              | " a b -- a/b " ]
     [ str>float              | " str -- float " ]
     [ unparse-float          | " float -- str " ]
     [ float>bits             | " float -- n " ]
@@ -126,7 +120,6 @@ USE: words
     [ fsin                   | " x -- y " ]
     [ fsinh                  | " x -- y " ]
     [ fsqrt                  | " x -- y " ]
-    [ word?                  | " obj -- ? " ]
     [ <word>                 | " prim param plist -- word " ]
     [ word-hashcode          | " word -- n " ]
     [ word-primitive         | " word -- n " ]
@@ -157,7 +150,6 @@ USE: words
     [ callstack              | " -- cs " ]
     [ set-datastack          | " ds -- " ]
     [ set-callstack          | " cs -- " ]
-    [ port?                  | " obj -- ? " ]
     [ exit*                  | " n -- " ]
     [ client-socket          | " host port -- in out " ]
     [ server-socket          | " port -- server " ]

diff --git a/library/platform/native/types.factor b/library/platform/native/types.factor
new file mode 100644 (file)
index 0000000..1ccf614
--- /dev/null
+++ b/library/platform/native/types.factor
@@ -0,0 +1,41 @@
+! :folding=indent:collapseFolds=0:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+USE: kernel
+
+IN: math         : fixnum?  ( obj -- ? ) type-of 0  eq? ;
+IN: words        : word?    ( obj -- ? ) type-of 1  eq? ;
+IN: lists        : cons?    ( obj -- ? ) type-of 2  eq? ;
+IN: math         : ratio?   ( obj -- ? ) type-of 4  eq? ;
+IN: math         : complex? ( obj -- ? ) type-of 5  eq? ;
+IN: vectors      : vector?  ( obj -- ? ) type-of 9  eq? ;
+IN: strings      : string?  ( obj -- ? ) type-of 10 eq? ;
+IN: strings      : sbuf?    ( obj -- ? ) type-of 11 eq? ;
+IN: io-internals : port?    ( obj -- ? ) type-of 12 eq? ;
+IN: math         : bignum?  ( obj -- ? ) type-of 13 eq? ;
+IN: math         : float?   ( obj -- ? ) type-of 14 eq? ;
+IN: alien        : dll?     ( obj -- ? ) type-of 15 eq? ;

diff --git a/library/vocabularies.factor b/library/vocabularies.factor
index 49e4bd731c2ba474fa1938f4fb091c24c73e50a7..cb5ecb9b658f122e53432a1bb3f5b537be737143 100644 (file)
--- a/library/vocabularies.factor
+++ b/library/vocabularies.factor
@@ -92,6 +92,7 @@ USE: strings
         "namespaces"
         "parser"
         "prettyprint"
+        "processes"
         "stack"
         "streams"
         "stdio"

diff --git a/native/arithmetic.c b/native/arithmetic.c
index c1d2a6c1ddd7063bff1ae7f2472fabeb21875027..b7c06a3ef9b368f05a9a0361548b9da7dc8f75a6 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -113,9 +113,29 @@ bool zerop(CELL tagged)
        case FLOAT_TYPE:
                return ((FLOAT*)UNTAG(tagged))->n == 0.0;
        case RATIO_TYPE:
+       case COMPLEX_TYPE:
+               return false;
+       default:
+               type_error(NUMBER_TYPE,tagged);
+               return false; /* Can't happen */
+       }
+}
+
+bool onep(CELL tagged)
+{
+       switch(type_of(tagged))
+       {
+       case FIXNUM_TYPE:
+               return tagged == 1;
+       case BIGNUM_TYPE:
+               return BIGNUM_ONE_P((ARRAY*)UNTAG(tagged),0);
+       case FLOAT_TYPE:
+               return ((FLOAT*)UNTAG(tagged))->n == 1.0;
+       case RATIO_TYPE:
+       case COMPLEX_TYPE:
                return false;
        default:
-               critical_error("Bad parameter to zerop",tagged);
+               type_error(NUMBER_TYPE,tagged);
                return false; /* Can't happen */
        }
 }

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 3479736b7b3d4b793df68fb7f154f07ca350f171..c93e81d3bb5186aa47265ebb957713a87a11588f 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -138,6 +138,7 @@ bool realp(CELL tagged);
 void primitive_numberp(void);
 
 bool zerop(CELL tagged);
+bool onep(CELL tagged);
 
 void primitive_to_fixnum(void);
 void primitive_to_bignum(void);
@@ -177,4 +178,4 @@ void primitive_xor(void);
 CELL shift(CELL x, FIXNUM y);
 void primitive_shift(void);
 CELL gcd(CELL x, CELL y);
-void primitive_gcd(void);
+void primitive_not(void);

diff --git a/native/cons.c b/native/cons.c
index 13dd058fb469a022e2753319234adf6e39f1e8d6..0a897090fce8938d37c464316261240a5a0a9a3e 100644 (file)
--- a/native/cons.c
+++ b/native/cons.c
@@ -8,11 +8,6 @@ CELL cons(CELL car, CELL cdr)
        return tag_cons(cons);
 }
 
-void primitive_consp(void)
-{
-       drepl(tag_boolean(typep(CONS_TYPE,dpeek())));
-}
-
 void primitive_cons(void)
 {
        CELL cdr = dpop();

diff --git a/native/cons.h b/native/cons.h
index 3cb1999df8729fef39b4bd7116069087f47144f7..2cab122e829b9c57b694f8ea7f1d5d79e74b3094 100644 (file)
--- a/native/cons.h
+++ b/native/cons.h
@@ -26,7 +26,6 @@ INLINE CELL cdr(CELL cons)
        return untag_cons(cons)->cdr;
 }
 
-void primitive_consp(void);
 void primitive_cons(void);
 void primitive_car(void);
 void primitive_cdr(void);

diff --git a/native/fixnum.c b/native/fixnum.c
index da2b80c449ae519d991b9808f2d9a8f4f1012b70..9811538efe4fd7bd9b7f90fbdde9cd0afdca96cc 100644 (file)
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -1,10 +1,5 @@
 #include "factor.h"
 
-void primitive_fixnump(void)
-{
-       drepl(tag_boolean(TAG(dpeek()) == FIXNUM_TYPE));
-}
-
 FIXNUM to_fixnum(CELL tagged)
 {
        RATIO* r;

diff --git a/native/fixnum.h b/native/fixnum.h
index 9c463845765f80b1554fb8b6aebda79b81a7ef52..3ee39575c22b6d52fde9c97963d8612f1260f513 100644 (file)
--- a/native/fixnum.h
+++ b/native/fixnum.h
@@ -13,9 +13,6 @@ INLINE CELL tag_fixnum(FIXNUM untagged)
        return RETAG(untagged << TAG_BITS,FIXNUM_TYPE);
 }
 
-void primitive_fixnump(void);
-void primitive_not(void);
-
 FIXNUM to_fixnum(CELL tagged);
 void primitive_to_fixnum(void);
 

diff --git a/native/float.c b/native/float.c
index d7ac05ba5aac2e76f7e506c622a17f59f7142a4a..4c6833ab62893abf03beb980f188ed7ad54a2710 100644 (file)
--- a/native/float.c
+++ b/native/float.c
@@ -1,10 +1,5 @@
 #include "factor.h"
 
-void primitive_floatp(void)
-{
-       drepl(tag_boolean(typep(FLOAT_TYPE,dpeek())));
-}
-
 FLOAT* to_float(CELL tagged)
 {
        RATIO* r;

diff --git a/native/float.h b/native/float.h
index 07b7c4bdb9c036fbb6d17f42c0366e989d557ebe..c37a6f79e2816d349fc64ade48851cde6fd1d890 100644 (file)
--- a/native/float.h
+++ b/native/float.h
@@ -21,7 +21,6 @@ INLINE double untag_float(CELL tagged)
        return untag_float_fast(tagged);
 }
 
-void primitive_floatp(void);
 FLOAT* to_float(CELL tagged);
 void primitive_to_float(void);
 void primitive_str_to_float(void);

diff --git a/native/memory.c b/native/memory.c
index cd374235888640ca2d5e217681f4fa1598699a00..97125da68bc2d3f624ba26c24df6cfc418295619 100644 (file)
--- a/native/memory.c
+++ b/native/memory.c
@@ -113,7 +113,7 @@ void primitive_allot_profiling(void)
 #endif
 }
 
-void primitive_address_of(void)
+void primitive_address(void)
 {
        dpush(tag_object(s48_ulong_to_bignum(dpop())));
 }

diff --git a/native/memory.h b/native/memory.h
index 8af98fcd0fe7f758917e8a33cec698e7e3dd56fe..1c3b0d9917a22746d85259ce8011be33b3ef9585 100644 (file)
--- a/native/memory.h
+++ b/native/memory.h
@@ -69,4 +69,4 @@ bool in_zone(ZONE* z, CELL pointer);
 
 void primitive_room(void);
 void primitive_allot_profiling(void);
-void primitive_address_of(void);
+void primitive_address(void);

diff --git a/native/port.c b/native/port.c
index e9937fa38b427a23206f5f3c843775f01541afa5..38e463ea8ff810125e8cef9a52340ea06f7a79f4 100644 (file)
--- a/native/port.c
+++ b/native/port.c
@@ -44,11 +44,6 @@ void init_line_buffer(PORT* port, FIXNUM count)
                port->line = tag_object(sbuf(LINE_SIZE));
 }
 
-void primitive_portp(void)
-{
-       drepl(tag_boolean(typep(PORT_TYPE,dpeek())));
-}
-
 void fixup_port(PORT* port)
 {
        port->fd = -1;

diff --git a/native/port.h b/native/port.h
index fa2d0d9df95b958b1aace90c7179051012db7f52..4bcbd3aaea55a8128f90d132d0e27a873560f079 100644 (file)
--- a/native/port.h
+++ b/native/port.h
@@ -36,7 +36,6 @@ typedef struct {
 PORT* untag_port(CELL tagged);
 PORT* port(PORT_MODE type, CELL fd);
 void init_line_buffer(PORT* port, FIXNUM count);
-void primitive_portp(void);
 void fixup_port(PORT* port);
 void collect_port(PORT* port);
 void postpone_io_error(PORT* port, const char* func);

diff --git a/native/primitives.c b/native/primitives.c
index 18127cab7c545c9950f7e828e3ab4a1f6c525ff0..448be62fc720a11cb2ebbc2fa3c2a25b9013dfc1 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -6,19 +6,16 @@ XT primitives[] = {
        primitive_execute,
        primitive_call,
        primitive_ifte,
-       primitive_consp,
        primitive_cons,
        primitive_car,
        primitive_cdr,
        primitive_set_car,
        primitive_set_cdr,
-       primitive_vectorp,
        primitive_vector,
        primitive_vector_length,
        primitive_set_vector_length,
        primitive_vector_nth,
        primitive_set_vector_nth,
-       primitive_stringp,
        primitive_string_length,
        primitive_string_nth,
        primitive_string_compare,
@@ -27,7 +24,6 @@ XT primitives[] = {
        primitive_index_of,
        primitive_substring,
        primitive_string_reverse,
-       primitive_sbufp,
        primitive_sbuf,
        primitive_sbuf_length,
        primitive_set_sbuf_length,
@@ -43,16 +39,13 @@ XT primitives[] = {
        primitive_to_bignum,
        primitive_to_float,
        primitive_number_eq,
-       primitive_fixnump,
-       primitive_bignump,
-       primitive_ratiop,
        primitive_numerator,
        primitive_denominator,
-       primitive_floatp,
+       primitive_to_fraction,
+       primitive_from_fraction,
        primitive_str_to_float,
        primitive_float_to_str,
        primitive_float_to_bits,
-       primitive_complexp,
        primitive_real,
        primitive_imaginary,
        primitive_to_rect,
@@ -86,7 +79,6 @@ XT primitives[] = {
         primitive_fsin,
         primitive_fsinh,
         primitive_fsqrt,
-       primitive_wordp,
        primitive_word,
        primitive_word_hashcode,
        primitive_word_xt,
@@ -119,7 +111,6 @@ XT primitives[] = {
        primitive_callstack,
        primitive_set_datastack,
        primitive_set_callstack,
-       primitive_portp,
        primitive_exit,
        primitive_client_socket,
        primitive_server_socket,
@@ -143,8 +134,8 @@ XT primitives[] = {
        primitive_millis,
        primitive_init_random,
        primitive_random_int,
-       primitive_type_of,
-       primitive_size_of,
+       primitive_type,
+       primitive_size,
        primitive_call_profiling,
        primitive_word_call_count,
        primitive_set_word_call_count,
@@ -160,7 +151,7 @@ XT primitives[] = {
        primitive_set_compiled_offset,
        primitive_literal_top,
        primitive_set_literal_top,
-       primitive_address_of,
+       primitive_address,
        primitive_dlopen,
        primitive_dlsym,
        primitive_dlsym_self,

diff --git a/native/ratio.c b/native/ratio.c
index c131ae994362fddea1bd209678fd81061e2afcdc..fef412682d2cf8e1775b1381c317a96c84f83bdb 100644 (file)
--- a/native/ratio.c
+++ b/native/ratio.c
@@ -8,6 +8,19 @@ RATIO* ratio(CELL numerator, CELL 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)
+{
+       CELL denominator = dpop();
+       CELL numerator = dpop();
+       if(zerop(denominator))
+               raise(SIGFPE);
+       if(onep(denominator))
+               dpush(numerator);
+       dpush(tag_ratio(ratio(numerator,denominator)));
+}
+
 RATIO* to_ratio(CELL x)
 {
        switch(type_of(x))
@@ -23,9 +36,25 @@ RATIO* to_ratio(CELL x)
        }
 }
 
-void primitive_ratiop(void)
+void primitive_to_fraction(void)
 {
-       drepl(tag_boolean(typep(RATIO_TYPE,dpeek())));
+       RATIO* r;
+
+       switch(type_of(dpeek()))
+       {
+       case FIXNUM_TYPE:
+       case BIGNUM_TYPE:
+               dpush(tag_fixnum(1));
+               break;
+       case RATIO_TYPE:
+               r = untag_ratio(dpeek());
+               drepl(r->numerator);
+               dpush(r->denominator);
+               break;
+       default:
+               type_error(RATIONAL_TYPE,dpeek());
+               break;
+       }
 }
 
 void primitive_numerator(void)

diff --git a/native/ratio.h b/native/ratio.h
index eedde3b7a28e286b687a68cd999a8bab24028607..298b1d5893ee6e27fa65b3d69b84d16893a4a2ca 100644 (file)
--- a/native/ratio.h
+++ b/native/ratio.h
@@ -17,9 +17,10 @@ INLINE CELL tag_ratio(RATIO* ratio)
 RATIO* ratio(CELL numerator, CELL denominator);
 RATIO* to_ratio(CELL x);
 
-void primitive_ratiop(void);
 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);

diff --git a/native/sbuf.c b/native/sbuf.c
index d21eca9c083df7d432d5b0e0beb284b2e71b7616..80a391b0a315bdf59a284be765d8a1b1e836ed87 100644 (file)
--- a/native/sbuf.c
+++ b/native/sbuf.c
@@ -8,11 +8,6 @@ SBUF* sbuf(FIXNUM capacity)
        return sbuf;
 }
 
-void primitive_sbufp(void)
-{
-       drepl(tag_boolean(typep(SBUF_TYPE,dpeek())));
-}
-
 void primitive_sbuf(void)
 {
        drepl(tag_object(sbuf(to_fixnum(dpeek()))));

diff --git a/native/sbuf.h b/native/sbuf.h
index 1da90fc4c82c27e70025c80d0ed475ed079a1874..0c40cc95cab4e07354e8c26080cdfac4c074a507 100644 (file)
--- a/native/sbuf.h
+++ b/native/sbuf.h
@@ -15,7 +15,6 @@ INLINE SBUF* untag_sbuf(CELL tagged)
 
 SBUF* sbuf(FIXNUM capacity);
 
-void primitive_sbufp(void);
 void primitive_sbuf(void);
 void primitive_sbuf_length(void);
 void primitive_set_sbuf_length(void);

diff --git a/native/string.c b/native/string.c
index 294a7ade583f4a3890da5e2d7eb4973462a91c1a..d77baa0f76d7d2e933d8e854081bcb10b5fca5c8 100644 (file)
--- a/native/string.c
+++ b/native/string.c
@@ -92,11 +92,6 @@ BYTE* to_c_string(STRING* s)
        return c_str;
 }
 
-void primitive_stringp(void)
-{
-       drepl(tag_boolean(typep(STRING_TYPE,dpeek())));
-}
-
 void primitive_string_length(void)
 {
        drepl(tag_fixnum(untag_string(dpeek())->capacity));

diff --git a/native/string.h b/native/string.h
index 9e53c9e2d40e1578ffcbb771d742d8f824560c32..154fcb9c572ffb6cc98620086bc2ad053feab38d 100644 (file)
--- a/native/string.h
+++ b/native/string.h
@@ -36,7 +36,6 @@ INLINE void set_string_nth(STRING* string, CELL index, CHAR value)
        cput(SREF(string,index),value);
 }
 
-void primitive_stringp(void);
 void primitive_string_length(void);
 void primitive_string_nth(void);
 FIXNUM string_compare_head(STRING* s1, STRING* s2, CELL len);

diff --git a/native/types.c b/native/types.c
index 60228accef60d7a5990390dfb06b7509877d4650..4c8ab74acc1c2989b66012c4b66528467a22e45f 100644 (file)
--- a/native/types.c
+++ b/native/types.c
@@ -115,12 +115,12 @@ CELL untagged_object_size(CELL pointer)
        return align8(size);
 }
 
-void primitive_type_of(void)
+void primitive_type(void)
 {
        drepl(tag_fixnum(type_of(dpeek())));
 }
 
-void primitive_size_of(void)
+void primitive_size(void)
 {
        drepl(tag_fixnum(object_size(dpeek())));
 }

diff --git a/native/types.h b/native/types.h
index d5e0bde38e41523ebf763d005e2ca72646445aad..2cec34d58b3813205a96c5401ad664a2c50844fe 100644 (file)
--- a/native/types.h
+++ b/native/types.h
@@ -82,5 +82,5 @@ INLINE CELL object_type(CELL tagged)
 void* allot_object(CELL type, CELL length);
 CELL untagged_object_size(CELL pointer);
 CELL object_size(CELL pointer);
-void primitive_type_of(void);
-void primitive_size_of(void);
+void primitive_type(void);
+void primitive_size(void);

diff --git a/native/vector.c b/native/vector.c
index 9e90624177e4a54054683cfcd5837f935c06c0b6..761e2f79d0b750f742ddea2f677e27647833208c 100644 (file)
--- a/native/vector.c
+++ b/native/vector.c
@@ -8,11 +8,6 @@ VECTOR* vector(FIXNUM capacity)
        return vector;
 }
 
-void primitive_vectorp(void)
-{
-       drepl(tag_boolean(typep(VECTOR_TYPE,dpeek())));
-}
-
 void primitive_vector(void)
 {
        drepl(tag_object(vector(to_fixnum(dpeek()))));

diff --git a/native/vector.h b/native/vector.h
index 074bb36bb24088c76003814f5ade9171b74354a4..b754508d572aa079186599bd42dca74b5ef4957a 100644 (file)
--- a/native/vector.h
+++ b/native/vector.h
@@ -15,7 +15,6 @@ INLINE VECTOR* untag_vector(CELL tagged)
 
 VECTOR* vector(FIXNUM capacity);
 
-void primitive_vectorp(void);
 void primitive_vector(void);
 void primitive_vector_length(void);
 void primitive_set_vector_length(void);

diff --git a/native/word.c b/native/word.c
index e1fc208977d04139f626d5d5e37e7033f4b80e94..cebb1109a619be72ff725b5a8b20a1729f1322f0 100644 (file)
--- a/native/word.c
+++ b/native/word.c
@@ -22,11 +22,6 @@ void update_xt(WORD* word)
        word->xt = primitive_to_xt(word->primitive);
 }
 
-void primitive_wordp(void)
-{
-       drepl(tag_boolean(typep(WORD_TYPE,dpeek())));
-}
-
 /* <word> ( primitive parameter plist -- word ) */
 void primitive_word(void)
 {

diff --git a/native/word.h b/native/word.h
index 307bb788b4f89335c58c078416770a2c9f17ef93..c93e2bdaa5b5a87ebaa724eb840950103cf5017b 100644 (file)
--- a/native/word.h
+++ b/native/word.h
@@ -32,7 +32,6 @@ INLINE CELL tag_word(WORD* word)
 
 WORD* word(CELL primitive, CELL parameter, CELL plist);
 void update_xt(WORD* word);
-void primitive_wordp(void);
 void primitive_word(void);
 void primitive_word_hashcode(void);
 void primitive_word_primitive(void);