Changeset 16022 in project


Ignore:
Timestamp:
09/21/09 20:50:25 (10 years ago)
Author:
Kon Lovett
Message:

Added pointer & locative. Fixed default-proc args in other-coerce.

Location:
release/4/coerce/trunk
Files:
2 edited

Legend:

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

    r16009 r16022  
    2525;; - Cannot know before attempt if coercion possible.
    2626;;
    27 ;; - The coercion of a composite object to a scalar often makes no sense.
     27;; - The coercion of a composite object to a scalar often makes little sense.
    2828;;
    2929;; - The coercion of a scalar object to a composite is usually just to
    30 ;; box the object in the specified composite.
     30;; box the object with the specified composite.
    3131
    3232(module type-coerce (;export
  • release/4/coerce/trunk/type-of.scm

    r16009 r16022  
    6969  (import scheme chicken)
    7070  (import (only data-structures identity)
    71           (only lolevel record-instance? record-instance-type)
     71          (only lolevel record-instance? record-instance-type
     72                pointer? tagged-pointer? locative?)
    7273          (only miscmacros if*)
    7374          (only type-checks check-procedure check-symbol)
     
    8182
    8283(define (type-of obj)
    83   (cond ((boolean? obj)           'boolean)
    84         ((char? obj)              'char)
    85         ((number? obj)            'number)
    86         ((string? obj)            'string)
    87         ((keyword? obj)           'keyword)
    88         ((symbol? obj)            'symbol)
    89         ((input-port? obj)        'port)
    90         ((output-port? obj)       'port)
    91         ((procedure? obj)         'procedure)
    92         ((eof-object? obj)        'eof-object)
    93         ((list? obj)              'list)
    94         ((pair? obj)              'pair)
    95         ((vector? obj)            'vector)
    96         ((record-instance? obj)   (record-instance-type obj))
    97         ((blob? obj)              'blob)
    98         ((procedure? obj)         'procedure)
    99         ((eq? (void) obj)         'unspecified)
     84  (cond ((boolean? obj)                   'boolean)
     85        ((char? obj)                      'char)
     86        #;((fixnum? obj)                    'fixnum)
     87        #;((flonum? obj)                    'flonum)
     88        #;((bignum? obj)                    'bignum)
     89        #;((ratio? obj)                     'ratio)
     90        #;((complex? obj)                   'complex)
     91        ((number? obj)                    'number)
     92        ((string? obj)                    'string)
     93        ((keyword? obj)                   'keyword)
     94        ((symbol? obj)                    'symbol)
     95        ((input-port? obj)                'port #;'input-port)
     96        ((output-port? obj)               'port #;'output-port)
     97        #;((extended-procedure? obj)        'extended-procedure)
     98        ((procedure? obj)                 'procedure)
     99        ((eof-object? obj)                'eof-object)
     100        ((list? obj)                      'list)
     101        #;((circular-list? obj)             'circular-list)
     102        #;((dotted-list? obj)               'dotted-list)
     103        ((pair? obj)                      'pair)
     104        ((vector? obj)                    'vector)
     105        ((blob? obj)                      'blob)
     106        #;((tagged-pointer? obj)            'tagged-pointer)
     107        ((pointer? obj)                   'pointer)
     108        ((locative? obj)                  'locative)
     109        #;((##sys#lambda-info? obj)         'lambda-info)
     110        ((record-instance? obj)           (record-instance-type obj))
     111        ((eq? (void) obj)                 'unspecified)
    100112        (else
    101113          (or (other-type-of obj)
    102               'scheme-object) ) ) )
     114              'object) ) ) )
    103115
    104116;;;
     
    119131(define (other-coerce obj result-type default-proc)
    120132  (if* (typdef/type (type-of obj)) ((typdef-proc it) obj result-type default-proc)
    121        (default-proc)) )
     133       (default-proc obj result-type)) )
    122134
    123135(define ((composite-pred pred old-pred) obj)
Note: See TracChangeset for help on using the changeset viewer.