Changeset 16009 in project


Ignore:
Timestamp:
09/21/09 03:01:33 (10 years ago)
Author:
Kon Lovett
Message:

Forgot blob & procedure

Location:
release/4/coerce
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/coerce/tags/1.0.0/type-coerce.scm

    r16006 r16009  
    2626;;
    2727;; - The coercion of a composite object to a scalar often makes no sense.
     28;;
     29;; - The coercion of a scalar object to a composite is usually just to
     30;; box the object in the specified composite.
    2831
    2932(module type-coerce (;export
     
    3336  coerce-all)
    3437
    35   (import scheme
    36           chicken
     38#|
     39  (cond-expand
     40    (full-numeric-tower
     41      (import (except scheme
     42                      + - * / = > < >= <=
     43                      number->string string->number
     44                      eqv? equal?
     45                      exp log sin cos tan atan acos asin expt sqrt
     46                      quotient modulo remainder
     47                      numerator denominator
     48                      abs max min gcd lcm
     49                      positive? negative? odd? even? zero?
     50                      exact? inexact?
     51                      rationalize
     52                      floor ceiling truncate round
     53                      inexact->exact exact->inexact
     54                      number? complex? real? rational? integer?
     55                      make-rectangular make-polar real-part imag-part magnitude angle)
     56                    (except chicken add1 sub1 random randomize conj signum
     57                      force-finalizers
     58                      bitwise-and bitwise-ior bitwise-xor bitwise-not arithmetic-shift)
     59              numbers )
     60      (require-library numbers) )
     61    (else
     62      (import scheme chicken) ) )
     63|#
     64
     65  (import scheme chicken)
     66  (import chicken
    3767          (only data-structures alist-ref)
    38           (only lolevel record->vector)
    3968          (only srfi-1 every reverse!)
    4069          (only miscmacros if*)
     
    4372          type-of)
    4473
    45   (require-library data-structures lolevel srfi-1
     74  (require-library data-structures srfi-1
    4675                   miscmacros type-checks type-errors type-of)
    4776
    4877;;;
    4978
    50 #; ;NOT YET
    51 (define (vector->record x)
    52   (##sys#check-vector x 'vector->record)
    53   (let* ((n (##sys#size x))
    54                (v (##sys#make-structure/size n)) )
    55     (do ((i 0 (fx+ i 1)))
    56               ((fx>= i n) v)
    57       (##sys#setslot v i (##sys#slot x i)) ) ) )
     79(define (->boolean obj) (and obj #t))
    5880
    5981(define (string->vector x) (list->vector (string->list x)))
    6082(define (vector->string x) (list->string (vector->list x)))
    61 
    62 #| ;JOKE
    63 (define (record->string x) (vector->string (record->vector x)))
    64 (define (string->record x) (vector->record (string->vector x)))
    65 |#
    6683
    6784;;; Extension
     
    117134  (when default-proc (check-procedure 'coerce default-proc 'default-proc))
    118135  (let ((objtyp (type-of obj)))
    119     (if (eq? objtyp restyp) obj
    120         (case objtyp
    121           ((char)
    122             (case restyp
    123               ((atom)     obj )
    124               ((number integer)
    125                 (char->integer obj) )
    126               ((string)   (string obj) )
    127               ((keyword)  (string->keyword (number->string obj)) )
    128               ((symbol)   (string->keyword (number->string obj)) )
    129               ((list)     (list obj) )
    130               ((vector)   (vector obj) )
    131               (else       (other->other) ) ) )
    132           ((number)
    133             (case restyp
    134               ((atom)     obj )
    135               ((char)     (integer->char obj) )
    136               ((integer)  (inexact->exact obj) )
    137               ((string)   (number->string obj) )
    138               ((keyword)  (string->keyword (number->string obj)) )
    139               ((symbol)   (string->symbol (number->string obj)) )
    140               ((list)     (string->list (number->string obj)) )
    141               ((vector)   (string->vector (number->string obj)) )
    142               (else       (other->other) ) ) )
    143           ((keyword)
    144             (case restyp
    145               ((atom)     obj )
    146               ((char)     (coerce (keyword->string obj) 'char) )
    147               ((number integer)
    148                 (coerce (keyword->string obj) restyp) )
    149               ((string)   (keyword->string obj) )
    150               ((symbol)   (string->symbol (keyword->string obj)) )
    151               ((list)     (string->list (keyword->string obj)) )
    152               ((vector)   (string->vector (keyword->string obj)) )
    153               (else       (other->other) ) ) )
    154           ((symbol)
    155             (case restyp
    156               ((atom)     obj )
    157               ((char)     (coerce (symbol->string obj) 'char) )
    158               ((number integer)
    159                 (coerce (symbol->string obj) restyp) )
    160               ((string)   (symbol->string obj) )
    161               ((keyword)  (string->keyword (symbol->string obj)) )
    162               ((list)     (string->list (symbol->string obj)) )
    163               ((vector)   (string->vector (symbol->string obj)) )
    164               (else       (other->other) ) ) )
    165           ((string)
    166             (case restyp
    167               ((atom)     (or (string->number obj) (string->symbol obj)) )
     136    (cond ((eq? objtyp restyp)    obj )
     137          ((eq? 'boolean restyp)  (->boolean obj) )
     138          (else
     139            (case objtyp
     140              ((boolean)
     141                (case restyp
     142                  ((atom)     obj )
     143                  ((number integer)
     144                    (if obj 1 0) )
     145                  ((string)   (if obj "true" "false") )
     146                  ((keyword)  (string->keyword (if obj "true" "false")) )
     147                  ((symbol)   (string->symbol (if obj "true" "false")) )
     148                  ((list)     (list obj) )
     149                  ((vector)   (vector obj) )
     150                  (else       (other->other) ) ) )
    168151              ((char)
    169                 (if (= 1 (string-length obj)) (string-ref obj 0)
    170                     (other->other)))
    171               ((number integer)
    172                 (or (string->number obj)
    173                     (other->other)) )
    174               ((keyword)  (string->keyword obj) )
    175               ((symbol)   (string->symbol obj) )
    176               ((list)     (string->list obj) )
    177               ((vector)   (string->vector obj) )
    178               #; ;JOKE
    179               ((record-instance)
    180                 (record->string obj) )
    181               (else       (other->other) ) ) )
    182           ((list)
    183             (case restyp
    184               ((atom)     (coerce (list->string obj) 'atom) )
    185               ((char)
    186                 (if (and (= 1 (length obj)) (char? (car obj)))
    187                     (car obj)
    188                     (other->other)) )
    189               ((number integer)
    190                (or (string->number (list->string obj))
    191                    (other->other)) )
    192               ((string)   (list->string obj) )
    193               ((keyword)  (string->keyword (list->string obj)) )
    194               ((symbol)   (string->symbol (list->string obj)) )
    195               ((vector)   (list->vector obj) )
    196               #; ;NOT YET
    197               ((record-instance)
    198                 (vector->record (list->vector obj)) )
    199               (else       (other->other) ) ) )
    200           ((vector)
    201             (case restyp
    202               ((atom)     (coerce (vector->string obj) 'atom) )
    203               ((char)
    204                 (if (and (= 1 (vector-length obj)) (char? (vector-ref obj 0)))
    205                     (vector-ref obj 0)
    206                     (other->other)) )
    207               ((number integer )
    208                 (or (string->number (coerce obj 'string))
    209                     (other->other)) )
    210               ((string)   (vector->string obj) )
    211               ((keyword)  (string->keyword (vector->string obj)) )
    212               ((symbol)   (string->symbol (vector->string obj)) )
    213               ((list)     (vector->list obj) )
    214               #; ;NOT YET
    215               ((record-instance)
    216                 (vector->record obj) )
    217               (else       (other->other) ) ) )
    218           ((record-instance)
    219             (case restyp
    220               #| ;JOKE
    221               ((atom)     (coerce (record->string obj 'atom) )
    222               ((char)
    223                 (if (and (= 1 (record-instance-length obj)) (char? (record-instance-slot obj 0)))
    224                     (record-instance-slot obj 0)
    225                     (other->other)) )
    226               ((number integer)
    227                (or (string->number (record->string obj)
    228                    (other->other)) )
    229               ((string)   (record->string obj )
    230               ((keyword)  (string->keyword (record->string obj) )
    231               ((symbol)   (string->symbol (record->string obj) )
    232               |#
    233               ((list)     (vector->list (record->vector obj)) )
    234               ((vector)   (record->vector obj) )
    235               (else       (other->other) ) ) )
    236           (else
    237             (other->other) ) ) ) ) )
     152                (case restyp
     153                  ((atom)     obj )
     154                  ((number integer)
     155                    (char->integer obj) )
     156                  ((string)   (string obj) )
     157                  ((keyword)  (string->keyword (number->string obj)) )
     158                  ((symbol)   (string->symbol (number->string obj)) )
     159                  ((list)     (list obj) )
     160                  ((vector)   (vector obj) )
     161                  (else       (other->other) ) ) )
     162              ((number)
     163                (case restyp
     164                  ((atom)     obj )
     165                  ((char)     (integer->char obj) )
     166                  ((integer)  (inexact->exact obj) )
     167                  ((string)   (number->string obj) )
     168                  ((keyword)  (string->keyword (number->string obj)) )
     169                  ((symbol)   (string->symbol (number->string obj)) )
     170                  ((list)     (string->list (number->string obj)) )
     171                  ((vector)   (string->vector (number->string obj)) )
     172                  (else       (other->other) ) ) )
     173              ((keyword)
     174                (case restyp
     175                  ((atom)     obj )
     176                  ((char)     (coerce (keyword->string obj) 'char) )
     177                  ((number integer)
     178                    (coerce (keyword->string obj) restyp) )
     179                  ((string)   (keyword->string obj) )
     180                  ((symbol)   (string->symbol (keyword->string obj)) )
     181                  ((list)     (string->list (keyword->string obj)) )
     182                  ((vector)   (string->vector (keyword->string obj)) )
     183                  (else       (other->other) ) ) )
     184              ((symbol)
     185                (case restyp
     186                  ((atom)     obj )
     187                  ((char)     (coerce (symbol->string obj) 'char) )
     188                  ((number integer)
     189                    (coerce (symbol->string obj) restyp) )
     190                  ((string)   (symbol->string obj) )
     191                  ((keyword)  (string->keyword (symbol->string obj)) )
     192                  ((list)     (string->list (symbol->string obj)) )
     193                  ((vector)   (string->vector (symbol->string obj)) )
     194                  (else       (other->other) ) ) )
     195              ((string)
     196                (case restyp
     197                  ((atom)     (or (string->number obj) (string->symbol obj)) )
     198                  ((char)
     199                    (if (= 1 (string-length obj)) (string-ref obj 0)
     200                        (other->other)))
     201                  ((number integer)
     202                    (or (string->number obj)
     203                        (other->other)) )
     204                  ((keyword)  (string->keyword obj) )
     205                  ((symbol)   (string->symbol obj) )
     206                  ((list)     (string->list obj) )
     207                  ((vector)   (string->vector obj) )
     208                  ((blob)     (string->blob obj) )
     209                  (else       (other->other) ) ) )
     210              ((list)
     211                (case restyp
     212                  ((atom)     (coerce (list->string obj) 'atom) )
     213                  ((char)
     214                    (if (and (= 1 (length obj)) (char? (car obj)))
     215                        (car obj)
     216                        (other->other)) )
     217                  ((number integer)
     218                   (or (string->number (list->string obj))
     219                       (other->other)) )
     220                  ((string)   (list->string obj) )
     221                  ((keyword)  (string->keyword (list->string obj)) )
     222                  ((symbol)   (string->symbol (list->string obj)) )
     223                  ((vector)   (list->vector obj) )
     224                  (else       (other->other) ) ) )
     225              ((vector)
     226                (case restyp
     227                  ((atom)     (coerce (vector->string obj) 'atom) )
     228                  ((char)
     229                    (if (and (= 1 (vector-length obj)) (char? (vector-ref obj 0)))
     230                        (vector-ref obj 0)
     231                        (other->other)) )
     232                  ((number integer )
     233                    (or (string->number (coerce obj 'string))
     234                        (other->other)) )
     235                  ((string)   (vector->string obj) )
     236                  ((keyword)  (string->keyword (vector->string obj)) )
     237                  ((symbol)   (string->symbol (vector->string obj)) )
     238                  ((list)     (vector->list obj) )
     239                  (else       (other->other) ) ) )
     240              ((blob)
     241                (case restyp
     242                  ((string)   (blob->string obj))
     243                  (else       (other->other) ) ) )
     244              (else
     245                (other->other) ) ) ) ) ) )
    238246
    239247;;
  • release/4/coerce/tags/1.0.0/type-of.scm

    r16006 r16009  
    3838  other-coerce)
    3939
    40   (import scheme
    41           chicken
    42           (only data-structures identity)
    43           (only lolevel record-instance?)
     40#|
     41; Need someway to make compiling for the full-numeric-tower & utf8 easier
     42
     43  (cond-expand
     44    (full-numeric-tower
     45      (import (except scheme
     46                      + - * / = > < >= <=
     47                      number->string string->number
     48                      eqv? equal?
     49                      exp log sin cos tan atan acos asin expt sqrt
     50                      quotient modulo remainder
     51                      numerator denominator
     52                      abs max min gcd lcm
     53                      positive? negative? odd? even? zero?
     54                      exact? inexact?
     55                      rationalize
     56                      floor ceiling truncate round
     57                      inexact->exact exact->inexact
     58                      number? complex? real? rational? integer?
     59                      make-rectangular make-polar real-part imag-part magnitude angle)
     60                    (except chicken add1 sub1 random randomize conj signum
     61                      force-finalizers
     62                      bitwise-and bitwise-ior bitwise-xor bitwise-not arithmetic-shift)
     63              numbers )
     64      (require-library numbers) )
     65    (else
     66      (import scheme chicken) ) )
     67|#
     68
     69  (import scheme chicken)
     70  (import (only data-structures identity)
     71          (only lolevel record-instance? record-instance-type)
    4472          (only miscmacros if*)
    4573          (only type-checks check-procedure check-symbol)
    4674          type-extend-support)
    4775
    48   (require-library data-structures lolevel miscmacros
    49                    type-checks type-extend-support)
     76  (require-library data-structures lolevel
     77                   miscmacros type-checks type-extend-support)
    5078
    5179;;@body
     
    6694        ((pair? obj)              'pair)
    6795        ((vector? obj)            'vector)
    68         ((record-instance? obj)   'record-instance)
     96        ((record-instance? obj)   (record-instance-type obj))
     97        ((blob? obj)              'blob)
     98        ((procedure? obj)         'procedure)
    6999        ((eq? (void) obj)         'unspecified)
    70100        (else
  • release/4/coerce/trunk/type-coerce.scm

    r16008 r16009  
    2626;;
    2727;; - The coercion of a composite object to a scalar often makes no sense.
     28;;
     29;; - The coercion of a scalar object to a composite is usually just to
     30;; box the object in the specified composite.
    2831
    2932(module type-coerce (;export
     
    3336  coerce-all)
    3437
    35   (import scheme
    36           chicken
     38#|
     39  (cond-expand
     40    (full-numeric-tower
     41      (import (except scheme
     42                      + - * / = > < >= <=
     43                      number->string string->number
     44                      eqv? equal?
     45                      exp log sin cos tan atan acos asin expt sqrt
     46                      quotient modulo remainder
     47                      numerator denominator
     48                      abs max min gcd lcm
     49                      positive? negative? odd? even? zero?
     50                      exact? inexact?
     51                      rationalize
     52                      floor ceiling truncate round
     53                      inexact->exact exact->inexact
     54                      number? complex? real? rational? integer?
     55                      make-rectangular make-polar real-part imag-part magnitude angle)
     56                    (except chicken add1 sub1 random randomize conj signum
     57                      force-finalizers
     58                      bitwise-and bitwise-ior bitwise-xor bitwise-not arithmetic-shift)
     59              numbers )
     60      (require-library numbers) )
     61    (else
     62      (import scheme chicken) ) )
     63|#
     64
     65  (import scheme chicken)
     66  (import chicken
    3767          (only data-structures alist-ref)
    3868          (only srfi-1 every reverse!)
     
    4676
    4777;;;
     78
     79(define (->boolean obj) (and obj #t))
    4880
    4981(define (string->vector x) (list->vector (string->list x)))
     
    102134  (when default-proc (check-procedure 'coerce default-proc 'default-proc))
    103135  (let ((objtyp (type-of obj)))
    104     (if (eq? objtyp restyp) obj
    105         (case objtyp
    106           ((char)
    107             (case restyp
    108               ((atom)     obj )
    109               ((number integer)
    110                 (char->integer obj) )
    111               ((string)   (string obj) )
    112               ((keyword)  (string->keyword (number->string obj)) )
    113               ((symbol)   (string->keyword (number->string obj)) )
    114               ((list)     (list obj) )
    115               ((vector)   (vector obj) )
    116               (else       (other->other) ) ) )
    117           ((number)
    118             (case restyp
    119               ((atom)     obj )
    120               ((char)     (integer->char obj) )
    121               ((integer)  (inexact->exact obj) )
    122               ((string)   (number->string obj) )
    123               ((keyword)  (string->keyword (number->string obj)) )
    124               ((symbol)   (string->symbol (number->string obj)) )
    125               ((list)     (string->list (number->string obj)) )
    126               ((vector)   (string->vector (number->string obj)) )
    127               (else       (other->other) ) ) )
    128           ((keyword)
    129             (case restyp
    130               ((atom)     obj )
    131               ((char)     (coerce (keyword->string obj) 'char) )
    132               ((number integer)
    133                 (coerce (keyword->string obj) restyp) )
    134               ((string)   (keyword->string obj) )
    135               ((symbol)   (string->symbol (keyword->string obj)) )
    136               ((list)     (string->list (keyword->string obj)) )
    137               ((vector)   (string->vector (keyword->string obj)) )
    138               (else       (other->other) ) ) )
    139           ((symbol)
    140             (case restyp
    141               ((atom)     obj )
    142               ((char)     (coerce (symbol->string obj) 'char) )
    143               ((number integer)
    144                 (coerce (symbol->string obj) restyp) )
    145               ((string)   (symbol->string obj) )
    146               ((keyword)  (string->keyword (symbol->string obj)) )
    147               ((list)     (string->list (symbol->string obj)) )
    148               ((vector)   (string->vector (symbol->string obj)) )
    149               (else       (other->other) ) ) )
    150           ((string)
    151             (case restyp
    152               ((atom)     (or (string->number obj) (string->symbol obj)) )
     136    (cond ((eq? objtyp restyp)    obj )
     137          ((eq? 'boolean restyp)  (->boolean obj) )
     138          (else
     139            (case objtyp
     140              ((boolean)
     141                (case restyp
     142                  ((atom)     obj )
     143                  ((number integer)
     144                    (if obj 1 0) )
     145                  ((string)   (if obj "true" "false") )
     146                  ((keyword)  (string->keyword (if obj "true" "false")) )
     147                  ((symbol)   (string->symbol (if obj "true" "false")) )
     148                  ((list)     (list obj) )
     149                  ((vector)   (vector obj) )
     150                  (else       (other->other) ) ) )
    153151              ((char)
    154                 (if (= 1 (string-length obj)) (string-ref obj 0)
    155                     (other->other)))
    156               ((number integer)
    157                 (or (string->number obj)
    158                     (other->other)) )
    159               ((keyword)  (string->keyword obj) )
    160               ((symbol)   (string->symbol obj) )
    161               ((list)     (string->list obj) )
    162               ((vector)   (string->vector obj) )
    163               (else       (other->other) ) ) )
    164           ((list)
    165             (case restyp
    166               ((atom)     (coerce (list->string obj) 'atom) )
    167               ((char)
    168                 (if (and (= 1 (length obj)) (char? (car obj)))
    169                     (car obj)
    170                     (other->other)) )
    171               ((number integer)
    172                (or (string->number (list->string obj))
    173                    (other->other)) )
    174               ((string)   (list->string obj) )
    175               ((keyword)  (string->keyword (list->string obj)) )
    176               ((symbol)   (string->symbol (list->string obj)) )
    177               ((vector)   (list->vector obj) )
    178               (else       (other->other) ) ) )
    179           ((vector)
    180             (case restyp
    181               ((atom)     (coerce (vector->string obj) 'atom) )
    182               ((char)
    183                 (if (and (= 1 (vector-length obj)) (char? (vector-ref obj 0)))
    184                     (vector-ref obj 0)
    185                     (other->other)) )
    186               ((number integer )
    187                 (or (string->number (coerce obj 'string))
    188                     (other->other)) )
    189               ((string)   (vector->string obj) )
    190               ((keyword)  (string->keyword (vector->string obj)) )
    191               ((symbol)   (string->symbol (vector->string obj)) )
    192               ((list)     (vector->list obj) )
    193               (else       (other->other) ) ) )
    194           (else
    195             (other->other) ) ) ) ) )
     152                (case restyp
     153                  ((atom)     obj )
     154                  ((number integer)
     155                    (char->integer obj) )
     156                  ((string)   (string obj) )
     157                  ((keyword)  (string->keyword (number->string obj)) )
     158                  ((symbol)   (string->symbol (number->string obj)) )
     159                  ((list)     (list obj) )
     160                  ((vector)   (vector obj) )
     161                  (else       (other->other) ) ) )
     162              ((number)
     163                (case restyp
     164                  ((atom)     obj )
     165                  ((char)     (integer->char obj) )
     166                  ((integer)  (inexact->exact obj) )
     167                  ((string)   (number->string obj) )
     168                  ((keyword)  (string->keyword (number->string obj)) )
     169                  ((symbol)   (string->symbol (number->string obj)) )
     170                  ((list)     (string->list (number->string obj)) )
     171                  ((vector)   (string->vector (number->string obj)) )
     172                  (else       (other->other) ) ) )
     173              ((keyword)
     174                (case restyp
     175                  ((atom)     obj )
     176                  ((char)     (coerce (keyword->string obj) 'char) )
     177                  ((number integer)
     178                    (coerce (keyword->string obj) restyp) )
     179                  ((string)   (keyword->string obj) )
     180                  ((symbol)   (string->symbol (keyword->string obj)) )
     181                  ((list)     (string->list (keyword->string obj)) )
     182                  ((vector)   (string->vector (keyword->string obj)) )
     183                  (else       (other->other) ) ) )
     184              ((symbol)
     185                (case restyp
     186                  ((atom)     obj )
     187                  ((char)     (coerce (symbol->string obj) 'char) )
     188                  ((number integer)
     189                    (coerce (symbol->string obj) restyp) )
     190                  ((string)   (symbol->string obj) )
     191                  ((keyword)  (string->keyword (symbol->string obj)) )
     192                  ((list)     (string->list (symbol->string obj)) )
     193                  ((vector)   (string->vector (symbol->string obj)) )
     194                  (else       (other->other) ) ) )
     195              ((string)
     196                (case restyp
     197                  ((atom)     (or (string->number obj) (string->symbol obj)) )
     198                  ((char)
     199                    (if (= 1 (string-length obj)) (string-ref obj 0)
     200                        (other->other)))
     201                  ((number integer)
     202                    (or (string->number obj)
     203                        (other->other)) )
     204                  ((keyword)  (string->keyword obj) )
     205                  ((symbol)   (string->symbol obj) )
     206                  ((list)     (string->list obj) )
     207                  ((vector)   (string->vector obj) )
     208                  ((blob)     (string->blob obj) )
     209                  (else       (other->other) ) ) )
     210              ((list)
     211                (case restyp
     212                  ((atom)     (coerce (list->string obj) 'atom) )
     213                  ((char)
     214                    (if (and (= 1 (length obj)) (char? (car obj)))
     215                        (car obj)
     216                        (other->other)) )
     217                  ((number integer)
     218                   (or (string->number (list->string obj))
     219                       (other->other)) )
     220                  ((string)   (list->string obj) )
     221                  ((keyword)  (string->keyword (list->string obj)) )
     222                  ((symbol)   (string->symbol (list->string obj)) )
     223                  ((vector)   (list->vector obj) )
     224                  (else       (other->other) ) ) )
     225              ((vector)
     226                (case restyp
     227                  ((atom)     (coerce (vector->string obj) 'atom) )
     228                  ((char)
     229                    (if (and (= 1 (vector-length obj)) (char? (vector-ref obj 0)))
     230                        (vector-ref obj 0)
     231                        (other->other)) )
     232                  ((number integer )
     233                    (or (string->number (coerce obj 'string))
     234                        (other->other)) )
     235                  ((string)   (vector->string obj) )
     236                  ((keyword)  (string->keyword (vector->string obj)) )
     237                  ((symbol)   (string->symbol (vector->string obj)) )
     238                  ((list)     (vector->list obj) )
     239                  (else       (other->other) ) ) )
     240              ((blob)
     241                (case restyp
     242                  ((string)   (blob->string obj))
     243                  (else       (other->other) ) ) )
     244              (else
     245                (other->other) ) ) ) ) ) )
    196246
    197247;;
  • release/4/coerce/trunk/type-of.scm

    r16008 r16009  
    3838  other-coerce)
    3939
    40   (import scheme
    41           chicken
    42           (only data-structures identity)
     40#|
     41; Need someway to make compiling for the full-numeric-tower & utf8 easier
     42
     43  (cond-expand
     44    (full-numeric-tower
     45      (import (except scheme
     46                      + - * / = > < >= <=
     47                      number->string string->number
     48                      eqv? equal?
     49                      exp log sin cos tan atan acos asin expt sqrt
     50                      quotient modulo remainder
     51                      numerator denominator
     52                      abs max min gcd lcm
     53                      positive? negative? odd? even? zero?
     54                      exact? inexact?
     55                      rationalize
     56                      floor ceiling truncate round
     57                      inexact->exact exact->inexact
     58                      number? complex? real? rational? integer?
     59                      make-rectangular make-polar real-part imag-part magnitude angle)
     60                    (except chicken add1 sub1 random randomize conj signum
     61                      force-finalizers
     62                      bitwise-and bitwise-ior bitwise-xor bitwise-not arithmetic-shift)
     63              numbers )
     64      (require-library numbers) )
     65    (else
     66      (import scheme chicken) ) )
     67|#
     68
     69  (import scheme chicken)
     70  (import (only data-structures identity)
    4371          (only lolevel record-instance? record-instance-type)
    4472          (only miscmacros if*)
     
    4674          type-extend-support)
    4775
    48   (require-library data-structures lolevel miscmacros
    49                    type-checks type-extend-support)
     76  (require-library data-structures lolevel
     77                   miscmacros type-checks type-extend-support)
    5078
    5179;;@body
     
    6795        ((vector? obj)            'vector)
    6896        ((record-instance? obj)   (record-instance-type obj))
     97        ((blob? obj)              'blob)
     98        ((procedure? obj)         'procedure)
    6999        ((eq? (void) obj)         'unspecified)
    70100        (else
Note: See TracChangeset for help on using the changeset viewer.