X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scheme.forth.jl.git;a=blobdiff_plain;f=src%2Fscheme-library.scm;h=85580fdb65540e5d45e05175bd6cfb4ddf92487e;hp=f8c0ec492c76fb8052f37b40faf9ae4f1ac80fb0;hb=3055ae2e3d57ec91a4187a6c5cf8f05357d60810;hpb=007ee2a4d8f3b87779599f06512973c92d0640e8

diff --git a/src/scheme-library.scm b/src/scheme-library.scm
index f8c0ec4..85580fd 100644
--- a/src/scheme-library.scm
+++ b/src/scheme-library.scm
@@ -17,6 +17,41 @@
 
 ;; NUMBERS
 
+; Rational primitives
+
+(define (numerator x)
+  (if (ratnum? x)
+    (rat:numerator x)
+    x))
+
+(define (denominator x)
+  (if (ratnum? x)
+    (rat:denominator x)
+    (if (fixnum? x)
+      1
+      1.0)))
+
+(define (rat:+ x y)
+  (make-rational (fix:+ (fix:* (numerator x) (denominator y))
+                        (fix:* (denominator x) (numerator y)))
+                 (fix:* (denominator x) (denominator y))))
+
+(define (rat:- x y)
+  (make-rational (fix:- (fix:* (numerator x) (denominator y))
+                        (fix:* (denominator x) (numerator y)))
+                 (fix:* (denominator x) (denominator y))))
+
+(define (rat:* x y)
+  (make-rational (fix:* (numerator x) (numerator y))
+                 (fix:* (denominator x) (denominator y))))
+
+(define (rat:/ x y)
+  (make-rational (fix:* (numerator x) (denominator y))
+                 (fix:* (denominator x) (numerator y))))
+
+(define (rat:1/ x)
+  (make-rational (denominator x) (numerator x)))
+
 ; Type dispatch and promotion
 
 (define (type-dispatch ops x)