Moved neg into the standard library.
authorVincent St-Amour <stamourv@iro.umontreal.ca>
Fri, 9 Oct 2009 14:54:59 +0000 (9 10:54 -0400)
committerVincent St-Amour <stamourv@iro.umontreal.ca>
Fri, 9 Oct 2009 14:54:59 +0000 (9 10:54 -0400)
Moved the sign handling of multiplication and division to the standard library.

bignums.c
dispatch.c
encoding.scm
env.scm
library.scm
parser.scm
primitives.c

index d0a025c..a44db23 100644 (file)
--- a/bignums.c
+++ b/bignums.c
@@ -287,12 +287,6 @@ integer sub (integer x, integer y) {
   return result;
 }
 
-integer neg (integer x) {
-  /* neg(x) returns the integer -x */
-
-  return sub (ZERO, x);
-}
-
 integer scale (digit n, integer x) {
   /* scale(n,x) returns the integer n*x */
 
index 6d8da7c..8b04a69 100644 (file)
@@ -494,8 +494,10 @@ void interpreter () {
       arg2 = pop();  arg1 = pop();  prim_div ();      push_arg1();  break;
     case 5:
       arg2 = pop();  arg1 = pop();  prim_rem ();      push_arg1();  break;
-    case 6:
-      arg1 = pop();  prim_neg ();      push_arg1();  break;
+#if 0
+    case 6: // FREE
+      break;
+#endif
     case 7:
       arg2 = pop();  arg1 = pop();  prim_eq ();       push_arg1();  break;
     case 8:
index e0def39..b1d228f 100644 (file)
             (define (prim.*)               (prim 3))
             (define (prim.quotient)        (prim 4))
             (define (prim.remainder)       (prim 5))
-            (define (prim.neg)             (prim 6))
             (define (prim.=)               (prim 7))
             (define (prim.<)               (prim 8))
             (define (prim.>)               (prim 10))
                              ((#%*)               (prim.*))
                              ((#%quotient)        (prim.quotient))
                              ((#%remainder)       (prim.remainder))
-                             ((#%neg)             (prim.neg))
                              ((#%=)               (prim.=))
                              ((#%<)               (prim.<))
                              ((#%>)               (prim.>))
diff --git a/env.scm b/env.scm
index 0eedeaf..859968e 100644 (file)
--- a/env.scm
+++ b/env.scm
@@ -34,7 +34,6 @@
      (make-var '#%* #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%quotient #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%remainder #t '() '() '() #f (make-primitive 2 #f #f))
-     (make-var '#%neg #t '() '() '() #f (make-primitive 1 #f #f))
      (make-var '#%= #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%< #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%> #t '() '() '() #f (make-primitive 2 #f #f))
@@ -89,7 +88,6 @@
 ;; (define foo car)
 (define substitute-primitives
   '((number? . #%number?)
-    (quotient . #%quotient)
     (remainder . #%remainder)
     (= . #%=)
     (< . #%<)
index 5142131..577ffb4 100644 (file)
@@ -24,7 +24,7 @@
 (define +
   (lambda (x . rest)
     (if (#%pair? rest)
-        (#%+-aux (#%+ x (#%car rest)) (#%cdr rest))
+        (#%+-aux x rest)
         x)))
 
 (define #%+-aux
         (#%+-aux (#%+ x (#%car rest)) (#%cdr rest))
         x)))
 
+(define neg
+  (lambda (x)
+    (- 0 x)))
+
 (define -
   (lambda (x . rest)
     (if (#%pair? rest)
-        (#%--aux (#%- x (#%car rest)) (#%cdr rest))
-        (#%neg x))))
+        (#%--aux x rest)
+        (neg x))))
 
 (define #%--aux
   (lambda (x rest)
 (define *
   (lambda (x . rest)
     (if (#%pair? rest)
-        (#%*-aux (#%* x (#%car rest)) (#%cdr rest))
+        (#%*-aux x rest)
         x)))
 
 (define #%*-aux
   (lambda (x rest)
     (if (#%pair? rest)
-        (#%*-aux (#%* x (#%car rest)) (#%cdr rest))
+        (#%*-aux (#%mul x (#%car rest)) (#%cdr rest))
         x)))
 
-(define quotient
+(define #%mul
+  (lambda (x y)
+    (let* ((x-neg? (< x 0))
+           (y-neg? (< y 0))
+           (x      (if x-neg? (neg x) x))
+           (y      (if y-neg? (neg y) y)))
+      (let ((prod   (#%* x y)))
+        (cond ((and x-neg? y-neg?)
+               prod)
+              ((or x-neg? y-neg?)
+               (neg prod))
+              (else
+               prod))))))
+
+(define / quotient)
+
+(define quotient ;; TODO similar to #%mul, abstract ?
   (lambda (x y)
-    (#%quotient x y)))
+    (let* ((x-neg? (< x 0))
+           (y-neg? (< y 0))
+           (x      (if x-neg? (neg x) x))
+           (y      (if y-neg? (neg y) y)))
+      (let ((quot   (#%quotient x y)))
+        (cond ((and x-neg? y-neg?)
+               quot)
+              ((or x-neg? y-neg?)
+               (neg quot))
+              (else
+               quot))))))
 
 (define remainder
   (lambda (x y)
 
 (define abs
   (lambda (x)
-    (if (#%< x 0) (#%neg x) x)))
+    (if (#%< x 0) (neg x) x)))
 
 (define modulo
   (lambda (x y)
   (lambda (n)
     (#%list->string
      (if (#%< n 0)
-         (#%cons #\- (#%number->string-aux (#%neg n) '()))
+         (#%cons #\- (#%number->string-aux (neg n) '()))
          (#%number->string-aux n '())))))
 
 (define #%number->string-aux
   (lambda (n lst)
-    (let ((rest (#%cons (#%+ #\0 (#%remainder n 10)) lst)))
+    (let ((rest (#%cons (#%+ #\0 (remainder n 10)) lst)))
       (if (#%< n 10)
           rest
-          (#%number->string-aux (#%quotient n 10) rest)))))
+          (#%number->string-aux (quotient n 10) rest)))))
 
 (define pp
   (lambda (x)
 ;; TODO add bitwise-and ? bitwise-not ?
 
 (define current-time (lambda () (#%clock)))
-(define time->seconds (lambda (t) (#%quotient t 100)))
+(define time->seconds (lambda (t) (quotient t 100)))
 
 (define u8vector
   (lambda x
index 0401c74..df6327c 100644 (file)
          ;; binary arthimetic operations can use primitives directly
          ((and (pair? expr)
                (= (length (cdr expr)) 2)
-               (assoc (car expr) '((+ . #%+) (- . #%-) (* . #%*))))
+               (assoc (car expr) '((+ . #%+) (- . #%-))))
           =>
           (lambda (prim)
             (parse use
index cb61ce8..603b0f3 100644 (file)
@@ -17,12 +17,12 @@ char *prim_name[64] =
     "prim #%*",
     "prim #%quotient",
     "prim #%remainder",
-    "prim #%neg",
+    "prim 6",
     "prim #%=",
     "prim #%<",
-    "prim #%<=",
+    "prim 9",
     "prim #%>",
-    "prim #%>=",
+    "prim 11",
     "prim #%pair?",
     "prim #%cons",
     "prim #%car",
@@ -118,12 +118,7 @@ void prim_sub () {
 
 void prim_mul () {
 #ifdef INFINITE_PRECISION_BIGNUMS
-  a1 = negp (arg1);
-  a2 = negp (arg2); // -1 if negative
-  arg1 = mulnonneg (a1 ? neg(arg1) : arg1,
-                   a2 ? neg(arg2) : arg2);
-  if (a1 + a2 == 1) // only one of the 2 was negative
-    arg1 = neg(arg1);
+  arg1 = mulnonneg (arg1, arg2);
 #else
   decode_2_int_args ();
   arg1 = encode_int (a1 * a2);
@@ -135,12 +130,7 @@ void prim_div () {
 #ifdef INFINITE_PRECISION_BIGNUMS
   if (obj_eq(arg2, ZERO))
     ERROR("quotient", "divide by 0");
-  a1 = negp (arg1);
-  a2 = negp (arg2); // -1 if negative
-  arg1 = divnonneg (a1 ? neg(arg1) : arg1,
-                   a2 ? neg(arg2) : arg2);
-  if (a1 + a2 == 1) // only one of the 2 was negative
-    arg1 = neg(arg1);
+  arg1 = divnonneg (arg1, arg2);
 #else
   decode_2_int_args ();
   if (a2 == 0)
@@ -172,15 +162,6 @@ void prim_rem () {
   arg2 = OBJ_FALSE;
 }
 
-void prim_neg () {
-#ifdef INFINITE_PRECISION_BIGNUMS
-  arg1 = neg (arg1);
-#else
-  a1 = decode_int (arg1);
-  arg1 = encode_int (- a1);
-#endif
-}
-
 void prim_eq () {
 #ifdef INFINITE_PRECISION_BIGNUMS
   arg1 = encode_bool(cmp (arg1, arg2) == 1);