* Many numeric predicates are added (exact?, inexact?, real?,

complex?, etc.).
* min and max are added.

src/libcore.ss

@@ -704,6 +704,34 @@ reference-implementation:
       [else
        (error 'char-whitespace? "~s is not a character" c)])))
 
+(primitive-set! 'char-alphabetic?
+  (lambda (c)
+    (cond
+      [(char? c)
+       (cond
+         [($char<= #\a c) ($char<= c #\z)]
+         [($char<= #\A c) ($char<= c #\Z)]
+         [else #f])]
+      [else 
+       (error 'char-alphabetic?  "~s is not a character" c)])))
+
+(primitive-set! 'char-downcase
+  (lambda (c)
+    (cond
+      [(char? c)
+       (cond
+         [(and ($char<= #\A c) ($char<= c #\Z))
+          ($fixnum->char 
+            ($fx+ ($char->fixnum c)
+                  ($fx- ($char->fixnum #\a)
+                        ($char->fixnum #\A))))]
+         [else c])]
+      [else 
+       (error 'char-downcase "~s is not a character" c)])))
+
+
+
+
 (primitive-set! 'cons (lambda (x y) (cons x y)))
 
 (primitive-set! 'eq? (lambda (x y) (eq? x y)))
@@ -1704,3 +1732,48 @@ reference-implementation:
           x
           (error 'command-list "invalid command-line-arguments ~s\n" x)))))
 
+(primitive-set! 'string->number
+  (lambda (x)
+    (define (convert-data str len pos? idx ac)
+      (cond
+        [($fx= idx len) (if pos? ac (- 0 ac))]
+        [else
+         (let ([c ($string-ref str idx)])
+           (cond
+             [(and ($char<= #\0 c) ($char<= c #\9))
+              (convert-data str len pos? ($fxadd1 idx) 
+                 (+ (* ac 10)
+                    ($fx- ($char->fixnum c) ($char->fixnum #\0))))]
+             [else #f]))]))
+    (define (convert-data-init str len pos? idx c)
+      (cond
+        [($char= c #\0) 
+         (if ($fx= idx len)
+             0
+             (convert-data-init str len pos? 
+                ($fxadd1 idx) 
+                ($string-ref str idx)))]
+        [(and ($char<= #\1 c) ($char<= c #\9))
+         (convert-data str len pos? idx
+            ($fx- ($char->fixnum c) ($char->fixnum #\0)))]
+        [else #f]))
+    (define (convert-num str len pos?)
+      (cond
+        [($fx> len 1)
+         (convert-data-init str len pos? 2 ($string-ref str 1))]
+        [else #f]))
+    (define (convert-sign str len)
+      (cond
+        [($fx> len 0)
+         (let ([c ($string-ref str 0)])
+           (case c
+             [(#\+) (convert-num str len #t)]
+             [(#\-) (convert-num str len #f)]
+             [else
+              (convert-data-init str len #t 1 c)]))]
+        [else #f]))
+    (cond
+      [(string? x) 
+       (convert-sign x ($string-length x))]
+      [else (error 'string->number "~s is not a string" x)])))
+

src/libnumerics.ss

@@ -163,12 +163,90 @@
         [else
          (binary* n (expt (binary* n n) (#%$fxsra m 1)))])))
 
+  (define max
+    (case-lambda
+      [(x y)
+       (cond
+         [(fixnum? x) 
+          (cond
+            [(fixnum? y) 
+             (if ($fx> x y) x y)]
+            [(bignum? y)
+             (if (positive-bignum? y) y x)]
+            [else (error 'max "~s is not a number" y)])]
+         [(bignum? x)
+          (cond
+            [(fixnum? y)
+             (if (positive-bignum? x) x y)]
+            [(bignum? y)
+             (if (bnbn> x y) x y)]
+            [else (error 'max "~s is not a number" y)])]
+         [else (error 'max "~s is not a number" x)])]
+      [(x y z . rest)
+       (let f ([a (max x y)] [b z] [ls rest])
+         (cond
+           [(null? ls) (max a b)]
+           [else
+            (f (max a b) (car ls) (cdr ls))]))]
+      [(x) 
+       (if (number? x) 
+           x 
+           (error 'max "~s is not a number" x))]))
+
+(define min
+    (case-lambda
+      [(x y)
+       (cond
+         [(fixnum? x) 
+          (cond
+            [(fixnum? y) 
+             (if ($fx> x y) y x)]
+            [(bignum? y)
+             (if (positive-bignum? y) x y)]
+            [else (error 'min "~s is not a number" y)])]
+         [(bignum? x)
+          (cond
+            [(fixnum? y)
+             (if (positive-bignum? x) y x)]
+            [(bignum? y)
+             (if (bnbn> x y) y x)]
+            [else (error 'min "~s is not a number" y)])]
+         [else (error 'min "~s is not a number" x)])]
+      [(x y z . rest)
+       (let f ([a (min x y)] [b z] [ls rest])
+         (cond
+           [(null? ls) (min a b)]
+           [else
+            (f (min a b) (car ls) (cdr ls))]))]
+      [(x) 
+       (if (number? x) 
+           x 
+           (error 'min "~s is not a number" x))]))
 
   (define number?
     (lambda (x)
       (or (fixnum? x)
           (bignum? x))))
 
+  (define complex?
+    (lambda (x) (number? x)))
+  (define real?
+    (lambda (x) (number? x)))
+  (define rational?
+    (lambda (x) (number? x)))
+  (define integer?
+    (lambda (x) (number? x)))
+  (define exact?
+    (lambda (x) 
+      (or (number? x)
+          (error 'exact? "~s is not a number" x))))
+
+  (define inexact?
+    (lambda (x) 
+      (if (number? x)
+          #f
+          (error 'inexact? "~s is not a number" x))))
+
   (define positive-bignum?
     (lambda (x) 
       (foreign-call "ikrt_positive_bn" x)))
@@ -315,6 +393,7 @@
 
 
 
+
   (primitive-set! '+ +)
   (primitive-set! '- -)
   (primitive-set! '* *)
@@ -430,4 +509,12 @@
 
   (primitive-set! 'even? even?)
   (primitive-set! 'odd? odd?)
+  (primitive-set! 'max max)
+  (primitive-set! 'min min)
+  (primitive-set! 'complex? complex?)
+  (primitive-set! 'real? real?)
+  (primitive-set! 'rational? rational?)
+  (primitive-set! 'exact? exact?)
+  (primitive-set! 'inexact? inexact?)
+  (primitive-set! 'integer? integer?)
   )

src/libtimers.ss

@@ -14,7 +14,7 @@
     (define (print-time msg secs usecs)
       (if (fx< usecs 0)
           (print-time msg (fx- secs 1) (fx+ usecs 1000000))
-          (printf "    ~a.~a~a~as ~a time\n"
+          (printf "    ~a.~a~a~as ~a"
                   secs
                   (fxremainder (fxquotient usecs 100000) 10)
                   (fxremainder (fxquotient usecs 10000) 10)
@@ -30,15 +30,15 @@
         [(1) (display "    1 collection\n")]
         [else (printf "    ~a collections\n" collections)]))
 
-    (print-time "user" 
-        (fx- (stats-user-secs t1) (stats-user-secs t0))
-        (fx- (stats-user-usecs t1) (stats-user-usecs t0)))
-    (print-time "system" 
-        (fx- (stats-sys-secs t1) (stats-sys-secs t0))
-        (fx- (stats-sys-usecs t1) (stats-sys-usecs t0)))
     (print-time "real" 
         (fx- (stats-real-secs t1) (stats-real-secs t0))
         (fx- (stats-real-usecs t1) (stats-real-usecs t0)))
+    (print-time "user" 
+        (fx- (stats-user-secs t1) (stats-user-secs t0))
+        (fx- (stats-user-usecs t1) (stats-user-usecs t0)))
+    (print-time "sys\n" 
+        (fx- (stats-sys-secs t1) (stats-sys-secs t0))
+        (fx- (stats-sys-usecs t1) (stats-sys-usecs t0)))
     (printf "    ~a bytes allocated\n" bytes))
 
   (define time-it

src/libwriter.ss

@@ -24,7 +24,8 @@
               (write-char #\\ p)
               (write-char* "del" p)]
              [else
-              (write-char #\+ p)
+              (write-char #\\ p)
+              (write-char #\x p)
               (write-fixnum i p)]))
           (write-char x p))))
   (define write-list

src/makefile.ss

@@ -88,7 +88,10 @@
     time-it 
     posix-fork fork waitpid env environ
     pretty-print
-    even? odd? member char-whitespace?
+    even? odd? member char-whitespace? char-alphabetic?
+    char-downcase max min complex? real? rational? 
+    exact? inexact? integer?
+    string->number
     ))
 
 (define system-primitives