X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scheme.forth.jl.git;a=blobdiff_plain;f=src%2Fscheme-primitives.4th;h=ba48b9e365a0f99ae7af8a6e241eecabb3d2e9d0;hp=7e123f71184d496b628d6571e323000b580ceada;hb=3055ae2e3d57ec91a4187a6c5cf8f05357d60810;hpb=007ee2a4d8f3b87779599f06512973c92d0640e8

diff --git a/src/scheme-primitives.4th b/src/scheme-primitives.4th
index 7e123f7..ba48b9e 100644
--- a/src/scheme-primitives.4th
+++ b/src/scheme-primitives.4th
@@ -20,6 +20,10 @@
     flonum-type istype? -rot 2drop boolean-type
 ; 1 make-fa-primitive flonum?
 
+:noname ( args -- boolobj )
+    ratnum-type istype? -rot 2drop boolean-type
+; 1 make-fa-primitive ratnum?
+
 :noname ( args -- boolobj )
     character-type istype? -rot 2drop boolean-type
 ; 1 make-fa-primitive char?
@@ -223,23 +227,6 @@
     swap abs swap
 ; 1 make-fa-primitive fix:abs
 
-: sort-pair
-    2dup > if
-        swap
-    then
-;
-
-( Find the GCD of n1 and n2 where n2 < n1. )
-: gcd ( n1 n2 -- m )
-    sort-pair
-    over 0= if
-        swap drop
-    else
-        over mod
-        recurse
-    then
-;
-
 :noname ( fixnum fixnum -- fixnum' )
     drop swap drop gcd fixnum-type
 ; 2 make-fa-primitive fix:gcd
@@ -383,6 +370,17 @@
     drop swap drop f/ fatan flonum-type
 ; 2 make-fa-primitive flo:atan2
 
+\ --- Rationals ---
+
+' make-rational 2 make-fa-primitive make-rational
+
+:noname ( ratnum -- fixnum )
+    drop pair-type car
+; 1 make-fa-primitive rat:numerator
+
+:noname ( ratnum -- fixnum )
+    drop pair-type cdr
+; 1 make-fa-primitive rat:denominator
 
 \ --- Conversion ---