diff --git a/scheme/ikarus.reader.ss b/scheme/ikarus.reader.ss
index 7e35fb1..57671d3 100644
--- a/scheme/ikarus.reader.ss
+++ b/scheme/ikarus.reader.ss
@@ -20,6 +20,7 @@
           annotation-expression annotation-source
           annotation-stripped)
   (import
+    (only (ikarus.string-to-number) define-string->number-parser)
     (ikarus system $chars)
     (ikarus system $fx)
     (ikarus system $pairs)
@@ -255,8 +256,8 @@
                 (die/p p 'tokenize "invalid syntax"
                   (string-append ".." (string c)))]))]
           [else 
-           (cons 'datum 
-             (tokenize-decimal-no-digits p '(#\.) #f))]))))
+           (cons 'datum
+             (dot p '(#\.) 10 #f #f))]))))
   (define tokenize-char* 
     (lambda (i str p d)
       (cond
@@ -566,17 +567,17 @@
              [else (die/p p 'tokenize
                      (format "invalid sequence #v~a" c))]))]
         [(memq c '(#\e #\E)) 
-         (cons 'datum (tokenize-exactness-mark p (list c #\#) 'e))]
+         (cons 'datum (parse-string p (list c #\#) 10 #f 'e))]
         [(memq c '(#\i #\I)) 
-         (cons 'datum (tokenize-exactness-mark p (list c #\#) 'i))]
+         (cons 'datum (parse-string p (list c #\#) 10 #f 'i))]
         [(memq c '(#\b #\B)) 
-         (cons 'datum (tokenize-radix-mark p (list c #\#) 2))]
+         (cons 'datum (parse-string p (list c #\#) 2 2 #f))]
         [(memq c '(#\x #\X)) 
-         (cons 'datum (tokenize-radix-mark p (list c #\#) 16))]
+         (cons 'datum (parse-string p (list c #\#) 16 16 #f))]
         [(memq c '(#\o #\O)) 
-         (cons 'datum (tokenize-radix-mark p (list c #\#) 8))]
+         (cons 'datum (parse-string p (list c #\#) 8 8 #f))]
         [(memq c '(#\d #\D)) 
-         (cons 'datum (tokenize-radix-mark p (list c #\#) 10))]
+         (cons 'datum (parse-string p (list c #\#) 10 10 #f))]
         [($char= #\@ c)
          (when (eq? (port-mode p) 'r6rs-mode)
            (die/p-1 p 'tokenize "fasl syntax is invalid in #!r6rs mode"
@@ -586,233 +587,30 @@
         [else 
          (die/p-1 p 'tokenize 
             (format "invalid syntax #~a" c))])))
-  (define (tokenize-exactness-mark p ls exact?)
-    (let ([c (read-char p)])
-      (cond
-        [(eof-object? c) (num-error p "eof object" ls)]
-        [(radix-digit c 10) =>
-         (lambda (d) 
-           (tokenize-integer p (cons c ls) exact? 10 d))]
-        [(char=? c #\.) 
-         (tokenize-decimal-no-digits p (cons c ls) exact?)]
-        [(char=? c #\-) 
-         (- (tokenize-integer-no-digits p (cons c ls) exact? 10))]
-        [(char=? c #\+)
-         (tokenize-integer-no-digits p (cons c ls) exact? 10)]
-        [(char=? c #\#)
-         (let ([c1 (read-char p)])
-           (cond
-             [(eof-object? c1) 
-              (num-error p "eof object" (cons c ls))]
-             [(memv c1 '(#\b #\B)) 
-              (tokenize-radix/exactness-marks p (cons* c1 c ls) exact? 2)]
-             [(memv c1 '(#\x #\X)) 
-              (tokenize-radix/exactness-marks p (cons* c1 c ls) exact? 16)]
-             [(memv c1 '(#\o #\O)) 
-              (tokenize-radix/exactness-marks p (cons* c1 c ls) exact? 8)]
-             [(memv c1 '(#\d #\D)) 
-              (tokenize-radix/exactness-marks p (cons* c1 c ls) exact? 10)]
-             [else (num-error p "invalid sequence" (cons* c1 c ls))]))]
-        [else (num-error p "invalid sequence" (cons c ls))]))) 
-  (define (tokenize-radix-mark p ls radix)
-    (let ([c (read-char p)])
-      (cond
-        [(eof-object? c) (num-error p "eof object" ls)]
-        [(radix-digit c radix) =>
-         (lambda (d)
-           (tokenize-integer p (cons c ls) #f radix d))]
-        [(char=? c #\.) 
-         (unless (= radix 10)
-           (num-error p "invalid decimal" (cons c ls)))
-         (tokenize-decimal-no-digits p (cons c ls) #f)]
-        [(char=? c #\-)
-         (- (tokenize-integer-no-digits p (cons c ls) #f radix))]
-        [(char=? c #\+)
-         (tokenize-integer-no-digits p (cons c ls) #f radix)]
-        [(char=? c #\#)
-         (let ([c1 (read-char p)])
-           (cond
-             [(eof-object? c1) 
-              (num-error p "eof object" (cons c ls))]
-             [(memv c1 '(#\e #\E)) 
-              (tokenize-radix/exactness-marks p (cons c1 (cons c ls))
-                'e radix)]
-             [(memv c1 '(#\i #\I)) 
-              (tokenize-radix/exactness-marks p (cons c1 (cons c ls))
-                'i radix)]
-             [else (num-error p "invalid sequence" (cons* c1 c ls))]))]
-        [else (num-error p "invalid sequence" (cons c ls))])))
-  (define (tokenize-radix/exactness-marks p ls exact? radix) 
-    (let ([c (read-char p)])
-      (cond
-        [(eof-object? c) (num-error p "eof object" ls)]
-        [(radix-digit c radix) =>
-         (lambda (d) 
-           (tokenize-integer p (cons c ls) exact? radix d))]
-        [(char=? c #\.) 
-         (unless (= radix 10)
-           (num-error p "invalid decimal" (cons c ls)))
-         (tokenize-decimal-no-digits p (cons c ls) exact?)]
-        [(char=? c #\-) 
-         (- (tokenize-integer-no-digits p (cons c ls) exact? radix))]
-        [(char=? c #\+)
-         (tokenize-integer-no-digits p (cons c ls) exact? radix)]
-        [else (num-error p "invalid sequence" (cons c ls))])))
-  (define (tokenize-integer p ls exact? radix ac) 
-    (define (tokenize-denom-start p ls exact? radix num)
-      (let ([c (read-char p)])
-        (cond
-          [(eof-object? c) (num-error p "eof object" ls)]
-          [(radix-digit c radix) =>
-           (lambda (d) 
-             (tokenize-denom p (cons c ls) exact? radix num d))]
-          [(char=? c #\-)
-           (tokenize-denom-no-digits p (cons c ls) exact? radix (- num))]
-          [(char=? c #\+)
-           (tokenize-denom-no-digits p (cons c ls) exact? radix num)]
-          [else (num-error p "invalid sequence" (cons c ls))])))
-    (define (tokenize-denom-no-digits p ls exact? radix num)
-      (let ([c (read-char p)])
-        (cond
-          [(eof-object? c) (num-error p "eof object" ls)]
-          [(radix-digit c radix) =>
-           (lambda (d) 
-             (tokenize-denom p (cons c ls) exact? radix num d))]
-          [else (num-error p "invalid sequence" (cons c ls))])))
-    (define (tokenize-denom p ls exact? radix num ac)
-      (let ([c (peek-char p)])
-        (cond
-          [(eof-object? c) 
-           (read-char p)
-           (if (= ac 0) 
-               (num-error p "zero denominator" ls)
-               (convert/exact exact? (/ num ac)))]
-          [(radix-digit c radix) =>
-           (lambda (d) 
-             (read-char p)
-             (tokenize-denom p (cons c ls) exact? radix num 
-                (+ (* radix ac) d)))]
-          [(delimiter? c) 
-           (if (= ac 0)
-               (num-error p "zero denominator" ls)
-               (convert/exact exact? (/ num ac)))]
-          [else (num-error p "invalid sequence" (cons c ls))])))
-    (let ([c (peek-char p)])
-      (cond
-        [(eof-object? c) (convert/exact exact? ac)]
-        [(radix-digit c radix) =>
-         (lambda (d)
-           (read-char p)
-           (tokenize-integer p (cons c ls) exact? radix 
-             (+ (* ac radix) d)))]
-        [(char=? c #\.)
-         (unless (= radix 10)
-           (num-error p "invalid decimal" (cons c ls)))
-         (read-char p)
-         (tokenize-decimal p (cons c ls) exact? ac 0)]
-        [(char=? c #\/)
-         (read-char p)
-         (tokenize-denom-start p (cons #\/ ls) exact? radix ac)]
-        [(memv c '(#\e #\E)) ; exponent
-         (read-char p)
-         (unless (= radix 10)
-           (num-error p "invalid decimal" (cons c ls)))
-         (let ([ex (tokenize-exponent-start p (cons c ls))])
-           (convert/exact (or exact? 'i)
-             (* ac (expt radix ex))))]
-        [(delimiter? c)
-         (convert/exact exact? ac)]
-        [else (num-error p "invalid sequence" (cons c ls))])))
-  (define (tokenize-exponent-start p ls)
-    (define (tokenize-exponent-no-digits p ls)
-      (let ([c (read-char p)])
-        (cond
-          [(eof-object? c) (num-error p "eof object" ls)]
-          [(radix-digit c 10) =>
-           (lambda (d) 
-             (tokenize-exponent p (cons c ls) d))]
-          [else (num-error p "invalid sequence" (cons c ls))])))
-    (define (tokenize-exponent p ls ac)
-      (let ([c (peek-char p)])
-        (cond
-          [(eof-object? c) ac]
-          [(radix-digit c 10) =>
-           (lambda (d) 
-             (read-char p)
-             (tokenize-exponent p (cons c ls) 
-               (+ (* ac 10) d)))]
-          [(delimiter? c) ac]
-          [else (num-error p "invalid sequence" (cons c ls))])))
-    (let ([c (read-char p)])
-      (cond
-        [(eof-object? c) (num-error p "eof object" ls)]
-        [(radix-digit c 10) =>
-         (lambda (d) 
-           (tokenize-exponent p (cons c ls) d))]
-        [(char=? c #\-)
-         (- (tokenize-exponent-no-digits p (cons c ls)))]
-        [(char=? c #\+)
-         (tokenize-exponent-no-digits p (cons c ls))]
-        [else (num-error p "invalid sequence" (cons c ls))])))
-  (define (tokenize-decimal p ls exact? ac exp)
-    (let ([c (peek-char p)])
-      (cond
-        [(eof-object? c) 
-         (let ([ac (* ac (expt 10 exp))])
-           (convert/exact (or exact? 'i) ac))]
-        [(radix-digit c 10) =>
-         (lambda (d) 
-           (read-char p)
-           (tokenize-decimal p (cons c ls) exact? 
-             (+ (* ac 10) d) (- exp 1)))]
-        [(memv c '(#\e #\E)) 
-         (read-char p)
-         (let ([ex (tokenize-exponent-start p (cons c ls))])
-           (let ([ac (* ac (expt 10 (+ exp ex)))])
-             (convert/exact (or exact? 'i) ac)))]
-        [(delimiter? c) 
-         (let ([ac (* ac (expt 10 exp))])
-           (convert/exact (or exact? 'i) ac))]
-        [else (num-error p "invalid sequence" (cons c ls))])))
-  (define (tokenize-decimal-no-digits p ls exact?)
-    (let ([c (read-char p)])
-      (cond
-        [(eof-object? c) (num-error p "eof object" ls)]
-        [(radix-digit c 10) =>
-         (lambda (d) 
-           (tokenize-decimal p (cons c ls) exact? d -1))]
-        [else (num-error p "invalid sequence" (cons c ls))])))
-  (define (convert/exact exact? n)
-    (if (eq? exact? 'i) 
-        (exact->inexact n)
-        n))
-  (define (radix-digit c radix)
-    (case radix
-      [(10) 
-       (cond
-         [(char<=? #\0 c #\9) 
-          (fx- (char->integer c) (char->integer #\0))]
-         [else #f])]
-      [(16) 
-       (cond
-         [(char<=? #\0 c #\9) 
-          (fx- (char->integer c) (char->integer #\0))]
-         [(char<=? #\a c #\f) 
-          (fx- (char->integer c) (fx- (char->integer #\a) 10))]
-         [(char<=? #\A c #\F) 
-          (fx- (char->integer c) (fx- (char->integer #\A) 10))]
-         [else #f])]
-      [(8) 
-       (cond
-         [(char<=? #\0 c #\7) 
-          (fx- (char->integer c) (char->integer #\0))]
-         [else #f])]
-      [(2) 
-       (case c
-         [(#\0) 0]
-         [(#\1) 1]
-         [else #f])]
-      [else (die 'radix-digit "invalid radix" radix)]))
+
+  (define (num-error p str ls)
+    (die/p-1 p 'read "invalid numeric sequence"
+      (list->string (reverse ls))))
+
+  (define-syntax port-config
+    (syntax-rules (GEN-TEST GEN-ARGS FAIL)
+      [(_ GEN-ARGS k . rest) (k (p ac) . rest)]
+      [(_ FAIL (p ac))
+       (num-error p "invalid numeric sequence" ac)]
+      [(_ GEN-TEST var next (p ac) eof-case char-case)
+       (let ([c (peek-char p)])
+         (if (or (eof-object? c) (delimiter? c))
+             eof-case
+             (let ([var c])
+               (define-syntax next
+                 (syntax-rules ()
+                   [(_ who args (... ...))
+                    (who p (cons (get-char p) ac) args (... ...))]))
+               char-case)))]))
+
+  (define-string->number-parser port-config
+    (parse-string digit+ sign dot))
+
   (define (read-char* p ls str who ci? delimited?)
     (let f ([i 0] [ls ls])
       (cond
@@ -836,37 +634,6 @@
               (die/p-1 p 'tokenize 
                 (format "invalid ~a: ~s" who
                   (list->string (reverse (cons c ls)))))]))])))
-  (define (tokenize-integer/nan/inf-no-digits p ls)
-    (let ([c (read-char p)])
-      (cond
-        [(eof-object? c) (num-error p "invalid eof" ls)]
-        [(radix-digit c 10) =>
-         (lambda (d)
-           (tokenize-integer p (cons c ls) #f 10 d))]
-        [(char=? c #\.) 
-         (tokenize-decimal-no-digits p (cons c ls) #f)]
-        [(memv c '(#\i #\I)) 
-         (read-char* p (cons #\i ls) "nf.0" "number sequence" #t #t)
-         +inf.0]
-        [(memv c '(#\n #\N))
-         (read-char* p (cons #\i ls) "an.0" "number sequence" #t #t)
-         +nan.0]
-        [else (num-error p "invalid sequence" (cons c ls))]))) 
-  (define (tokenize-integer-no-digits p ls exact? radix?)
-    (let ([c (read-char p)])
-      (cond
-        [(eof-object? c) (num-error p "invalid eof" ls)]
-        [(radix-digit c (or radix? 10)) =>
-         (lambda (d) 
-           (tokenize-integer p (cons c ls) exact? (or radix? 10) d))]
-        [(char=? c #\.) 
-         (when (and radix? (not (= radix? 10)))
-           (num-error p "invalid decimal" (cons c ls)))
-         (tokenize-decimal-no-digits p (cons c ls) exact?)]
-        [else (num-error p "invalid sequence" (cons c ls))])))
-  (define (num-error p str ls)
-    (die/p-1 p 'read "invalid numeric sequence"
-      (list->string (reverse ls))))
   (define (tokenize-hashnum p n)
     (let ([c (read-char p)])
       (cond
@@ -948,10 +715,10 @@
              '(macro . unquote-splicing)]
             [else '(macro . unquote)]))]
         [($char= #\# c) (tokenize-hash p)]
-        [(radix-digit c 10) =>
-         (lambda (d) 
+        [(char<=? #\0 c #\9) 
+         (let ([d (fx- (char->integer c) (char->integer #\0))])
            (cons 'datum
-             (tokenize-integer p (list c) #f 10 d)))]
+             (digit+ p (list c) 10 #f +1 d)))]
         [(initial? c)
          (let ([ls (reverse (tokenize-identifier (cons c '()) p))])
            (cons 'datum (string->symbol (list->string ls))))]
@@ -965,7 +732,7 @@
              [(delimiter? c)  '(datum . +)]
              [else
               (cons 'datum
-                (tokenize-integer/nan/inf-no-digits p '(#\+)))]))]
+                (sign p '(#\+) 10 #f +1))]))]
         [(memq c '(#\-))
          (let ([c (peek-char p)])
            (cond
@@ -978,7 +745,7 @@
                   (cons 'datum (string->symbol str))))]
              [else
               (cons 'datum
-                (- (tokenize-integer/nan/inf-no-digits p '(#\-))))]))]
+                (sign p '(#\-) 10 #f -1))]))]
         [($char= #\. c)
          (tokenize-dot p)]
         [($char= #\| c)
diff --git a/scheme/ikarus.string-to-number.ss b/scheme/ikarus.string-to-number.ss
index dff5c2b..b1334ba 100755
--- a/scheme/ikarus.string-to-number.ss
+++ b/scheme/ikarus.string-to-number.ss
@@ -1,283 +1,324 @@
 
 (library (ikarus.string-to-number)
-  (export string->number)
+  (export string->number define-string->number-parser)
   (import (except (ikarus) string->number))
 
-  (module (string->number)
-    (define who 'string->number)
-    (define (do-sn/ex sn ex ac)
-      (* sn (if (eq? ex 'i) (inexact ac) ac)))
-    (define (do-dec-sn/ex sn ex ac)
-      (* sn (if (eq? ex 'e) ac (inexact ac))))
-    (define (digit c r)
-      (let ([n (fx- (char->integer c) (char->integer #\0))])
-        (cond
-          [(and (fx>=? n 0) (fx< n r)) n]
-          [(eqv? r 16)
-           (let ([n (fx- (char->integer c) (char->integer #\a))])
-             (cond
-               [(and (fx>=? n 0) (fx< n 6)) (+ n 10)]
-               [else
-                (let ([n (fx- (char->integer c) (char->integer #\A))])
-                  (cond
-                    [(and (fx>=? n 0) (fx< n 6)) (+ n 10)]
-                    [else #f]))]))]
-          [else #f])))
-
-    (module (define-parser)
-      (define-syntax gen-empty
-        (syntax-rules (eof)
-          [(_ C Ca) (C FAIL Ca)]
-          [(_ C Ca [(eof) then] . rest) then]
-          [(_ C Ca other . rest) (gen-empty C Ca . rest)]))
-      (define-syntax gen-char
-        (syntax-rules (eof =>)
-          [(_ C Ca c) (C FAIL Ca)]
-          [(_ C Ca c [(eof) then] . rest)
-           (gen-char C Ca c . rest)]
-          [(_ C Ca c [(test . args) => result then] . rest)
+  (define who 'string->number)
+  (define (do-sn/ex sn ex ac)
+    (* sn (if (eq? ex 'i) (inexact ac) ac)))
+  (define (do-dec-sn/ex sn ex ac)
+    (* sn (if (eq? ex 'e) ac (inexact ac))))
+  (define (digit c r)
+    (let ([n (fx- (char->integer c) (char->integer #\0))])
+      (cond
+        [(and (fx>=? n 0) (fx< n r)) n]
+        [(eqv? r 16)
+         (let ([n (fx- (char->integer c) (char->integer #\a))])
            (cond
-             [(test c . args) => 
-              (lambda (result) then)]
-             [else (gen-char C Ca c . rest)])]
-          [(_ C Ca c [ls then] . rest)
-           (if (memv c 'ls)
-               then
-               (gen-char C Ca c . rest))]))
-      (define-syntax gen-clause
-        (syntax-rules ()
-          [(_ (Ca ...) C next fail name (arg* ...) (clause* ...))
-           (define (name Ca ... arg* ...)
-             (define-syntax fail
-               (syntax-rules ()
-                 [(_) (C FAIL (Ca ...))]))
-             (cond
-               [(C GEN-EOF? (Ca ...))
-                (gen-empty C (Ca ...) clause* ...)]
-               [else
-                (let ([c (C GEN-REF (Ca ...))])
-                  (define-syntax next
-                    (syntax-rules ()
-                      [(_ who args (... ...))
-                       (C GEN-NEXT (Ca ...) who args (... ...))]))
-                  (gen-char C (Ca ...) c clause* ...))]))]))
-      (define-syntax define-parser
-        (syntax-rules ()
+             [(and (fx>=? n 0) (fx< n 6)) (+ n 10)]
+             [else
+              (let ([n (fx- (char->integer c) (char->integer #\A))])
+                (cond
+                  [(and (fx>=? n 0) (fx< n 6)) (+ n 10)]
+                  [else #f]))]))]
+        [else #f])))
+
+  (module (define-parser)
+    (define-syntax gen-empty
+      (syntax-rules (eof)
+        [(_ C Ca) (C FAIL Ca)]
+        [(_ C Ca [(eof) then] . rest) then]
+        [(_ C Ca other . rest) (gen-empty C Ca . rest)]))
+    (define-syntax gen-char
+      (syntax-rules (eof =>)
+        [(_ C Ca c) (C FAIL Ca)]
+        [(_ C Ca c [(eof) then] . rest)
+         (gen-char C Ca c . rest)]
+        [(_ C Ca c [(test . args) => result then] . rest)
+         (cond
+           [(test c . args) => 
+            (lambda (result) then)]
+           [else (gen-char C Ca c . rest)])]
+        [(_ C Ca c [ls then] . rest)
+         (if (memv c 'ls)
+             then
+             (gen-char C Ca c . rest))]))
+    (define-syntax gen-clause
+      (syntax-rules ()
+        [(_ (Ca ...) C next fail name (arg* ...) (clause* ...))
+         (define (name Ca ... arg* ...)
+           (define-syntax fail
+             (syntax-rules ()
+               [(_) (C FAIL (Ca ...))]))
+           (C GEN-TEST c next (Ca ...)
+              (gen-empty C (Ca ...) clause* ...)
+              (gen-char C (Ca ...) c clause* ...)))]))
+    (define-syntax define-parser^
+      (lambda (x)
+        (define (lookup ls1 ls2)
+          (lambda (var)
+            (let f ([ls1 ls1] [ls2 ls2])
+              (cond
+                [(null? ls1) 
+                 (error 'define-parser "cannot find" var)]
+                [(bound-identifier=? var (car ls1))
+                 (car ls2)]
+                [else (f (cdr ls1) (cdr ls2))]))))
+        (syntax-case x ()
           [(_ (entries ...) config next fail
+             orig*
              [name* (arg** ...) clause** ...] ...)
-           (begin
-             (module M (entries ...)
-               (config GEN-ARGS 
-                  gen-clause config next fail name* 
-                  (arg** ...)
-                  (clause** ...))
-               ...)
-             (import M))])))
+           (with-syntax ([(mapped-entries ...)
+                          (map 
+                            (lookup
+                              (car (syntax->datum #'orig*)) 
+                              #'(name* ...))
+                            #'(entries ...))])
+             #'(begin
+                 (config GEN-ARGS 
+                    gen-clause config next fail name* 
+                    (arg** ...)
+                    (clause** ...))
+                 ...
+                 (define entries mapped-entries)
+                 ...))])))
+    (define-syntax define-parser
+      (lambda (x)
+        (syntax-case x ()
+          [(_ definer next fail [name* (arg** ...) clause** ...] ...)
+           (with-syntax ([orig*
+                          (datum->syntax #'foo (list #'(name* ...)))])
+             #'(define-syntax definer
+                 (syntax-rules ()
+                   [(_ config (entries (... ...)))
+                    (define-parser^ (entries (... ...)) config next fail
+                      orig*
+                      [name* (arg** ...) clause** ...] ...)])))]))))
 
-    (define-syntax string-config
-      (syntax-rules (GEN-EOF? GEN-REF GEN-ARGS GEN-NEXT FAIL)
-        [(_ GEN-EOF? (s n i)) (fx=? i n)]
-        [(_ GEN-REF (s n i)) (string-ref s i)]
-        [(_ GEN-ARGS k . rest) (k (s n i) . rest)]
-        [(_ GEN-NEXT (s n i) who . rest) 
-         (who s n (fx+ i 1) . rest)]
-        [(_ FAIL (s n i)) #f]))
 
-    (define-parser (do-parse) string-config next fail
 
-      (ratio+ (r ex sn num ac)
-        [(eof)
-         (if (= ac 0)
-             (fail)
-             (do-sn/ex sn ex (/ num ac)))]
-        [(digit r) => d
-         (next ratio+ r ex sn num (+ (* ac r) d))]
-        [(#\+)
-         (if (= ac 0)
-             (fail)
-             (let ([real (do-sn/ex sn ex (/ num ac))])
-               (next im:sign r real ex +1)))]
-        [(#\-)
-         (if (= ac 0)
-             (fail)
-             (let ([real (do-sn/ex sn ex (/ num ac))])
-               (next im:sign r real ex -1)))]
-        [(#\i)
-         (if (= ac 0)
-             (fail)
-             (make-rectangular 0 (do-sn/ex sn ex (/ num ac))))])
+  (define-parser define-string->number-parser next fail
 
-      (im:ratio+ (r real ex sn num ac)
-        [(digit r) => d
-         (next im:ratio+ r real ex sn num (+ (* ac r) d))]
-        [(#\i) 
-         (if (= ac 0)
-             (fail)
-             (next im:done 
-               (make-rectangular real (do-sn/ex sn ex (/ num ac)))))])
+    (ratio+ (r ex sn num ac)
+      [(eof)
+       (if (= ac 0)
+           (fail)
+           (do-sn/ex sn ex (/ num ac)))]
+      [(digit r) => d
+       (next ratio+ r ex sn num (+ (* ac r) d))]
+      [(#\+)
+       (if (= ac 0)
+           (fail)
+           (let ([real (do-sn/ex sn ex (/ num ac))])
+             (next im:sign r real ex +1)))]
+      [(#\-)
+       (if (= ac 0)
+           (fail)
+           (let ([real (do-sn/ex sn ex (/ num ac))])
+             (next im:sign r real ex -1)))]
+      [(#\i)
+       (if (= ac 0)
+           (fail)
+           (make-rectangular 0 (do-sn/ex sn ex (/ num ac))))])
 
-      (im:done (n)
-        [(eof) n])
+    (im:ratio+ (r real ex sn num ac)
+      [(digit r) => d
+       (next im:ratio+ r real ex sn num (+ (* ac r) d))]
+      [(#\i) 
+       (if (= ac 0)
+           (fail)
+           (next im:done 
+             (make-rectangular real (do-sn/ex sn ex (/ num ac)))))])
 
-      (ratio (r ex sn num)
-        [(digit r) => d
-         (next ratio+ r ex sn num d)])
+    (im:done (n)
+      [(eof) n])
 
-      (im:ratio (r real ex sn num)
-        [(digit r) => d
-         (next im:ratio+ r real ex sn num d)])
+    (ratio (r ex sn num)
+      [(digit r) => d
+       (next ratio+ r ex sn num d)])
 
-      (exponent+digit (r ex sn ac exp1 exp2 exp-sign)
-        [(eof)
-         (do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))]
-        [(digit r) => d
-         (next exponent+digit r ex sn ac exp1 (+ (* exp2 r) d) exp-sign)])
+    (im:ratio (r real ex sn num)
+      [(digit r) => d
+       (next im:ratio+ r real ex sn num d)])
 
-      (exponent+sign (r ex sn ac exp1 exp-sign)
-        [(digit r) => d
-         (next exponent+digit r ex sn ac exp1 d exp-sign)])
+    (exponent+digit (r ex sn ac exp1 exp2 exp-sign)
+      [(eof)
+       (do-dec-sn/ex sn ex (* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))]
+      [(digit r) => d
+       (next exponent+digit r ex sn ac exp1 (+ (* exp2 r) d) exp-sign)])
 
-      (exponent (r ex sn ac exp1)
-        [(digit r) => d
-         (next exponent+digit r ex sn ac exp1 d +1)]
-        [(#\+) (next exponent+sign r ex sn ac exp1 +1)]
-        [(#\-) (next exponent+sign r ex sn ac exp1 -1)])
+    (exponent+sign (r ex sn ac exp1 exp-sign)
+      [(digit r) => d
+       (next exponent+digit r ex sn ac exp1 d exp-sign)])
 
-      (digit+dot (r ex sn ac exp)
-        [(eof)
-         (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]
-        [(digit r) => d
-         (next digit+dot r ex sn (+ (* ac r) d) (- exp 1))]
-        [(#\+)
-         (let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
-           (next im:sign r real ex +1))]
-        [(#\-)
-         (let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
-           (next im:sign r real ex -1))]
-        [(#\i)
-         (let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
-           (next im:done (make-rectangular 0.0 real)))]
-        [(#\e)
-         (if (fx=? r 10)
-             (next exponent r ex sn ac exp)
-             (fail))])
+    (exponent (r ex sn ac exp1)
+      [(digit r) => d
+       (next exponent+digit r ex sn ac exp1 d +1)]
+      [(#\+) (next exponent+sign r ex sn ac exp1 +1)]
+      [(#\-) (next exponent+sign r ex sn ac exp1 -1)])
 
-      (digit+ (r ex sn ac)
-        [(eof) (do-sn/ex sn ex ac)]
-        [(digit r) => d
-         (next digit+ r ex sn (+ (* ac r) d))]
-        [(#\/) (next ratio r ex sn ac)]
-        [(#\.)
-         (if (fx=? r 10) 
-             (next digit+dot r ex sn ac 0)
-             (fail))]
-        [(#\+)
-         (let ([real (do-sn/ex sn ex ac)])
-           (next im:sign r real ex +1))]
-        [(#\-)
-         (let ([real (do-sn/ex sn ex ac)])
-           (next im:sign r real ex -1))]
-        [(#\i)
-         (make-rectangular 0 (do-sn/ex sn ex ac))]
-        [(#\e)
-         (if (fx=? r 10) 
-             (next exponent r ex sn ac 0)
-             (fail))])
+    (digit+dot (r ex sn ac exp)
+      [(eof)
+       (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]
+      [(digit r) => d
+       (next digit+dot r ex sn (+ (* ac r) d) (- exp 1))]
+      [(#\+)
+       (let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
+         (next im:sign r real ex +1))]
+      [(#\-)
+       (let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
+         (next im:sign r real ex -1))]
+      [(#\i)
+       (let ([real (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
+         (next im:done (make-rectangular 0.0 real)))]
+      [(#\e)
+       (if (fx=? r 10)
+           (next exponent r ex sn ac exp)
+           (fail))])
 
-      (im:digit+ (r real ex sn ac)
-        [(digit r) => d
-         (next im:digit+ r real ex sn (+ (* ac r) d))]
-        [(#\/)
-         (next im:ratio r real ex sn ac)]
-        [(#\i)
-         (next im:done (make-rectangular real (do-sn/ex sn ex ac)))])
+    (digit+ (r ex sn ac)
+      [(eof) (do-sn/ex sn ex ac)]
+      [(digit r) => d
+       (next digit+ r ex sn (+ (* ac r) d))]
+      [(#\/) (next ratio r ex sn ac)]
+      [(#\.)
+       (if (fx=? r 10) 
+           (next digit+dot r ex sn ac 0)
+           (fail))]
+      [(#\+)
+       (let ([real (do-sn/ex sn ex ac)])
+         (next im:sign r real ex +1))]
+      [(#\-)
+       (let ([real (do-sn/ex sn ex ac)])
+         (next im:sign r real ex -1))]
+      [(#\i)
+       (make-rectangular 0 (do-sn/ex sn ex ac))]
+      [(#\e)
+       (if (fx=? r 10) 
+           (next exponent r ex sn ac 0)
+           (fail))])
 
-      (sign-i (r ex sn)
-        [(eof)
-         (make-rectangular 
-           (if (eq? ex 'i) 0.0 0)
-           sn)]
-        [(#\n) (next sign-in r sn)])
-      (sign-in (r sn)
-        [(#\f) (next sign-inf r sn)])
-      (sign-inf (r sn)
-        [(#\.) (next sign-inf. r sn)])
-      (sign-inf. (r sn)
-        [(#\0) (next sign-inf.0 r sn)])
-      (sign-inf.0 (r sn)
-        [(eof) (* sn +inf.0)]
-        [(#\i) 
-         (next im:done (make-rectangular 0.0 (* sn +inf.0)))])
+    (im:digit+ (r real ex sn ac)
+      [(digit r) => d
+       (next im:digit+ r real ex sn (+ (* ac r) d))]
+      [(#\/)
+       (next im:ratio r real ex sn ac)]
+      [(#\i)
+       (next im:done (make-rectangular real (do-sn/ex sn ex ac)))])
 
-      (im:sign-i (real ex sn)
-        [(eof) (make-rectangular real (do-sn/ex sn ex 1))]
-        [(#\n) (next im:sign-in (make-rectangular real (* sn +inf.0)))])
-      (im:sign-in (n)
-        [(#\f) (next im:sign-inf n)])
-      (im:sign-inf (n)
-        [(#\.) (next im:sign-inf. n)])
-      (im:sign-inf. (n)
-        [(#\0) (next im:sign-inf.0 n)])
-      (im:sign-inf.0 (n)
-        [(#\i) (next im:done n)])
+    (sign-i (r ex sn)
+      [(eof)
+       (make-rectangular 
+         (if (eq? ex 'i) 0.0 0)
+         sn)]
+      [(#\n) (next sign-in r sn)])
+    (sign-in (r sn)
+      [(#\f) (next sign-inf r sn)])
+    (sign-inf (r sn)
+      [(#\.) (next sign-inf. r sn)])
+    (sign-inf. (r sn)
+      [(#\0) (next sign-inf.0 r sn)])
+    (sign-inf.0 (r sn)
+      [(eof) (* sn +inf.0)]
+      [(#\i) 
+       (next im:done (make-rectangular 0.0 (* sn +inf.0)))])
 
-      (dot (r ex sn)
-        [(digit r) => d
-         (next digit+dot r ex sn d -1)])
+    (im:sign-i (real ex sn)
+      [(eof) (make-rectangular real (do-sn/ex sn ex 1))]
+      [(#\n) (next im:sign-in (make-rectangular real (* sn +inf.0)))])
+    (im:sign-in (n)
+      [(#\f) (next im:sign-inf n)])
+    (im:sign-inf (n)
+      [(#\.) (next im:sign-inf. n)])
+    (im:sign-inf. (n)
+      [(#\0) (next im:sign-inf.0 n)])
+    (im:sign-inf.0 (n)
+      [(#\i) (next im:done n)])
 
-      (im:sign (r real ex sn)
-        [(digit r) => d
-         (next im:digit+ r real ex sn d)]
-        [(#\i) 
-         (next im:sign-i real ex sn)])
-    
-      (sign (r ex sn)
-        [(digit r) => d
-         (next digit+ r ex sn d)]
-        [(#\i)
-         (next sign-i r ex sn)]
-        [(#\.)
-         (if (fx=? r 10)
-             (next dot r ex sn)
-             (fail))])
+    (dot (r ex sn)
+      [(digit r) => d
+       (next digit+dot r ex sn d -1)])
 
-      (do-parse-h (dr r ex)
-        [(#\x #\X)
-         (if r (fail) (next do-parse 16 16 ex))]
-        [(#\o #\O)
-         (if r (fail) (next do-parse 8 8 ex))]
-        [(#\b #\B)
-         (if r (fail) (next do-parse 2 2 ex))]
-        [(#\d #\D)
-         (if r (fail) (next do-parse 10 10 ex))]
-        [(#\e #\E)
-         (if ex (fail) (next do-parse dr r 'e))]
-        [(#\i #\I)
-         (if ex (fail) (next do-parse dr r 'i))])
+    (im:sign (r real ex sn)
+      [(digit r) => d
+       (next im:digit+ r real ex sn d)]
+      [(#\i) 
+       (next im:sign-i real ex sn)])
+  
+    (sign (r ex sn)
+      [(digit r) => d
+       (next digit+ r ex sn d)]
+      [(#\i)
+       (next sign-i r ex sn)]
+      [(#\.)
+       (if (fx=? r 10)
+           (next dot r ex sn)
+           (fail))]
+      [(#\n)
+       (next sign-n)])
+    (sign-n () [(#\a) (next sign-na)])
+    (sign-na () [(#\n) (next sign-nan)])
+    (sign-nan () [(#\.) (next sign-nan.)])
+    (sign-nan. () [(#\0) (next sign-nan.0)])
+    (sign-nan.0 ()
+      [(eof) +nan.0]
+      [(#\i) (next sign-nan.0i)])
+    (sign-nan.0i ()
+      [(eof) (make-rectangular 0.0 +nan.0)])
 
-      (do-parse (dr r ex)
-        [(#\#) (next do-parse-h dr r ex)]
-        [(#\+) (next sign dr ex +1)]
-        [(#\-) (next sign dr ex -1)]
-        [(#\.)
-         (if (fx=? dr 10) 
-             (next dot dr ex +1)
-             (fail))]
-        [(digit dr) => d
-         (next digit+ dr ex +1 d)])
-    )
+    (parse-string-h (dr r ex)
+      [(#\x #\X)
+       (if r (fail) (next parse-string 16 16 ex))]
+      [(#\o #\O)
+       (if r (fail) (next parse-string 8 8 ex))]
+      [(#\b #\B)
+       (if r (fail) (next parse-string 2 2 ex))]
+      [(#\d #\D)
+       (if r (fail) (next parse-string 10 10 ex))]
+      [(#\e #\E)
+       (if ex (fail) (next parse-string dr r 'e))]
+      [(#\i #\I)
+       (if ex (fail) (next parse-string dr r 'i))])
 
-    (define string->number
-      (case-lambda
-        [(s)
-         (unless (string? s) (die who "not a string" s))
-         (do-parse s (string-length s) 0 10 #f #f)]
-        [(s r)
-         (unless (string? s) (die who "not a string" s))
-         (unless (memv r '(10 16 2 8)) (die who "invalid radix" r))
-         (do-parse s (string-length s) 0 r #f #f)]))
-    
-    ))
+    (parse-string (dr r ex)
+      [(#\#) (next parse-string-h dr r ex)]
+      [(#\+) (next sign dr ex +1)]
+      [(#\-) (next sign dr ex -1)]
+      [(#\.)
+       (if (fx=? dr 10) 
+           (next dot dr ex +1)
+           (fail))]
+      [(digit dr) => d
+       (next digit+ dr ex +1 d)])
+  )
+
+  (define-syntax string-config
+    (syntax-rules (GEN-TEST GEN-ARGS FAIL)
+      [(_ GEN-ARGS k . rest) (k (s n i) . rest)]
+      [(_ FAIL (s n i)) #f]
+      [(_ GEN-TEST var next (s n i) sk fk)
+       (if (fx=? i n)
+           sk
+           (let ([var (string-ref s i)])
+             (define-syntax next
+               (syntax-rules ()
+                 [(_ who args (... ...))
+                  (who s n (fx+ i 1) args (... ...))]))
+             fk))]))
+
+  (define-string->number-parser string-config (parse-string))
+
+  (define string->number
+    (case-lambda
+      [(s)
+       (unless (string? s) (die who "not a string" s))
+       (parse-string s (string-length s) 0 10 #f #f)]
+      [(s r)
+       (unless (string? s) (die who "not a string" s))
+       (unless (memv r '(10 16 2 8)) (die who "invalid radix" r))
+       (parse-string s (string-length s) 0 r #f #f)]))
+  
+)
 
 
 
diff --git a/scheme/last-revision b/scheme/last-revision
index 9d877e1..5d030fe 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1494
+1495
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index 99765de..8979255 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -82,9 +82,7 @@
     "ikarus.intel-assembler.ss"
     "ikarus.trace.ss"
     "ikarus.fasl.write.ss"
-;;; HERE
     "ikarus.fasl.ss"
-
     "ikarus.compiler.ss"
     "psyntax.compat.ss"
     "psyntax.library-manager.ss"
@@ -92,7 +90,6 @@
     "psyntax.config.ss"
     "psyntax.builders.ss"
     "psyntax.expander.ss"
-
     "ikarus.load.ss"
     "ikarus.pretty-print.ss"
     "ikarus.cafe.ss"