Changeset 14139 in project


Ignore:
Timestamp:
04/07/09 02:25:06 (11 years ago)
Author:
Kon Lovett
Message:

Added syntax. Release.

Location:
release/4/check-errors
Files:
8 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/check-errors/tags/1.0.0/conditions.scm

    r14086 r14139  
    1313
    1414(module conditions (;export
    15   make-exn-condition make-exn-condition+
    16   condition-predicate* make-condition-predicate)
     15  make-exn-condition
     16  make-exn-condition+
     17  condition-predicate*
     18  (make-condition-predicate condition-predicate*))
    1719
    1820(import scheme chicken srfi-1 #;srfi-12)
    19 (require-library srfi-1)
     21(require-library srfi-1 #;srfi-12)
    2022
    2123;;
  • release/4/check-errors/tags/1.0.0/inline-type-checks.scm

    r14084 r14139  
    1010(cond-expand
    1111  (unsafe
     12 
     13    (define-syntax define-inline-check-type
     14      (lambda (form r c)
     15        (let (($define-inline (r 'define-inline)))
     16          (let* ((typ (cadr form))
     17                 (nam (string->symbol (string-append "check-" (symbol->string typ)))) )
     18            `(,$define-inline (,nam . _) (begin) ) ) ) ) )
    1219
    13     (define-inline (%check-fixnum . _) (begin))
    1420    (define-inline (%check-positive-fixnum . _) (begin))
    1521    (define-inline (%check-cardinal-fixnum . _) (begin))
    16     (define-inline (%check-flonum . _) (begin))
    17     (define-inline (%check-integer . _) (begin))
    1822    (define-inline (%check-positive-integer . _) (begin))
    1923    (define-inline (%check-cardinal-integer . _) (begin))
    20     (define-inline (%check-number . _) (begin))
    2124    (define-inline (%check-positive-number . _) (begin))
    2225    (define-inline (%check-cardinal-number . _) (begin))
    23     (define-inline (%check-procedure . _) (begin))
    24     (define-inline (%check-input-port . _) (begin))
    25     (define-inline (%check-output-port . _) (begin))
    26     (define-inline (%check-list . _) (begin))
    27     (define-inline (%check-pair . _) (begin))
    28     (define-inline (%check-blob . _) (begin))
    29     (define-inline (%check-vector . _) (begin))
    30     (define-inline (%check-structure . _) (begin))
    31     (define-inline (%check-symbol . _) (begin))
    32     (define-inline (%check-keyword . _) (begin))
    33     (define-inline (%check-string . _) (begin))
    34     (define-inline (%check-char . _) (begin))
    35     (define-inline (%check-boolean . _) (begin)) )
     26    (define-inline (%check-structure . _) (begin)) )
    3627
    3728  (else
     
    3930    ;;
    4031
    41     (define-inline (%check-fixnum loc obj #!optional argnam)
    42       (unless (%fixnum? obj)
    43         (error-type-fixnum loc obj argnam) ) )
     32    (define-syntax define-inline-check-type
     33      (lambda (form r c)
     34        (let (($define-inline (r 'define-inline))
     35              ($#!optional (r '#!optional)) )
     36          (let* ((typ (cadr form))
     37                 (typstr (symbol->string typ))
     38                 (pred (if (not (null? (cddr form))) (caddr form) (string->symbol (string-append "%" typstr "?"))))
     39                 (nam (string->symbol (string-append "%check-" typstr)))
     40                 (errnam (string->symbol (string-append "error-" typstr))) )
     41            `(,$define-inline (,nam loc obj ,$#!optional argnam)
     42               (unless (,pred obj)
     43                 (,errnam loc obj argnam) ) ) ) ) ) )
     44
     45    ;;
    4446
    4547    (define-inline (%check-positive-fixnum loc obj #!optional argnam)
    4648      (unless (and (%fixnum? obj) (%fxpositive? obj))
    47         (error-type-positive-fixnum loc obj argnam) ) )
     49        (error-positive-fixnum loc obj argnam) ) )
    4850
    4951    (define-inline (%check-cardinal-fixnum loc obj #!optional argnam)
    5052      (unless (and (%fixnum? obj) (%fxcardinal? obj))
    51         (error-type-cardinal-fixnum loc obj argnam) ) )
     53        (error-cardinal-fixnum loc obj argnam) ) )
    5254
    5355    ;;
    5456
    55     (define-inline (%check-flonum loc obj #!optional argnam)
    56       (unless (%flonum? obj)
    57         (error-type-flonum loc obj argnam) ) )
     57    (define-inline (%check-positive-integer loc obj #!optional argnam)
     58      (unless (and (%integer? obj) (%positive? obj))
     59        (error-positive-integer loc obj argnam) ) )
     60
     61    (define-inline (%check-cardinal-integer loc obj #!optional argnam)
     62      (unless (and (%integer? obj) (%cardinal? obj))
     63        (error-cardinal-integer loc obj argnam) ) )
    5864
    5965    ;;
    6066
    61     (define-inline (%check-integer loc obj #!optional argnam)
    62       (unless (%integer? obj)
    63         (error-type-integer loc obj argnam) ) )
    64 
    65     (define-inline (%check-positive-integer loc obj #!optional argnam)
    66       (unless (and (%integer? obj) (%positive? obj))
    67         (error-type-positive-integer loc obj argnam) ) )
    68 
    69     (define-inline (%check-cardinal-integer loc obj #!optional argnam)
    70       (unless (and (%integer? obj) (%cardinal? obj))
    71         (error-type-cardinal-integer loc obj argnam) ) )
    72 
    73     ;;
    74 
    75     (define-inline (%check-number loc obj #!optional argnam)
    76       (unless (%number? obj)
    77         (error-type-number loc obj argnam) ) )
    78 
    7967    (define-inline (%check-positive-number loc obj #!optional argnam)
    8068      (unless (%positive? obj)
    81         (error-type-positive-number loc obj argnam) ) )
     69        (error-positive-number loc obj argnam) ) )
    8270
    8371    (define-inline (%check-cardinal-number loc obj #!optional argnam)
    8472      (unless (%cardinal? obj)
    85         (error-type-cardinal-number loc obj argnam) ) )
    86 
    87     ;;
    88 
    89     (define-inline (%check-procedure loc obj #!optional argnam)
    90       (unless (%procedure? obj)
    91         (error-type-procedure loc obj argnam) ) )
    92 
    93     ;;
    94 
    95     (define-inline (%check-input-port loc obj #!optional argnam)
    96       (unless (%input-port? obj)
    97         (error-type-input-port loc obj argnam) ) )
    98 
    99     (define-inline (%check-output-port loc obj #!optional argnam)
    100       (unless (%output-port? obj)
    101         (error-type-output-port loc obj argnam) ) )
    102 
    103     ;;
    104 
    105     (define-inline (%check-list loc obj #!optional argnam)
    106       (unless (%list? obj)
    107         (error-type-list loc obj argnam) ) )
    108 
    109     (define-inline (%check-pair loc obj #!optional argnam)
    110       (unless (%pair? obj)
    111         (error-type-pair loc  obj argnam) ) )
    112 
    113     ;;
    114 
    115     (define-inline (%check-blob loc obj #!optional argnam)
    116       (unless (%blob? obj)
    117         (error-type-blob loc obj argnam) ) )
    118 
    119     ;;
    120 
    121     (define-inline (%check-vector loc obj #!optional argnam)
    122       (unless (%vector? obj)
    123         (error-type-vector loc obj argnam) ) )
     73        (error-cardinal-number loc obj argnam) ) )
    12474
    12575    ;;
     
    12777    (define-inline (%check-structure loc obj tag #!optional argnam)
    12878      (unless (%structure-instance? obj tag)
    129         (error-type-structure loc obj tag argnam) ) )
     79        (error-structure loc obj tag argnam) ) ) ) )
    13080
    131     ;;
     81;;
    13282
    133     (define-inline (%check-symbol loc obj #!optional argnam)
    134       (unless (%symbol? obj)
    135         (error-type-symbol loc obj argnam) ) )
    136 
    137     ;;
    138 
    139     (define-inline (%check-keyword loc obj #!optional argnam)
    140       (unless (%keyword? obj)
    141         (error-type-keyword loc obj argnam) ) )
    142 
    143     ;;
    144 
    145     (define-inline (%check-string loc obj #!optional argnam)
    146       (unless (%string? obj)
    147         (error-type-string loc obj argnam) ) )
    148 
    149     ;;
    150 
    151     (define-inline (%check-char loc obj #!optional argnam)
    152       (unless (%char? obj)
    153         (error-type-char loc obj argnam) ) )
    154 
    155     ;;
    156 
    157     (define-inline (%check-boolean loc obj #!optional argnam)
    158       (unless (%boolean? obj)
    159         (error-type-boolean loc obj argnam) ) ) ) )
     83(define-inline-check-type fixnum)
     84(define-inline-check-type flonum)
     85(define-inline-check-type integer)
     86(define-inline-check-type number)
     87(define-inline-check-type symbol)
     88(define-inline-check-type keyword)
     89(define-inline-check-type string)
     90(define-inline-check-type char)
     91(define-inline-check-type boolean)
     92(define-inline-check-type procedure)
     93(define-inline-check-type input-port)
     94(define-inline-check-type output-port)
     95(define-inline-check-type list)
     96(define-inline-check-type pair)
     97(define-inline-check-type blob)
     98(define-inline-check-type vector)
  • release/4/check-errors/tags/1.0.0/type-checks.scm

    r14087 r14139  
    3737  check-string
    3838  check-char
    39   check-boolean)
     39  check-boolean
     40  ;;
     41  define-check-type define-check+error-type)
    4042
    4143(import chicken scheme type-errors)
     
    4648(cond-expand
    4749  (unsafe
     50 
     51    (define-syntax define-check-type
     52      (lambda (form r c)
     53        (let (($define (r 'define)))
     54          (let* ((typ (cadr form))
     55                 (nam (string->symbol (string-append "check-" (symbol->string typ)))) )
     56            `(,$define (,nam . _) (begin) ) ) ) ) )
    4857
    49     (define (check-fixnum . _) (begin))
    5058    (define (check-positive-fixnum . _) (begin))
    5159    (define (check-cardinal-fixnum . _) (begin))
    52     (define (check-flonum . _) (begin))
    53     (define (check-integer . _) (begin))
    5460    (define (check-positive-integer . _) (begin))
    5561    (define (check-cardinal-integer . _) (begin))
    56     (define (check-number . _) (begin))
    5762    (define (check-positive-number . _) (begin))
    5863    (define (check-cardinal-number . _) (begin))
    59     (define (check-procedure . _) (begin))
    60     (define (check-input-port . _) (begin))
    61     (define (check-output-port . _) (begin))
    62     (define (check-list . _) (begin))
    63     (define (check-pair . _) (begin))
    64     (define (check-blob . _) (begin))
    65     (define (check-vector . _) (begin))
    66     (define (check-structure . _) (begin))
    67     (define (check-symbol . _) (begin))
    68     (define (check-keyword . _) (begin))
    69     (define (check-string . _) (begin))
    70     (define (check-char . _) (begin))
    71     (define (check-boolean . _) (begin)) )
     64    (define (check-structure . _) (begin)) )
    7265
    7366  (else
    7467
    75     (define (cardinal? obj) (<= 0 obj))
     68    ;;
     69
     70    ; <symbol>          : <pred> is '<symbol>?'
     71    ; <symbol> <symbol> : <pred> is <symbol>
     72    ; ->
     73    ; (define (check-<symbol> loc obj #!optional argnam)
     74    ;   (unless (<pred> obj)
     75    ;     (error-<symbol> loc obj argnam) ) )
     76
     77    (define-syntax define-check-type
     78      (lambda (form r c)
     79        (let (($define (r 'define))
     80              ($#!optional (r '#!optional)) )
     81          (let* ((typ (cadr form))
     82                 (typstr (symbol->string typ))
     83                 (pred (if (not (null? (cddr form))) (caddr form) (string->symbol (string-append typstr "?"))))
     84                 (nam (string->symbol (string-append "check-" typstr)))
     85                 (errnam (string->symbol (string-append "error-" typstr))) )
     86            `(,$define (,nam loc obj ,$#!optional argnam)
     87               (unless (,pred obj)
     88                 (,errnam loc obj argnam) ) ) ) ) ) )
     89    ;;
     90
     91    (define (check-positive-fixnum loc obj #!optional argnam)
     92      (unless (and (fixnum? obj) (fx< 0 obj))
     93        (error-positive-fixnum loc obj argnam) ) )
     94
     95    (define (check-cardinal-fixnum loc obj #!optional argnam)
     96      (unless (and (fixnum? obj) (fx<= 0 obj))
     97        (error-cardinal-fixnum loc obj argnam) ) )
    7698
    7799    ;;
    78100
    79     (define (check-fixnum loc obj #!optional argnam)
    80       (unless (fixnum? obj)
    81         (error-type-fixnum loc obj argnam) ) )
     101    (define (check-positive-integer loc obj #!optional argnam)
     102      (unless (and (integer? obj) (positive? obj))
     103        (error-positive-integer loc obj argnam) ) )
    82104
    83     (define (check-positive-fixnum loc obj #!optional argnam)
    84       (unless (and (fixnum? obj) (positive? obj))
    85         (error-type-positive-fixnum loc obj argnam) ) )
    86 
    87     (define (check-cardinal-fixnum loc obj #!optional argnam)
    88       (unless (and (fixnum? obj) (cardinal? obj))
    89         (error-type-cardinal-fixnum loc obj argnam) ) )
     105    (define (check-cardinal-integer loc obj #!optional argnam)
     106      (unless (and (integer? obj) (<= 0 obj))
     107        (error-cardinal-integer loc obj argnam) ) )
    90108
    91109    ;;
    92110
    93     (define (check-flonum loc obj #!optional argnam)
    94       (unless (flonum? obj)
    95         (error-type-flonum loc obj argnam) ) )
    96 
    97     ;;
    98 
    99     (define (check-integer loc obj #!optional argnam)
    100       (unless (integer? obj)
    101         (error-type-integer loc obj argnam) ) )
    102 
    103     (define (check-positive-integer loc obj #!optional argnam)
    104       (unless (and (integer? obj) (positive? obj))
    105         (error-type-positive-integer loc obj argnam) ) )
    106 
    107     (define (check-cardinal-integer loc obj #!optional argnam)
    108       (unless (and (integer? obj) (cardinal? obj))
    109         (error-type-cardinal-integer loc obj argnam) ) )
    110 
    111     ;;
    112 
    113     (define (check-number loc obj #!optional argnam)
    114       (unless (number? obj)
    115         (error-type-number loc obj argnam) ) )
    116 
    117111    (define (check-positive-number loc obj #!optional argnam)
    118112      (unless (positive? obj)
    119         (error-type-positive-number loc obj argnam) ) )
     113        (error-positive-number loc obj argnam) ) )
    120114
    121115    (define (check-cardinal-number loc obj #!optional argnam)
    122       (unless (cardinal? obj)
    123         (error-type-cardinal-number loc obj argnam) ) )
    124 
    125     ;;
    126 
    127     (define (check-procedure loc obj #!optional argnam)
    128       (unless (procedure? obj)
    129         (error-type-procedure loc obj argnam) ) )
    130 
    131     ;;
    132 
    133     (define (check-input-port loc obj #!optional argnam)
    134       (unless (input-port? obj)
    135         (error-type-input-port loc obj argnam) ) )
    136 
    137     (define (check-output-port loc obj #!optional argnam)
    138       (unless (output-port? obj)
    139         (error-type-output-port loc obj argnam) ) )
    140 
    141     ;;
    142 
    143     (define (check-list loc obj #!optional argnam)
    144       (unless (list? obj)
    145         (error-type-list loc obj argnam) ) )
    146 
    147     (define (check-pair loc obj #!optional argnam)
    148       (unless (pair? obj)
    149         (error-type-pair loc  obj argnam) ) )
    150 
    151     ;;
    152 
    153     (define (check-blob loc obj #!optional argnam)
    154       (unless (blob? obj)
    155         (error-type-blob loc obj argnam) ) )
    156 
    157     ;;
    158 
    159     (define (check-vector loc obj #!optional argnam)
    160       (unless (vector? obj)
    161         (error-type-vector loc obj argnam) ) )
     116      (unless (<= 0 obj)
     117        (error-cardinal-number loc obj argnam) ) )
    162118
    163119    ;;
     
    165121    (define (check-structure loc obj tag #!optional argnam)
    166122      (unless (##sys#structure? obj tag)
    167         (error-type-structure loc obj tag argnam) ) )
     123        (error-structure loc obj tag argnam) ) ) ) )
    168124
    169     ;;
     125;;
    170126
    171     (define (check-symbol loc obj #!optional argnam)
    172       (unless (symbol? obj)
    173         (error-type-symbol loc obj argnam) ) )
     127(define-check-type fixnum)
     128(define-check-type flonum)
     129(define-check-type integer)
     130(define-check-type number)
     131(define-check-type symbol)
     132(define-check-type keyword)
     133(define-check-type string)
     134(define-check-type char)
     135(define-check-type boolean)
     136(define-check-type procedure)
     137(define-check-type input-port)
     138(define-check-type output-port)
     139(define-check-type list)
     140(define-check-type pair)
     141(define-check-type blob)
     142(define-check-type vector)
    174143
    175     ;;
     144;;
    176145
    177     (define (check-keyword loc obj #!optional argnam)
    178       (unless (keyword? obj)
    179         (error-type-keyword loc obj argnam) ) )
     146(define-syntax define-check+error-type
     147  (lambda (form r c)
     148    (let (($define-check-type (r 'define-check-type))
     149          ($define-error-type (r 'define-error-type)) )
     150      (let ((typ (cadr form)))
     151        `(begin
     152           (,$define-check-type ,typ)
     153           (,$define-error-type ,typ) ) ) ) ) )
    180154
    181     ;;
    182 
    183     (define (check-string loc obj #!optional argnam)
    184       (unless (string? obj)
    185         (error-type-string loc obj argnam) ) )
    186 
    187     ;;
    188 
    189     (define (check-char loc obj #!optional argnam)
    190       (unless (char? obj)
    191         (error-type-char loc obj argnam) ) )
    192 
    193     ;;
    194 
    195     (define (check-boolean loc obj #!optional argnam)
    196       (unless (boolean? obj)
    197         (error-type-boolean loc obj argnam) ) ) ) )
    198 
    199 ) ;module type-checks
     155) ;module type-checks
  • release/4/check-errors/tags/1.0.0/type-errors.scm

    r14086 r14139  
    1818  error-argument-type
    1919  ;;
    20   error-type-fixnum
    21   error-type-positive-fixnum
    22   error-type-cardinal-fixnum
    23   error-type-flonum
    24   error-type-integer
    25   error-type-positive-integer
    26   error-type-cardinal-integer
    27   error-type-number
    28   error-type-positive-number
    29   error-type-cardinal-number
    30   error-type-procedure
    31   error-type-input-port
    32   error-type-output-port
    33   error-type-list
    34   error-type-pair
    35   error-type-blob
    36   error-type-vector
    37   error-type-structure
    38   error-type-symbol
    39   error-type-keyword
    40   error-type-string
    41   error-type-char
    42   error-type-boolean)
     20  error-fixnum
     21  error-positive-fixnum
     22  error-cardinal-fixnum
     23  error-flonum
     24  error-integer
     25  error-positive-integer
     26  error-cardinal-integer
     27  error-number
     28  error-positive-number
     29  error-cardinal-number
     30  error-procedure
     31  error-input-port
     32  error-output-port
     33  error-list
     34  error-pair
     35  error-blob
     36  error-vector
     37  error-structure
     38  error-symbol
     39  error-keyword
     40  error-string
     41  error-char
     42  error-boolean
     43  ;;
     44  (define-error-type error-argument-type))
    4345
    44 (import scheme chicken (only data-structures conc))
     46(import scheme chicken (only data-structures ->string conc))
    4547
    4648;;;
     
    5153
    5254(define (error-argument-type loc obj kndnam #!optional argnam)
    53   (##sys#signal-hook #:type-error
    54                      loc
    55                      (conc "bad "
    56                            (if argnam (conc #\` argnam #\') "")
    57                            " argument type - expected "
    58                            (if (vowel? (string-ref kndnam 0)) "an " "a ")
    59                            kndnam)
    60                      obj) )
     55  (let ((kndnam (->string kndnam)))
     56    (##sys#signal-hook #:type-error
     57                       loc
     58                       (conc "bad"
     59                             #\space (if argnam (conc #\` (->string argnam) #\') "")
     60                             #\space "argument type - expected"
     61                             #\space (if (vowel? (string-ref kndnam 0)) "an" "a")
     62                             #\space kndnam)
     63                       obj) ) )
    6164
    6265;;
    6366
    64 (define (error-type-fixnum loc obj #!optional argnam)
    65         (error-argument-type loc obj "fixnum" argnam) )
     67; <symbol>          : <msg> is "<symbol>"
     68; <symbol> <string> : <msg> is <string>
     69; ->
     70; (define (error-<symbol> loc obj #!optional argnam)
     71;   (error-argument-type loc obj <msg> argnam) )
    6672
    67 (define (error-type-positive-fixnum loc obj #!optional argnam)
    68         (error-argument-type loc obj "positive fixnum" argnam) )
     73(define-syntax define-error-type
     74  (lambda (form r c)
     75    (let (($define (r 'define))
     76          ($#!optional (r '#!optional))
     77          ($error-argument-type (r 'error-argument-type)) )
     78      (let* ((typ (cadr form))
     79             (typstr (symbol->string typ))
     80             (msg (if (null? (cddr form)) typstr (caddr form)))
     81             (nam (string->symbol (string-append "error-" typstr))) )
     82        `(,$define (,nam loc obj ,$#!optional argnam)
     83           (,$error-argument-type loc obj ,msg argnam) ) ) ) ) )
    6984
    70 (define (error-type-cardinal-fixnum loc obj #!optional argnam)
    71         (error-argument-type loc obj "cardinal fixnum" argnam) )
     85;;
    7286
    73 (define (error-type-flonum loc obj #!optional argnam)
    74         (error-argument-type loc obj "flonum" argnam) )
     87(define-error-type fixnum)
     88(define-error-type positive-fixnum "positive fixnum")
     89(define-error-type cardinal-fixnum "cardinal fixnum")
     90(define-error-type flonum)
     91(define-error-type integer)
     92(define-error-type positive-integer "positive integer")
     93(define-error-type cardinal-integer "cardinal integer")
     94(define-error-type number)
     95(define-error-type positive-number "positive number")
     96(define-error-type cardinal-number "cardinal number")
     97(define-error-type procedure)
     98(define-error-type input-port "input port")
     99(define-error-type output-port "output port")
     100(define-error-type list)
     101(define-error-type pair)
     102(define-error-type blob)
     103(define-error-type vector)
     104(define-error-type symbol)
     105(define-error-type keyword)
     106(define-error-type string)
     107(define-error-type char)
     108(define-error-type boolean)
    75109
    76 (define (error-type-integer loc obj #!optional argnam)
    77         (error-argument-type loc obj "integer" argnam) )
    78 
    79 (define (error-type-positive-integer loc obj #!optional argnam)
    80         (error-argument-type loc obj "positive integer" argnam) )
    81 
    82 (define (error-type-cardinal-integer loc obj #!optional argnam)
    83         (error-argument-type loc obj "cardinal integer" argnam) )
    84 
    85 (define (error-type-number loc obj #!optional argnam)
    86         (error-argument-type loc obj "number" argnam) )
    87 
    88 (define (error-type-positive-number loc obj #!optional argnam)
    89         (error-argument-type loc obj "positive number" argnam) )
    90 
    91 (define (error-type-cardinal-number loc obj #!optional argnam)
    92         (error-argument-type loc obj "cardinal number" argnam) )
    93 
    94 (define (error-type-procedure loc obj #!optional argnam)
    95         (error-argument-type loc obj "procedure" argnam) )
    96 
    97 (define (error-type-input-port loc obj #!optional argnam)
    98         (error-argument-type loc obj "input port" argnam) )
    99 
    100 (define (error-type-output-port loc obj #!optional argnam)
    101         (error-argument-type loc obj "output port" argnam) )
    102 
    103 (define (error-type-list loc obj #!optional argnam)
    104         (error-argument-type loc obj "list" argnam) )
    105 
    106 (define (error-type-pair loc obj #!optional argnam)
    107         (error-argument-type loc obj "pair" argnam) )
    108 
    109 (define (error-type-blob loc obj #!optional argnam)
    110         (error-argument-type loc obj "blob" argnam) )
    111 
    112 (define (error-type-vector loc obj #!optional argnam)
    113         (error-argument-type loc obj "vector" argnam) )
    114 
    115 (define (error-type-structure loc obj tag #!optional argnam)
     110(define (error-structure loc obj tag #!optional argnam)
    116111        (error-argument-type loc obj (conc "structure" #\space tag) argnam) )
    117112
    118 (define (error-type-symbol loc obj #!optional argnam)
    119         (error-argument-type loc obj "symbol" argnam) )
    120 
    121 (define (error-type-keyword loc obj #!optional argnam)
    122         (error-argument-type loc obj "keyword" argnam) )
    123 
    124 (define (error-type-string loc obj #!optional argnam)
    125         (error-argument-type loc obj "string" argnam) )
    126 
    127 (define (error-type-char loc obj #!optional argnam)
    128         (error-argument-type loc obj "char" argnam) )
    129 
    130 (define (error-type-boolean loc obj #!optional argnam)
    131         (error-argument-type loc obj "boolean" argnam) )
    132 
    133113) ;module type-errors
  • release/4/check-errors/trunk/conditions.scm

    r14086 r14139  
    1313
    1414(module conditions (;export
    15   make-exn-condition make-exn-condition+
    16   condition-predicate* make-condition-predicate)
     15  make-exn-condition
     16  make-exn-condition+
     17  condition-predicate*
     18  (make-condition-predicate condition-predicate*))
    1719
    1820(import scheme chicken srfi-1 #;srfi-12)
    19 (require-library srfi-1)
     21(require-library srfi-1 #;srfi-12)
    2022
    2123;;
  • release/4/check-errors/trunk/inline-type-checks.scm

    r14084 r14139  
    1010(cond-expand
    1111  (unsafe
     12 
     13    (define-syntax define-inline-check-type
     14      (lambda (form r c)
     15        (let (($define-inline (r 'define-inline)))
     16          (let* ((typ (cadr form))
     17                 (nam (string->symbol (string-append "check-" (symbol->string typ)))) )
     18            `(,$define-inline (,nam . _) (begin) ) ) ) ) )
    1219
    13     (define-inline (%check-fixnum . _) (begin))
    1420    (define-inline (%check-positive-fixnum . _) (begin))
    1521    (define-inline (%check-cardinal-fixnum . _) (begin))
    16     (define-inline (%check-flonum . _) (begin))
    17     (define-inline (%check-integer . _) (begin))
    1822    (define-inline (%check-positive-integer . _) (begin))
    1923    (define-inline (%check-cardinal-integer . _) (begin))
    20     (define-inline (%check-number . _) (begin))
    2124    (define-inline (%check-positive-number . _) (begin))
    2225    (define-inline (%check-cardinal-number . _) (begin))
    23     (define-inline (%check-procedure . _) (begin))
    24     (define-inline (%check-input-port . _) (begin))
    25     (define-inline (%check-output-port . _) (begin))
    26     (define-inline (%check-list . _) (begin))
    27     (define-inline (%check-pair . _) (begin))
    28     (define-inline (%check-blob . _) (begin))
    29     (define-inline (%check-vector . _) (begin))
    30     (define-inline (%check-structure . _) (begin))
    31     (define-inline (%check-symbol . _) (begin))
    32     (define-inline (%check-keyword . _) (begin))
    33     (define-inline (%check-string . _) (begin))
    34     (define-inline (%check-char . _) (begin))
    35     (define-inline (%check-boolean . _) (begin)) )
     26    (define-inline (%check-structure . _) (begin)) )
    3627
    3728  (else
     
    3930    ;;
    4031
    41     (define-inline (%check-fixnum loc obj #!optional argnam)
    42       (unless (%fixnum? obj)
    43         (error-type-fixnum loc obj argnam) ) )
     32    (define-syntax define-inline-check-type
     33      (lambda (form r c)
     34        (let (($define-inline (r 'define-inline))
     35              ($#!optional (r '#!optional)) )
     36          (let* ((typ (cadr form))
     37                 (typstr (symbol->string typ))
     38                 (pred (if (not (null? (cddr form))) (caddr form) (string->symbol (string-append "%" typstr "?"))))
     39                 (nam (string->symbol (string-append "%check-" typstr)))
     40                 (errnam (string->symbol (string-append "error-" typstr))) )
     41            `(,$define-inline (,nam loc obj ,$#!optional argnam)
     42               (unless (,pred obj)
     43                 (,errnam loc obj argnam) ) ) ) ) ) )
     44
     45    ;;
    4446
    4547    (define-inline (%check-positive-fixnum loc obj #!optional argnam)
    4648      (unless (and (%fixnum? obj) (%fxpositive? obj))
    47         (error-type-positive-fixnum loc obj argnam) ) )
     49        (error-positive-fixnum loc obj argnam) ) )
    4850
    4951    (define-inline (%check-cardinal-fixnum loc obj #!optional argnam)
    5052      (unless (and (%fixnum? obj) (%fxcardinal? obj))
    51         (error-type-cardinal-fixnum loc obj argnam) ) )
     53        (error-cardinal-fixnum loc obj argnam) ) )
    5254
    5355    ;;
    5456
    55     (define-inline (%check-flonum loc obj #!optional argnam)
    56       (unless (%flonum? obj)
    57         (error-type-flonum loc obj argnam) ) )
     57    (define-inline (%check-positive-integer loc obj #!optional argnam)
     58      (unless (and (%integer? obj) (%positive? obj))
     59        (error-positive-integer loc obj argnam) ) )
     60
     61    (define-inline (%check-cardinal-integer loc obj #!optional argnam)
     62      (unless (and (%integer? obj) (%cardinal? obj))
     63        (error-cardinal-integer loc obj argnam) ) )
    5864
    5965    ;;
    6066
    61     (define-inline (%check-integer loc obj #!optional argnam)
    62       (unless (%integer? obj)
    63         (error-type-integer loc obj argnam) ) )
    64 
    65     (define-inline (%check-positive-integer loc obj #!optional argnam)
    66       (unless (and (%integer? obj) (%positive? obj))
    67         (error-type-positive-integer loc obj argnam) ) )
    68 
    69     (define-inline (%check-cardinal-integer loc obj #!optional argnam)
    70       (unless (and (%integer? obj) (%cardinal? obj))
    71         (error-type-cardinal-integer loc obj argnam) ) )
    72 
    73     ;;
    74 
    75     (define-inline (%check-number loc obj #!optional argnam)
    76       (unless (%number? obj)
    77         (error-type-number loc obj argnam) ) )
    78 
    7967    (define-inline (%check-positive-number loc obj #!optional argnam)
    8068      (unless (%positive? obj)
    81         (error-type-positive-number loc obj argnam) ) )
     69        (error-positive-number loc obj argnam) ) )
    8270
    8371    (define-inline (%check-cardinal-number loc obj #!optional argnam)
    8472      (unless (%cardinal? obj)
    85         (error-type-cardinal-number loc obj argnam) ) )
    86 
    87     ;;
    88 
    89     (define-inline (%check-procedure loc obj #!optional argnam)
    90       (unless (%procedure? obj)
    91         (error-type-procedure loc obj argnam) ) )
    92 
    93     ;;
    94 
    95     (define-inline (%check-input-port loc obj #!optional argnam)
    96       (unless (%input-port? obj)
    97         (error-type-input-port loc obj argnam) ) )
    98 
    99     (define-inline (%check-output-port loc obj #!optional argnam)
    100       (unless (%output-port? obj)
    101         (error-type-output-port loc obj argnam) ) )
    102 
    103     ;;
    104 
    105     (define-inline (%check-list loc obj #!optional argnam)
    106       (unless (%list? obj)
    107         (error-type-list loc obj argnam) ) )
    108 
    109     (define-inline (%check-pair loc obj #!optional argnam)
    110       (unless (%pair? obj)
    111         (error-type-pair loc  obj argnam) ) )
    112 
    113     ;;
    114 
    115     (define-inline (%check-blob loc obj #!optional argnam)
    116       (unless (%blob? obj)
    117         (error-type-blob loc obj argnam) ) )
    118 
    119     ;;
    120 
    121     (define-inline (%check-vector loc obj #!optional argnam)
    122       (unless (%vector? obj)
    123         (error-type-vector loc obj argnam) ) )
     73        (error-cardinal-number loc obj argnam) ) )
    12474
    12575    ;;
     
    12777    (define-inline (%check-structure loc obj tag #!optional argnam)
    12878      (unless (%structure-instance? obj tag)
    129         (error-type-structure loc obj tag argnam) ) )
     79        (error-structure loc obj tag argnam) ) ) ) )
    13080
    131     ;;
     81;;
    13282
    133     (define-inline (%check-symbol loc obj #!optional argnam)
    134       (unless (%symbol? obj)
    135         (error-type-symbol loc obj argnam) ) )
    136 
    137     ;;
    138 
    139     (define-inline (%check-keyword loc obj #!optional argnam)
    140       (unless (%keyword? obj)
    141         (error-type-keyword loc obj argnam) ) )
    142 
    143     ;;
    144 
    145     (define-inline (%check-string loc obj #!optional argnam)
    146       (unless (%string? obj)
    147         (error-type-string loc obj argnam) ) )
    148 
    149     ;;
    150 
    151     (define-inline (%check-char loc obj #!optional argnam)
    152       (unless (%char? obj)
    153         (error-type-char loc obj argnam) ) )
    154 
    155     ;;
    156 
    157     (define-inline (%check-boolean loc obj #!optional argnam)
    158       (unless (%boolean? obj)
    159         (error-type-boolean loc obj argnam) ) ) ) )
     83(define-inline-check-type fixnum)
     84(define-inline-check-type flonum)
     85(define-inline-check-type integer)
     86(define-inline-check-type number)
     87(define-inline-check-type symbol)
     88(define-inline-check-type keyword)
     89(define-inline-check-type string)
     90(define-inline-check-type char)
     91(define-inline-check-type boolean)
     92(define-inline-check-type procedure)
     93(define-inline-check-type input-port)
     94(define-inline-check-type output-port)
     95(define-inline-check-type list)
     96(define-inline-check-type pair)
     97(define-inline-check-type blob)
     98(define-inline-check-type vector)
  • release/4/check-errors/trunk/type-checks.scm

    r14087 r14139  
    3737  check-string
    3838  check-char
    39   check-boolean)
     39  check-boolean
     40  ;;
     41  define-check-type define-check+error-type)
    4042
    4143(import chicken scheme type-errors)
     
    4648(cond-expand
    4749  (unsafe
     50 
     51    (define-syntax define-check-type
     52      (lambda (form r c)
     53        (let (($define (r 'define)))
     54          (let* ((typ (cadr form))
     55                 (nam (string->symbol (string-append "check-" (symbol->string typ)))) )
     56            `(,$define (,nam . _) (begin) ) ) ) ) )
    4857
    49     (define (check-fixnum . _) (begin))
    5058    (define (check-positive-fixnum . _) (begin))
    5159    (define (check-cardinal-fixnum . _) (begin))
    52     (define (check-flonum . _) (begin))
    53     (define (check-integer . _) (begin))
    5460    (define (check-positive-integer . _) (begin))
    5561    (define (check-cardinal-integer . _) (begin))
    56     (define (check-number . _) (begin))
    5762    (define (check-positive-number . _) (begin))
    5863    (define (check-cardinal-number . _) (begin))
    59     (define (check-procedure . _) (begin))
    60     (define (check-input-port . _) (begin))
    61     (define (check-output-port . _) (begin))
    62     (define (check-list . _) (begin))
    63     (define (check-pair . _) (begin))
    64     (define (check-blob . _) (begin))
    65     (define (check-vector . _) (begin))
    66     (define (check-structure . _) (begin))
    67     (define (check-symbol . _) (begin))
    68     (define (check-keyword . _) (begin))
    69     (define (check-string . _) (begin))
    70     (define (check-char . _) (begin))
    71     (define (check-boolean . _) (begin)) )
     64    (define (check-structure . _) (begin)) )
    7265
    7366  (else
    7467
    75     (define (cardinal? obj) (<= 0 obj))
     68    ;;
     69
     70    ; <symbol>          : <pred> is '<symbol>?'
     71    ; <symbol> <symbol> : <pred> is <symbol>
     72    ; ->
     73    ; (define (check-<symbol> loc obj #!optional argnam)
     74    ;   (unless (<pred> obj)
     75    ;     (error-<symbol> loc obj argnam) ) )
     76
     77    (define-syntax define-check-type
     78      (lambda (form r c)
     79        (let (($define (r 'define))
     80              ($#!optional (r '#!optional)) )
     81          (let* ((typ (cadr form))
     82                 (typstr (symbol->string typ))
     83                 (pred (if (not (null? (cddr form))) (caddr form) (string->symbol (string-append typstr "?"))))
     84                 (nam (string->symbol (string-append "check-" typstr)))
     85                 (errnam (string->symbol (string-append "error-" typstr))) )
     86            `(,$define (,nam loc obj ,$#!optional argnam)
     87               (unless (,pred obj)
     88                 (,errnam loc obj argnam) ) ) ) ) ) )
     89    ;;
     90
     91    (define (check-positive-fixnum loc obj #!optional argnam)
     92      (unless (and (fixnum? obj) (fx< 0 obj))
     93        (error-positive-fixnum loc obj argnam) ) )
     94
     95    (define (check-cardinal-fixnum loc obj #!optional argnam)
     96      (unless (and (fixnum? obj) (fx<= 0 obj))
     97        (error-cardinal-fixnum loc obj argnam) ) )
    7698
    7799    ;;
    78100
    79     (define (check-fixnum loc obj #!optional argnam)
    80       (unless (fixnum? obj)
    81         (error-type-fixnum loc obj argnam) ) )
     101    (define (check-positive-integer loc obj #!optional argnam)
     102      (unless (and (integer? obj) (positive? obj))
     103        (error-positive-integer loc obj argnam) ) )
    82104
    83     (define (check-positive-fixnum loc obj #!optional argnam)
    84       (unless (and (fixnum? obj) (positive? obj))
    85         (error-type-positive-fixnum loc obj argnam) ) )
    86 
    87     (define (check-cardinal-fixnum loc obj #!optional argnam)
    88       (unless (and (fixnum? obj) (cardinal? obj))
    89         (error-type-cardinal-fixnum loc obj argnam) ) )
     105    (define (check-cardinal-integer loc obj #!optional argnam)
     106      (unless (and (integer? obj) (<= 0 obj))
     107        (error-cardinal-integer loc obj argnam) ) )
    90108
    91109    ;;
    92110
    93     (define (check-flonum loc obj #!optional argnam)
    94       (unless (flonum? obj)
    95         (error-type-flonum loc obj argnam) ) )
    96 
    97     ;;
    98 
    99     (define (check-integer loc obj #!optional argnam)
    100       (unless (integer? obj)
    101         (error-type-integer loc obj argnam) ) )
    102 
    103     (define (check-positive-integer loc obj #!optional argnam)
    104       (unless (and (integer? obj) (positive? obj))
    105         (error-type-positive-integer loc obj argnam) ) )
    106 
    107     (define (check-cardinal-integer loc obj #!optional argnam)
    108       (unless (and (integer? obj) (cardinal? obj))
    109         (error-type-cardinal-integer loc obj argnam) ) )
    110 
    111     ;;
    112 
    113     (define (check-number loc obj #!optional argnam)
    114       (unless (number? obj)
    115         (error-type-number loc obj argnam) ) )
    116 
    117111    (define (check-positive-number loc obj #!optional argnam)
    118112      (unless (positive? obj)
    119         (error-type-positive-number loc obj argnam) ) )
     113        (error-positive-number loc obj argnam) ) )
    120114
    121115    (define (check-cardinal-number loc obj #!optional argnam)
    122       (unless (cardinal? obj)
    123         (error-type-cardinal-number loc obj argnam) ) )
    124 
    125     ;;
    126 
    127     (define (check-procedure loc obj #!optional argnam)
    128       (unless (procedure? obj)
    129         (error-type-procedure loc obj argnam) ) )
    130 
    131     ;;
    132 
    133     (define (check-input-port loc obj #!optional argnam)
    134       (unless (input-port? obj)
    135         (error-type-input-port loc obj argnam) ) )
    136 
    137     (define (check-output-port loc obj #!optional argnam)
    138       (unless (output-port? obj)
    139         (error-type-output-port loc obj argnam) ) )
    140 
    141     ;;
    142 
    143     (define (check-list loc obj #!optional argnam)
    144       (unless (list? obj)
    145         (error-type-list loc obj argnam) ) )
    146 
    147     (define (check-pair loc obj #!optional argnam)
    148       (unless (pair? obj)
    149         (error-type-pair loc  obj argnam) ) )
    150 
    151     ;;
    152 
    153     (define (check-blob loc obj #!optional argnam)
    154       (unless (blob? obj)
    155         (error-type-blob loc obj argnam) ) )
    156 
    157     ;;
    158 
    159     (define (check-vector loc obj #!optional argnam)
    160       (unless (vector? obj)
    161         (error-type-vector loc obj argnam) ) )
     116      (unless (<= 0 obj)
     117        (error-cardinal-number loc obj argnam) ) )
    162118
    163119    ;;
     
    165121    (define (check-structure loc obj tag #!optional argnam)
    166122      (unless (##sys#structure? obj tag)
    167         (error-type-structure loc obj tag argnam) ) )
     123        (error-structure loc obj tag argnam) ) ) ) )
    168124
    169     ;;
     125;;
    170126
    171     (define (check-symbol loc obj #!optional argnam)
    172       (unless (symbol? obj)
    173         (error-type-symbol loc obj argnam) ) )
     127(define-check-type fixnum)
     128(define-check-type flonum)
     129(define-check-type integer)
     130(define-check-type number)
     131(define-check-type symbol)
     132(define-check-type keyword)
     133(define-check-type string)
     134(define-check-type char)
     135(define-check-type boolean)
     136(define-check-type procedure)
     137(define-check-type input-port)
     138(define-check-type output-port)
     139(define-check-type list)
     140(define-check-type pair)
     141(define-check-type blob)
     142(define-check-type vector)
    174143
    175     ;;
     144;;
    176145
    177     (define (check-keyword loc obj #!optional argnam)
    178       (unless (keyword? obj)
    179         (error-type-keyword loc obj argnam) ) )
     146(define-syntax define-check+error-type
     147  (lambda (form r c)
     148    (let (($define-check-type (r 'define-check-type))
     149          ($define-error-type (r 'define-error-type)) )
     150      (let ((typ (cadr form)))
     151        `(begin
     152           (,$define-check-type ,typ)
     153           (,$define-error-type ,typ) ) ) ) ) )
    180154
    181     ;;
    182 
    183     (define (check-string loc obj #!optional argnam)
    184       (unless (string? obj)
    185         (error-type-string loc obj argnam) ) )
    186 
    187     ;;
    188 
    189     (define (check-char loc obj #!optional argnam)
    190       (unless (char? obj)
    191         (error-type-char loc obj argnam) ) )
    192 
    193     ;;
    194 
    195     (define (check-boolean loc obj #!optional argnam)
    196       (unless (boolean? obj)
    197         (error-type-boolean loc obj argnam) ) ) ) )
    198 
    199 ) ;module type-checks
     155) ;module type-checks
  • release/4/check-errors/trunk/type-errors.scm

    r14086 r14139  
    1818  error-argument-type
    1919  ;;
    20   error-type-fixnum
    21   error-type-positive-fixnum
    22   error-type-cardinal-fixnum
    23   error-type-flonum
    24   error-type-integer
    25   error-type-positive-integer
    26   error-type-cardinal-integer
    27   error-type-number
    28   error-type-positive-number
    29   error-type-cardinal-number
    30   error-type-procedure
    31   error-type-input-port
    32   error-type-output-port
    33   error-type-list
    34   error-type-pair
    35   error-type-blob
    36   error-type-vector
    37   error-type-structure
    38   error-type-symbol
    39   error-type-keyword
    40   error-type-string
    41   error-type-char
    42   error-type-boolean)
     20  error-fixnum
     21  error-positive-fixnum
     22  error-cardinal-fixnum
     23  error-flonum
     24  error-integer
     25  error-positive-integer
     26  error-cardinal-integer
     27  error-number
     28  error-positive-number
     29  error-cardinal-number
     30  error-procedure
     31  error-input-port
     32  error-output-port
     33  error-list
     34  error-pair
     35  error-blob
     36  error-vector
     37  error-structure
     38  error-symbol
     39  error-keyword
     40  error-string
     41  error-char
     42  error-boolean
     43  ;;
     44  (define-error-type error-argument-type))
    4345
    44 (import scheme chicken (only data-structures conc))
     46(import scheme chicken (only data-structures ->string conc))
    4547
    4648;;;
     
    5153
    5254(define (error-argument-type loc obj kndnam #!optional argnam)
    53   (##sys#signal-hook #:type-error
    54                      loc
    55                      (conc "bad "
    56                            (if argnam (conc #\` argnam #\') "")
    57                            " argument type - expected "
    58                            (if (vowel? (string-ref kndnam 0)) "an " "a ")
    59                            kndnam)
    60                      obj) )
     55  (let ((kndnam (->string kndnam)))
     56    (##sys#signal-hook #:type-error
     57                       loc
     58                       (conc "bad"
     59                             #\space (if argnam (conc #\` (->string argnam) #\') "")
     60                             #\space "argument type - expected"
     61                             #\space (if (vowel? (string-ref kndnam 0)) "an" "a")
     62                             #\space kndnam)
     63                       obj) ) )
    6164
    6265;;
    6366
    64 (define (error-type-fixnum loc obj #!optional argnam)
    65         (error-argument-type loc obj "fixnum" argnam) )
     67; <symbol>          : <msg> is "<symbol>"
     68; <symbol> <string> : <msg> is <string>
     69; ->
     70; (define (error-<symbol> loc obj #!optional argnam)
     71;   (error-argument-type loc obj <msg> argnam) )
    6672
    67 (define (error-type-positive-fixnum loc obj #!optional argnam)
    68         (error-argument-type loc obj "positive fixnum" argnam) )
     73(define-syntax define-error-type
     74  (lambda (form r c)
     75    (let (($define (r 'define))
     76          ($#!optional (r '#!optional))
     77          ($error-argument-type (r 'error-argument-type)) )
     78      (let* ((typ (cadr form))
     79             (typstr (symbol->string typ))
     80             (msg (if (null? (cddr form)) typstr (caddr form)))
     81             (nam (string->symbol (string-append "error-" typstr))) )
     82        `(,$define (,nam loc obj ,$#!optional argnam)
     83           (,$error-argument-type loc obj ,msg argnam) ) ) ) ) )
    6984
    70 (define (error-type-cardinal-fixnum loc obj #!optional argnam)
    71         (error-argument-type loc obj "cardinal fixnum" argnam) )
     85;;
    7286
    73 (define (error-type-flonum loc obj #!optional argnam)
    74         (error-argument-type loc obj "flonum" argnam) )
     87(define-error-type fixnum)
     88(define-error-type positive-fixnum "positive fixnum")
     89(define-error-type cardinal-fixnum "cardinal fixnum")
     90(define-error-type flonum)
     91(define-error-type integer)
     92(define-error-type positive-integer "positive integer")
     93(define-error-type cardinal-integer "cardinal integer")
     94(define-error-type number)
     95(define-error-type positive-number "positive number")
     96(define-error-type cardinal-number "cardinal number")
     97(define-error-type procedure)
     98(define-error-type input-port "input port")
     99(define-error-type output-port "output port")
     100(define-error-type list)
     101(define-error-type pair)
     102(define-error-type blob)
     103(define-error-type vector)
     104(define-error-type symbol)
     105(define-error-type keyword)
     106(define-error-type string)
     107(define-error-type char)
     108(define-error-type boolean)
    75109
    76 (define (error-type-integer loc obj #!optional argnam)
    77         (error-argument-type loc obj "integer" argnam) )
    78 
    79 (define (error-type-positive-integer loc obj #!optional argnam)
    80         (error-argument-type loc obj "positive integer" argnam) )
    81 
    82 (define (error-type-cardinal-integer loc obj #!optional argnam)
    83         (error-argument-type loc obj "cardinal integer" argnam) )
    84 
    85 (define (error-type-number loc obj #!optional argnam)
    86         (error-argument-type loc obj "number" argnam) )
    87 
    88 (define (error-type-positive-number loc obj #!optional argnam)
    89         (error-argument-type loc obj "positive number" argnam) )
    90 
    91 (define (error-type-cardinal-number loc obj #!optional argnam)
    92         (error-argument-type loc obj "cardinal number" argnam) )
    93 
    94 (define (error-type-procedure loc obj #!optional argnam)
    95         (error-argument-type loc obj "procedure" argnam) )
    96 
    97 (define (error-type-input-port loc obj #!optional argnam)
    98         (error-argument-type loc obj "input port" argnam) )
    99 
    100 (define (error-type-output-port loc obj #!optional argnam)
    101         (error-argument-type loc obj "output port" argnam) )
    102 
    103 (define (error-type-list loc obj #!optional argnam)
    104         (error-argument-type loc obj "list" argnam) )
    105 
    106 (define (error-type-pair loc obj #!optional argnam)
    107         (error-argument-type loc obj "pair" argnam) )
    108 
    109 (define (error-type-blob loc obj #!optional argnam)
    110         (error-argument-type loc obj "blob" argnam) )
    111 
    112 (define (error-type-vector loc obj #!optional argnam)
    113         (error-argument-type loc obj "vector" argnam) )
    114 
    115 (define (error-type-structure loc obj tag #!optional argnam)
     110(define (error-structure loc obj tag #!optional argnam)
    116111        (error-argument-type loc obj (conc "structure" #\space tag) argnam) )
    117112
    118 (define (error-type-symbol loc obj #!optional argnam)
    119         (error-argument-type loc obj "symbol" argnam) )
    120 
    121 (define (error-type-keyword loc obj #!optional argnam)
    122         (error-argument-type loc obj "keyword" argnam) )
    123 
    124 (define (error-type-string loc obj #!optional argnam)
    125         (error-argument-type loc obj "string" argnam) )
    126 
    127 (define (error-type-char loc obj #!optional argnam)
    128         (error-argument-type loc obj "char" argnam) )
    129 
    130 (define (error-type-boolean loc obj #!optional argnam)
    131         (error-argument-type loc obj "boolean" argnam) )
    132 
    133113) ;module type-errors
Note: See TracChangeset for help on using the changeset viewer.