Changeset 9899 in project


Ignore:
Timestamp:
03/20/08 05:13:36 (12 years ago)
Author:
Kon Lovett
Message:

Save.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/string-natural-compare/trunk/string-natural-compare-support.scm

    r9898 r9899  
    130130              [(char-fence? cb)                         +1 ]
    131131              [(and (char-numeric? ca) (char-numeric? cb))
    132                (if (and (char-zero? ca) (char-zero? cb))
    133                    (loop (fx+ ia 1) (fx+ ib 1))
    134                    (let ([result (if (or (char-zero? ca) (char-zero? cb))
    135                                      (compare-left a ia b ib)
    136                                      (compare-right a ia b ib) ) ] )
    137                       (cond [(fixnum? result)  (loop (fx+ ia result) (fx+ ib result)) ]
    138                             [result             +1 ]
    139                             [else               -1 ] ) ) ) ]
    140               [ci?
    141                (cond [(char-ci<? ca cb)   -1 ]
    142                      [(char-ci>? ca cb)   +1 ]
    143                      [else                (loop (fx+ ia 1) (fx+ ib 1)) ] ) ]
    144               [else
    145                (cond [(char<? ca cb)   -1 ]
    146                      [(char>? ca cb)   +1 ]
    147                      [else             (loop (fx+ ia 1) (fx+ ib 1)) ] ) ] ) ) ) ) )
     132                (if (and (char-zero? ca) (char-zero? cb))
     133                    (loop (fx+ ia 1) (fx+ ib 1))
     134                    (let ([result (if (or (char-zero? ca) (char-zero? cb))
     135                                      (compare-left a ia b ib)
     136                                      (compare-right a ia b ib) ) ] )
     137                       (cond [(fixnum? result)  (loop (fx+ ia result) (fx+ ib result)) ]
     138                             [result             +1 ]
     139                             [else               -1 ] ) ) ) ]
     140              [ci?
     141                (cond [(char-ci<? ca cb)   -1 ]
     142                      [(char-ci>? ca cb)   +1 ]
     143                      [else                (loop (fx+ ia 1) (fx+ ib 1)) ] ) ]
     144              [else
     145                (cond [(char<? ca cb)   -1 ]
     146                      [(char>? ca cb)   +1 ]
     147                      [else             (loop (fx+ ia 1) (fx+ ib 1)) ] ) ] ) ) ) ) )
    148148
    149149;;
     
    160160              [(char-fence? cb)                         +1 ]
    161161              [(and (char-numeric? ca) (char-numeric? cb))
    162                (let ([result (if (and (char-zero? ca) (char-zero? cb))
    163                                  (compare-left a ia b ib)
    164                                  (compare-right a ia b ib) ) ] )
    165                   (cond [(fixnum? result)  (loop (fx+ ia result) (fx+ ib result)) ]
    166                         [result             +1 ]
    167                         [else               -1 ] ) ) ]
    168               [ci?
    169                (cond [(char-ci<? ca cb)   -1 ]
    170                      [(char-ci>? ca cb)   +1 ]
    171                      [else                (loop (fx+ ia 1) (fx+ ib 1)) ] ) ]
    172               [else
    173                (cond [(char<? ca cb)   -1 ]
    174                      [(char>? ca cb)   +1 ]
    175                      [else             (loop (fx+ ia 1) (fx+ ib 1)) ] ) ] ) ) ) ) )
     162                (let ([result (if (and (char-zero? ca) (char-zero? cb))
     163                                  (compare-left a ia b ib)
     164                                  (compare-right a ia b ib) ) ] )
     165                   (cond [(fixnum? result)  (loop (fx+ ia result) (fx+ ib result)) ]
     166                         [result             +1 ]
     167                         [else               -1 ] ) ) ]
     168              [ci?
     169                (cond [(char-ci<? ca cb)   -1 ]
     170                      [(char-ci>? ca cb)   +1 ]
     171                      [else                (loop (fx+ ia 1) (fx+ ib 1)) ] ) ]
     172              [else
     173                (cond [(char<? ca cb)   -1 ]
     174                      [(char>? ca cb)   +1 ]
     175                      [else             (loop (fx+ ia 1) (fx+ ib 1)) ] ) ] ) ) ) ) )
    176176
    177177;;
     
    215215              [(char-fence? cb)                         +1 ]
    216216              [(and (char-numeric? ca) (char-numeric? cb))
    217                (let loop ([i ia] [zs zeroskip])
    218                  (if (and (char-zero? (char@ a i))
    219                           (char-numeric (char@ a (fx+ i 1))))
    220                      (loop (fx+ i 1) (fx+ zs 1))
    221                      (begin
    222                        (set! ia i)
    223                        (set! zeroskip zs) ) ) )
    224                (let loop ([i ib] [zs zeroskip])
    225                  (if (and (char-zero? (char@ b i))
    226                           (char-numeric (char@ b (fx+ i 1))))
    227                      (loop (fx+ i 1) (fx- zs 1))
    228                      (begin
    229                        (set! ib i)
    230                        (set! zeroskip zs) ) ) )
    231                          
    232                  ]
    233               [ci?
    234                (cond [(char-ci<? ca cb)   -1 ]
    235                      [(char-ci>? ca cb)   +1 ]
    236                      [else                (loop (fx+ ia 1) (fx+ ib 1)) ] ) ]
    237               [else
    238                (cond [(char<? ca cb)   -1 ]
    239                      [(char>? ca cb)   +1 ]
    240                      [else             (loop (fx+ ia 1) (fx+ ib 1)) ] ) ] ) ) ) ) )
     217                (let loop ([i ia] [zs zeroskip])
     218                  (if (and (char-zero? (char@ a i))
     219                           (char-numeric (char@ a (fx+ i 1))))
     220                      (loop (fx+ i 1) (fx+ zs 1))
     221                      (begin
     222                        (set! ia i)
     223                        (set! zeroskip zs) ) ) )
     224                (let loop ([i ib] [zs zeroskip])
     225                  (if (and (char-zero? (char@ b i))
     226                           (char-numeric (char@ b (fx+ i 1))))
     227                      (loop (fx+ i 1) (fx- zs 1))
     228                      (begin
     229                        (set! ib i)
     230                        (set! zeroskip zs) ) ) )
     231                (let loop1 ([ja ia] [jb ib])
     232                  (let ([ca (char@ a ja)]
     233                        [cb (char@ b jb)])
     234                    (if (and (not (char-fence? ca)) (char-numeric? ca)
     235                             (not (char-fence? cb)) (char-numeric? cb))
     236                        (loop1 (fx+ ja 1) (fx+ jb 1))
     237                        (let ([ca (char@ a ja)]
     238                              [cb (char@ b jb)])
     239                          (cond [(and (not (char-fence? ca)) (char-numeric? ca))
     240                                  +1]
     241                                [(and (not (char-fence? cb)) (char-numeric? cb))
     242                                  -1]
     243                                [else
     244                                  (let loop2 ([i 0])
     245                                    (cond [(fx< (fx+ ia i) ja)
     246                                            (let ([ca (char@ a (fx+ ia i))]
     247                                                  [cb (char@ b (fx+ ib i))])
     248                                              (cond [(char<? ca cb)
     249                                                      -1 ]
     250                                                    [(char>? ca cb)
     251                                                      +1 ]
     252                                                    [else
     253                                                      (loop2 (fx+ i 1)) ] ) ) ]
     254                                          [(fx< 0 zeroskip)
     255                                            +1 ]
     256                                          [(fx< zeroskip 0)
     257                                            -1 ] )
     258                                          [else
     259                                            (loop (fx+ ia i) (fx+ ib i)) ] ) ] ) ) ) ) ) ]
     260              [ci?
     261                (cond [(char-ci<? ca cb)   -1 ]
     262                      [(char-ci>? ca cb)   +1 ]
     263                      [else                (loop (fx+ ia 1) (fx+ ib 1)) ] ) ]
     264              [else
     265                (cond [(char<? ca cb)   -1 ]
     266                      [(char>? ca cb)   +1 ]
     267                      [else             (loop (fx+ ia 1) (fx+ ib 1)) ] ) ] ) ) ) ) )
    241268
    242269;;;
Note: See TracChangeset for help on using the changeset viewer.