Changeset 34206 in project


Ignore:
Timestamp:
06/26/17 04:07:15 (5 weeks ago)
Author:
kon
Message:

chg ] [ -> ( )

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

Legend:

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

    r27970 r34206  
    44(module check-errors ()
    55
    6   (import scheme chicken foreign)
    7   (reexport type-checks type-errors srfi-4-checks srfi-4-errors)
    8   (require-library type-checks type-errors srfi-4-checks srfi-4-errors)
     6(import scheme chicken foreign)
     7(reexport type-checks type-errors srfi-4-checks srfi-4-errors)
     8(require-library type-checks type-errors srfi-4-checks srfi-4-errors)
    99
    1010) ;module check-errors
  • release/4/check-errors/tags/2.0.1/check-errors.setup

    r33623 r34206  
    77; Do not use -local with error modules so error & warning can be rebound.
    88
    9 (setup-shared+static-extension-module 'type-errors (extension-version "2.0.0")
     9(setup-shared+static-extension-module 'type-errors (extension-version "2.0.1")
    1010  #:inline? #t
    1111  #:types? #t
    1212  #:compile-options '(-fixnum-arithmetic -no-procedure-checks -no-bound-checks))
    1313
    14 (setup-shared+static-extension-module 'srfi-4-errors (extension-version "2.0.0")
     14(setup-shared+static-extension-module 'srfi-4-errors (extension-version "2.0.1")
    1515  #:inline? #t
    1616  #:types? #t
    1717  #:compile-options '(-fixnum-arithmetic -no-procedure-checks -no-bound-checks))
    1818
    19 (setup-shared+static-extension-module 'type-checks (extension-version "2.0.0")
     19(setup-shared+static-extension-module 'type-checks (extension-version "2.0.1")
    2020  #:inline? #t
    2121  #:types? #t
    22   #:compile-options '(-optimize-level 3 -no-procedure-checks -no-bound-checks)
     22  #:compile-options '(-optimize-level 3 -debug-level 1 -no-procedure-checks -no-bound-checks)
    2323  #:files '("inline-type-checks.scm"))
    2424
    25 (setup-shared+static-extension-module 'srfi-4-checks (extension-version "2.0.0")
     25(setup-shared+static-extension-module 'srfi-4-checks (extension-version "2.0.1")
    2626  #:inline? #t
    2727  #:types? #t
    28   #:compile-options '(-optimize-level 3 -no-procedure-checks -no-bound-checks))
     28  #:compile-options '(-optimize-level 3 -debug-level 1 -no-procedure-checks -no-bound-checks))
    2929
    30 (install-extension 'check-errors '() `((version ,(extension-version "2.0.0"))))
     30(install-extension 'check-errors '() `((version ,(extension-version "2.0.1"))))
    3131
    32 (setup-shared+static-extension-module 'check-errors (extension-version "2.0.0")
     32(setup-shared+static-extension-module 'check-errors (extension-version "2.0.1")
    3333  #:inline? #t
    3434  #:types? #t
    35   #:compile-options '(-optimize-level 3 -no-procedure-checks -no-bound-checks))
     35  #:compile-options '(-optimize-level 3 -debug-level 1 -no-procedure-checks -no-bound-checks))
  • release/4/check-errors/tags/2.0.1/inline-type-checks.scm

    r22509 r34206  
    11;;;; inline-type-checks.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, Apr '09
    34
     
    89;; - This source is to be included only!
    910
    10 ; maybe a problem with expansion environment namespace pollution
     11;(maybe a problem with expansion environment namespace pollution)
    1112(define-for-syntax (symbolize . elts)
    1213  (string->symbol (apply conc (map strip-syntax elts))) )
    1314
    14 ;just in case older inlines
    15 (define-inline (%natural? n) (%<= 0 n))
    16 (define-inline (%fxnatural? fx) (%fx<= 0 fx))
     15;; Just in case older inlines
     16
     17(define-inline (%natural? n)
     18  (%<= 0 n) )
     19
     20(define-inline (%fxnatural? fx)
     21  (%fx<= 0 fx) )
    1722
    1823(cond-expand
    1924
    2025  (unsafe
    21  
     26
    2227    (define-syntax define-inline-check-type
    2328      (er-macro-transformer
     
    2934              `(,_define-inline (,nam loc obj . _) obj) ) ) ) ) )
    3035
    31     (define-inline (%check-positive-fixnum . _) (begin))
    32     (define-inline (%check-natural-fixnum . _) (begin))
    33     (define-inline (%check-positive-integer . _) (begin))
    34     (define-inline (%check-natural-integer . _) (begin))
    35     (define-inline (%check-positive-number . _) (begin))
    36     (define-inline (%check-natural-number . _) (begin))
    37     (define-inline (%check-structure . _) (begin))
    38     (define-inline (%check-minimum-argument-count . _) (begin))
    39     (define-inline (%check-argument-count . _) (begin)) )
     36    (define-inline (%check-positive-fixnum loc obj . _) obj)
     37    (define-inline (%check-natural-fixnum loc obj . _) obj)
     38    (define-inline (%check-positive-integer loc obj . _) obj)
     39    (define-inline (%check-natural-integer loc obj . _) obj)
     40    (define-inline (%check-positive-number loc obj . _) obj)
     41    (define-inline (%check-natural-number loc obj . _) obj)
     42    (define-inline (%check-structure loc obj . _) obj)
     43    (define-inline (%check-minimum-argument-count loc obj . _) obj)
     44    (define-inline (%check-argument-count loc obj . _) obj) )
    4045
    4146  (else
    4247
     48    //proper alist strict
    4349    (define-inline (%alist? obj)
    44       (or (%null? obj)
    45           (and (%pair? obj) (%list-every/1 (lambda (x) (%pair? x)) obj))) )
     50      (or
     51        (%null? obj)
     52        (and
     53          (%pair? obj)
     54          (%list-every/1 (lambda (x) (%pair? x)) obj))) )
    4655
    4756    ;;
     
    5564            (let* ((typ (cadr frm))
    5665                   (typstr (symbol->string typ))
    57                    (pred (if (not (null? (cddr frm))) (caddr frm)
     66                   (pred (if (not (null? (cddr frm)))
     67                           (caddr frm)
    5868                           (string->symbol (string-append "%" typstr "?"))))
    5969                   (nam (string->symbol (string-append "%check-" typstr)))
     
    6171              `(,_define-inline (,nam loc obj . args)
    6272                 (,_unless (,pred obj)
    63                    (,errnam loc obj (,_optional args)))
     73                   (,errnam loc obj (,_optional args)) )
    6474                 obj ) ) ) ) ) )
    6575
     
    6878    (define-inline (%check-positive-fixnum loc obj . args)
    6979      (unless (and (%fixnum? obj) (%fxpositive? obj))
    70         (error-positive-fixnum loc obj (optional args)))
     80        (error-positive-fixnum loc obj (optional args)) )
    7181      obj )
    7282
    7383    (define-inline (%check-natural-fixnum loc obj . args)
    7484      (unless (and (%fixnum? obj) (%fxnatural? obj))
    75         (error-natural-fixnum loc obj (optional args)))
     85        (error-natural-fixnum loc obj (optional args)) )
    7686      obj )
    7787
     
    8090    (define-inline (%check-positive-integer loc obj . args)
    8191      (unless (and (%integer? obj) (%positive? obj))
    82         (error-positive-integer loc obj (optional args)))
     92        (error-positive-integer loc obj (optional args)) )
    8393      obj )
    8494
    8595    (define-inline (%check-natural-integer loc obj . args)
    8696      (unless (and (%integer? obj) (%natural? obj))
    87         (error-natural-integer loc obj (optional args)))
     97        (error-natural-integer loc obj (optional args)) )
    8898      obj )
    8999
     
    92102    (define-inline (%check-positive-number loc obj . args)
    93103      (unless (and (%number? obj) (%positive? obj))
    94         (error-positive-number loc obj (optional args)))
     104        (error-positive-number loc obj (optional args)) )
    95105      obj )
    96106
    97107    (define-inline (%check-natural-number loc obj . args)
    98108      (unless (and (%number? obj) (%natural? obj))
    99         (error-natural-number loc obj (optional args)))
     109        (error-natural-number loc obj (optional args)) )
    100110      obj )
    101111
     
    104114    (define-inline (%check-structure loc obj tag . args)
    105115      (unless (%structure-instance? obj tag)
    106         (error-structure loc obj tag (optional args)))
     116        (error-structure loc obj tag (optional args)) )
    107117      obj )
    108118
     
    116126    (define-inline (%check-argument-count loc argc maxargc)
    117127      (unless (%fx<= argc maxargc)
    118         (error-argument-count loc argc maxargc))
     128        (error-argument-count loc argc maxargc) )
    119129      argc ) ) )
    120130
     
    141151
    142152(define-inline (%check-cardinal-fixnum loc obj . args)
    143   (%check-natural-fixnum loc obj (optional args)))
     153  (%check-natural-fixnum loc obj (optional args)) )
     154
    144155(define-inline (%check-cardinal-integer loc obj . args)
    145   (%check-natural-integer loc obj (optional args)))
     156  (%check-natural-integer loc obj (optional args)) )
     157
    146158(define-inline (%check-cardinal-number loc obj . args)
    147   (%check-natural-number loc obj (optional args)))
     159  (%check-natural-number loc obj (optional args)) )
  • release/4/check-errors/tags/2.0.1/srfi-4-checks.scm

    r19227 r34206  
    44(module srfi-4-checks
    55
    6   (;export
    7     check-s8vector
    8     check-u8vector
    9     check-s16vector
    10     check-u16vector
    11     check-s32vector
    12     check-u32vector
    13     check-s64vector
    14     check-u64vector
    15     check-f32vector
    16     check-f64vector)
    17  
    18   (import
    19     scheme
    20     chicken
    21     srfi-4
    22     (only data-structures any?)
    23     (only type-checks define-check-type)
    24     srfi-4-errors)
    25  
    26   (require-library srfi-4 type-checks srfi-4-errors)
    27  
     6(;export
     7  check-s8vector
     8  check-u8vector
     9  check-s16vector
     10  check-u16vector
     11  check-s32vector
     12  check-u32vector
     13  check-s64vector
     14  check-u64vector
     15  check-f32vector
     16  check-f64vector)
     17
     18(import scheme)
     19
     20(import chicken)
     21
     22(require-extension srfi-4)
     23
     24(import (only data-structures any?))
     25(require-library data-structures)
     26
     27(import (only type-checks define-check-type))
     28(require-library type-checks)
     29
     30(require-extension srfi-4-errors)
     31
    2832(define-check-type s8vector)
    2933(define-check-type u8vector)
  • release/4/check-errors/tags/2.0.1/srfi-4-errors.scm

    r19227 r34206  
    44(module srfi-4-errors
    55
    6   (;export
    7     error-s8vector
    8     error-u8vector
    9     error-s16vector
    10     error-u16vector
    11     error-s32vector
    12     error-u32vector
    13     error-s64vector
    14     error-u64vector
    15     error-f32vector
    16     error-f64vector)
    17  
    18   (import
    19     scheme
    20     chicken
    21     srfi-4
    22     (only type-errors define-error-type))
    23  
    24   (require-library srfi-4 type-errors)
    25  
     6(;export
     7  error-s8vector
     8  error-u8vector
     9  error-s16vector
     10  error-u16vector
     11  error-s32vector
     12  error-u32vector
     13  error-s64vector
     14  error-u64vector
     15  error-f32vector
     16  error-f64vector)
     17
     18(import scheme)
     19
     20(import chicken)
     21
     22(require-extension srfi-4)
     23
     24(import (only type-errors define-error-type))
     25(require-library type-errors)
     26
    2627(define-error-type s8vector)
    2728(define-error-type u8vector)
  • release/4/check-errors/tags/2.0.1/type-checks.scm

    r22412 r34206  
    11;;;; type-checks.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, Apr '09
    34
     
    67(module type-checks
    78
    8   (;export
    9     define-check-type
    10     define-check+error-type
    11     check-defined-value
    12     check-bound-value
    13     check-number
    14     check-fixnum
    15     check-flonum
    16     check-integer
    17     check-real
    18     check-complex
    19     check-rational
    20     check-exact
    21     check-inexact
    22     check-positive-fixnum
    23     check-natural-fixnum
    24     check-positive-integer
    25     check-natural-integer
    26     check-positive-number
    27     check-natural-number
    28     check-procedure check-closure
    29     check-input-port
    30     check-output-port
    31     check-list
    32     check-pair
    33     check-blob
    34     check-vector
    35     check-structure
    36     check-record
    37     check-record-type
    38     check-symbol
    39     check-keyword
    40     check-string
    41     check-char
    42     check-boolean
    43     check-alist
    44     check-minimum-argument-count check-argument-count
    45     check-closed-interval check-open-interval
    46     check-half-closed-interval check-half-open-interval
    47     ;
    48     check-cardinal-fixnum
    49     check-cardinal-integer
    50     check-cardinal-number)
    51 
    52   (import chicken scheme type-errors)
    53 
    54   (require-library type-errors)
    55 
    56   (declare (bound-to-procedure ##sys#structure?))
     9(;export
     10define-check-type
     11define-check+error-type
     12check-defined-value
     13check-bound-value
     14check-number
     15check-fixnum
     16check-flonum
     17check-integer
     18check-real
     19check-complex
     20check-rational
     21check-exact
     22check-inexact
     23check-positive-fixnum
     24check-natural-fixnum
     25check-positive-integer
     26check-natural-integer
     27check-positive-number
     28check-natural-number
     29check-procedure check-closure
     30check-input-port
     31check-output-port
     32check-list
     33check-pair
     34check-blob
     35check-vector
     36check-structure
     37check-record
     38check-record-type
     39check-symbol
     40check-keyword
     41check-string
     42check-char
     43check-boolean
     44check-alist
     45check-minimum-argument-count check-argument-count
     46check-closed-interval check-open-interval
     47check-half-closed-interval check-half-open-interval
     48;
     49check-cardinal-fixnum
     50check-cardinal-integer
     51check-cardinal-number)
     52
     53(import chicken scheme type-errors)
     54
     55(require-library type-errors)
     56
     57(declare (bound-to-procedure ##sys#structure?))
    5758
    5859;;
     
    7778
    7879    ;; Backwards
    79     (define (check-cardinal-fixnum . _) (begin))
    80     (define (check-cardinal-integer . _) (begin))
    81     (define (check-cardinal-number . _) (begin))
    82 
    83     (define (check-positive-fixnum . _) (begin))
    84     (define (check-natural-fixnum . _) (begin))
    85     (define (check-positive-integer . _) (begin))
    86     (define (check-natural-integer . _) (begin))
    87     (define (check-positive-number . _) (begin))
    88     (define (check-natural-number . _) (begin))
    89     (define (check-structure . _) (begin))
    90     (define (check-record . _) (begin))
    91     (define (check-record-type . _) (begin))
    92     (define (check-minimum-argument-count . _) (begin))
    93     (define (check-argument-count . _) (begin))
    94     (define (check-closed-interval . _) (begin))
    95     (define (check-open-interval . _) (begin))
    96     (define (check-half-closed-interval . _) (begin))
    97     (define (check-half-open-interval . _) (begin)) )
     80    (define (check-cardinal-fixnum loc obj . _) obj)
     81    (define (check-cardinal-integer loc obj . _) obj)
     82    (define (check-cardinal-number loc obj . _) obj)
     83
     84    (define (check-positive-fixnum loc obj . _) obj)
     85    (define (check-natural-fixnum loc obj . _) obj)
     86    (define (check-positive-integer loc obj . _) obj)
     87    (define (check-natural-integer loc obj . _) obj)
     88    (define (check-positive-number loc obj . _) obj)
     89    (define (check-natural-number loc obj . _) obj)
     90    (define (check-structure loc obj . _) obj)
     91    (define (check-record loc obj . _) obj)
     92    (define (check-record-type loc obj . _) obj)
     93    (define (check-minimum-argument-count loc obj . _) obj)
     94    (define (check-argument-count loc obj . _) obj)
     95    (define (check-closed-interval loc obj . _) obj)
     96    (define (check-open-interval loc obj . _) obj)
     97    (define (check-half-closed-interval loc obj . _) obj)
     98    (define (check-half-open-interval loc obj . _) obj) )
    9899
    99100  (else
     
    257258(define (check-half-closed-interval loc num min max . args)
    258259  (unless (and (<= min num) (< num max))
    259     (error-half-closed-interval loc num min max (optional args))) 
     260    (error-half-closed-interval loc num min max (optional args)))
    260261  num)
    261262
  • release/4/check-errors/tags/2.0.1/type-errors.scm

    r27970 r34206  
    11;;;; type-errors.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, Apr '09
    34
     
    1415(module type-errors
    1516
    16   (;export
    17     make-bad-argument-message
    18     make-type-name-message
    19     make-error-type-message
    20     signal-type-error
    21     error-argument-type
    22     warning-argument-type
    23     (define-error-type error-argument-type)
    24     error-bound-value
    25     error-defined-value
    26     error-number
    27     error-fixnum
    28     error-flonum
    29     error-integer
    30     error-real
    31     error-complex
    32     error-rational
    33     error-exact
    34     error-inexact
    35     error-positive-number
    36     error-natural-number
    37     error-positive-fixnum
    38     error-natural-fixnum
    39     error-positive-integer
    40     error-natural-integer
    41     error-procedure error-closure
    42     error-input-port
    43     error-output-port
    44     error-list
    45     error-pair
    46     error-blob
    47     error-vector
    48     error-structure
    49     error-record
    50     error-record-type
    51     error-symbol
    52     error-keyword
    53     error-string
    54     error-char
    55     error-boolean
    56     error-plist
    57     error-alist
    58     error-minimum-argument-count
    59     error-argument-count
    60     error-interval
    61     error-closed-interval error-open-interval
    62     error-half-open-interval error-half-closed-interval
    63     ;
    64     error-cardinal-fixnum
    65     error-cardinal-integer
    66     error-cardinal-number)
    67 
    68   (import scheme chicken foreign (only data-structures ->string conc))
    69 
    70   (require-library data-structures)
    71 
    72   (declare
    73     (pure
    74       vowel? get-indefinite-article
    75       make-error-type-message make-type-name-message
    76       make-bad-argument-message)
    77     (bound-to-procedure ##sys#signal-hook ##sys#error-hook) )
     17(;export
     18  make-bad-argument-message
     19  make-type-name-message
     20  make-error-type-message
     21  signal-type-error
     22  error-argument-type
     23  warning-argument-type
     24  (define-error-type error-argument-type)
     25  error-bound-value
     26  error-defined-value
     27  error-number
     28  error-fixnum
     29  error-flonum
     30  error-integer
     31  error-real
     32  error-complex
     33  error-rational
     34  error-exact
     35  error-inexact
     36  error-positive-number
     37  error-natural-number
     38  error-positive-fixnum
     39  error-natural-fixnum
     40  error-positive-integer
     41  error-natural-integer
     42  error-procedure error-closure
     43  error-input-port
     44  error-output-port
     45  error-list
     46  error-pair
     47  error-blob
     48  error-vector
     49  error-structure
     50  error-record
     51  error-record-type
     52  error-symbol
     53  error-keyword
     54  error-string
     55  error-char
     56  error-boolean
     57  error-plist
     58  error-alist
     59  error-minimum-argument-count
     60  error-argument-count
     61  error-interval
     62  error-closed-interval error-open-interval
     63  error-half-open-interval error-half-closed-interval
     64  ;
     65  error-cardinal-fixnum
     66  error-cardinal-integer
     67  error-cardinal-number)
     68
     69(import scheme)
     70
     71(import chicken foreign)
     72
     73(import (only data-structures ->string conc))
     74(require-library data-structures)
     75
     76(declare
     77  (pure
     78    vowel? appropriate-indefinite-article
     79    make-error-type-message make-type-name-message
     80    make-bad-argument-message)
     81  (bound-to-procedure
     82    ##sys#signal-hook ##sys#error-hook) )
    7883
    7984;;;
    8085
    81 ; maybe a problem with expansion environment namespace pollution
     86(define (->boolean obj)
     87  (and
     88    obj
     89    #t ) )
     90
     91;(maybe a problem with expansion environment namespace pollution)
    8292(define-for-syntax (symbolize . elts)
    8393  (string->symbol (apply conc (map strip-syntax elts))) )
    8494
    85 (define (vowel? ch) (and (memq ch '(#\a #\e #\i #\o #\u)) #t))
    86 
    87 (define (get-indefinite-article wrdstr)
    88   (if (vowel? (string-ref wrdstr 0)) 'an
    89     'a) )
    90 
    9195;;
    9296
    9397(define (make-bad-argument-message #!optional argnam)
    94   (if (not argnam) "bad argument"
     98  (if (not argnam)
     99    "bad argument"
    95100    (string-append "bad `" (->string argnam) "' argument") ) )
    96101
    97102(define (make-type-name-message typnam)
    98   (let ((typnam (->string typnam)))
    99     (conc (get-indefinite-article typnam) #\space typnam) ) )
     103  (or
     104    (localized-type-name-message typnam)
     105    (->string typnam)) )
    100106
    101107(define (make-error-type-message typnam #!optional argnam)
     
    118124
    119125(define (warning-argument-type loc obj typnam #!optional argnam)
    120   (warning
    121     (string-append
    122       (if loc (conc #\( (symbol->string loc) #\) #\space) "")
    123       (conc (make-error-type-message typnam argnam) #\: #\space)
    124       (->string obj))) )
     126  (let ((typ-msg (conc (make-error-type-message typnam argnam) #\: #\space) )
     127        (obj-str (->string obj) ) )
     128    (let* ((wrn-msg (string-append typ-msg obj-str) )
     129           (wrn-msg
     130            (if loc
     131              (string-append (location-message loc) wrn-msg)
     132              wrn-msg ) ) )
     133      (warning wrn-msg) ) ) )
     134
     135(define (location-message loc)
     136  (conc #\( (symbol->string loc) #\) #\space) )
    125137
    126138;;
     
    201213    num) )
    202214
     215(define-constant +left-open-interval+ '|(|)     ;'|]|
     216(define-constant +right-open-interval+ '|)|)    ;'|[|
     217
     218(define-constant +left-closed-interval+ '|[|)
     219(define-constant +right-closed-interval+ '|]|)
     220
    203221(define (error-closed-interval loc num min max #!optional argnam)
    204   (error-interval loc num '|[| min max '|]| argnam))
     222  (error-interval loc num +left-closed-interval+ min max +right-closed-interval+ argnam))
    205223
    206224(define (error-open-interval loc num min max #!optional argnam)
    207   (error-interval loc num '|]| min max '|[| argnam))
     225  (error-interval loc num +left-open-interval+ min max +right-open-interval+ argnam))
    208226
    209227(define (error-half-open-interval loc num min max #!optional argnam)
    210   (error-interval loc num '|]| min max '|]| argnam))
     228  (error-interval loc num +left-open-interval+ min max +right-closed-interval+ argnam))
    211229
    212230(define (error-half-closed-interval loc num min max #!optional argnam)
    213   (error-interval loc num '|[| min max '|[| argnam))
     231  (error-interval loc num +left-closed-interval+ min max +right-open-interval+ argnam))
    214232
    215233(define (error-minimum-argument-count loc argc minargc)
    216   (##sys#error-hook (foreign-value "C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR" int) loc
    217                     minargc argc #f) )
     234  (##sys#error-hook
     235    (foreign-value "C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR" int)
     236    loc
     237    minargc argc #f) )
    218238
    219239(define (error-argument-count loc argc maxargc)
    220   (##sys#error-hook (foreign-value "C_BAD_ARGUMENT_COUNT_ERROR" int) loc
    221                     maxargc argc #f) )
     240  (##sys#error-hook
     241    (foreign-value "C_BAD_ARGUMENT_COUNT_ERROR" int)
     242    loc
     243    maxargc argc #f) )
    222244
    223245;; Backwards
     
    227249(define error-cardinal-number error-natural-number)
    228250
     251;;;
     252
     253;;
     254
     255(define (localized-type-name-message typnam)
     256  ;FIXME en only
     257  (let ((typnam (->string typnam)))
     258    (conc (appropriate-indefinite-article typnam) #\space typnam) ) )
     259
     260;;
     261
     262(define +english-vowels+ '(#\a #\e #\i #\o #\u))
     263(define +english-indefinite-articles+ '(an a))
     264
     265(define (vowel? ch)
     266  (->boolean (memq ch +english-vowels+)) )
     267
     268(define (appropriate-indefinite-article wrdstr)
     269  (if (vowel? (string-ref wrdstr 0))
     270    (car +english-indefinite-articles+)
     271    (cadr +english-indefinite-articles+) ) )
     272
    229273) ;module type-errors
  • release/4/check-errors/trunk/check-errors.scm

    r27970 r34206  
    44(module check-errors ()
    55
    6   (import scheme chicken foreign)
    7   (reexport type-checks type-errors srfi-4-checks srfi-4-errors)
    8   (require-library type-checks type-errors srfi-4-checks srfi-4-errors)
     6(import scheme chicken foreign)
     7(reexport type-checks type-errors srfi-4-checks srfi-4-errors)
     8(require-library type-checks type-errors srfi-4-checks srfi-4-errors)
    99
    1010) ;module check-errors
  • release/4/check-errors/trunk/check-errors.setup

    r33623 r34206  
    77; Do not use -local with error modules so error & warning can be rebound.
    88
    9 (setup-shared+static-extension-module 'type-errors (extension-version "2.0.0")
     9(setup-shared+static-extension-module 'type-errors (extension-version "2.0.1")
    1010  #:inline? #t
    1111  #:types? #t
    1212  #:compile-options '(-fixnum-arithmetic -no-procedure-checks -no-bound-checks))
    1313
    14 (setup-shared+static-extension-module 'srfi-4-errors (extension-version "2.0.0")
     14(setup-shared+static-extension-module 'srfi-4-errors (extension-version "2.0.1")
    1515  #:inline? #t
    1616  #:types? #t
    1717  #:compile-options '(-fixnum-arithmetic -no-procedure-checks -no-bound-checks))
    1818
    19 (setup-shared+static-extension-module 'type-checks (extension-version "2.0.0")
     19(setup-shared+static-extension-module 'type-checks (extension-version "2.0.1")
    2020  #:inline? #t
    2121  #:types? #t
    22   #:compile-options '(-optimize-level 3 -no-procedure-checks -no-bound-checks)
     22  #:compile-options '(-optimize-level 3 -debug-level 1 -no-procedure-checks -no-bound-checks)
    2323  #:files '("inline-type-checks.scm"))
    2424
    25 (setup-shared+static-extension-module 'srfi-4-checks (extension-version "2.0.0")
     25(setup-shared+static-extension-module 'srfi-4-checks (extension-version "2.0.1")
    2626  #:inline? #t
    2727  #:types? #t
    28   #:compile-options '(-optimize-level 3 -no-procedure-checks -no-bound-checks))
     28  #:compile-options '(-optimize-level 3 -debug-level 1 -no-procedure-checks -no-bound-checks))
    2929
    30 (install-extension 'check-errors '() `((version ,(extension-version "2.0.0"))))
     30(install-extension 'check-errors '() `((version ,(extension-version "2.0.1"))))
    3131
    32 (setup-shared+static-extension-module 'check-errors (extension-version "2.0.0")
     32(setup-shared+static-extension-module 'check-errors (extension-version "2.0.1")
    3333  #:inline? #t
    3434  #:types? #t
    35   #:compile-options '(-optimize-level 3 -no-procedure-checks -no-bound-checks))
     35  #:compile-options '(-optimize-level 3 -debug-level 1 -no-procedure-checks -no-bound-checks))
  • release/4/check-errors/trunk/inline-type-checks.scm

    r22509 r34206  
    11;;;; inline-type-checks.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, Apr '09
    34
     
    89;; - This source is to be included only!
    910
    10 ; maybe a problem with expansion environment namespace pollution
     11;(maybe a problem with expansion environment namespace pollution)
    1112(define-for-syntax (symbolize . elts)
    1213  (string->symbol (apply conc (map strip-syntax elts))) )
    1314
    14 ;just in case older inlines
    15 (define-inline (%natural? n) (%<= 0 n))
    16 (define-inline (%fxnatural? fx) (%fx<= 0 fx))
     15;; Just in case older inlines
     16
     17(define-inline (%natural? n)
     18  (%<= 0 n) )
     19
     20(define-inline (%fxnatural? fx)
     21  (%fx<= 0 fx) )
    1722
    1823(cond-expand
    1924
    2025  (unsafe
    21  
     26
    2227    (define-syntax define-inline-check-type
    2328      (er-macro-transformer
     
    2934              `(,_define-inline (,nam loc obj . _) obj) ) ) ) ) )
    3035
    31     (define-inline (%check-positive-fixnum . _) (begin))
    32     (define-inline (%check-natural-fixnum . _) (begin))
    33     (define-inline (%check-positive-integer . _) (begin))
    34     (define-inline (%check-natural-integer . _) (begin))
    35     (define-inline (%check-positive-number . _) (begin))
    36     (define-inline (%check-natural-number . _) (begin))
    37     (define-inline (%check-structure . _) (begin))
    38     (define-inline (%check-minimum-argument-count . _) (begin))
    39     (define-inline (%check-argument-count . _) (begin)) )
     36    (define-inline (%check-positive-fixnum loc obj . _) obj)
     37    (define-inline (%check-natural-fixnum loc obj . _) obj)
     38    (define-inline (%check-positive-integer loc obj . _) obj)
     39    (define-inline (%check-natural-integer loc obj . _) obj)
     40    (define-inline (%check-positive-number loc obj . _) obj)
     41    (define-inline (%check-natural-number loc obj . _) obj)
     42    (define-inline (%check-structure loc obj . _) obj)
     43    (define-inline (%check-minimum-argument-count loc obj . _) obj)
     44    (define-inline (%check-argument-count loc obj . _) obj) )
    4045
    4146  (else
    4247
     48    //proper alist strict
    4349    (define-inline (%alist? obj)
    44       (or (%null? obj)
    45           (and (%pair? obj) (%list-every/1 (lambda (x) (%pair? x)) obj))) )
     50      (or
     51        (%null? obj)
     52        (and
     53          (%pair? obj)
     54          (%list-every/1 (lambda (x) (%pair? x)) obj))) )
    4655
    4756    ;;
     
    5564            (let* ((typ (cadr frm))
    5665                   (typstr (symbol->string typ))
    57                    (pred (if (not (null? (cddr frm))) (caddr frm)
     66                   (pred (if (not (null? (cddr frm)))
     67                           (caddr frm)
    5868                           (string->symbol (string-append "%" typstr "?"))))
    5969                   (nam (string->symbol (string-append "%check-" typstr)))
     
    6171              `(,_define-inline (,nam loc obj . args)
    6272                 (,_unless (,pred obj)
    63                    (,errnam loc obj (,_optional args)))
     73                   (,errnam loc obj (,_optional args)) )
    6474                 obj ) ) ) ) ) )
    6575
     
    6878    (define-inline (%check-positive-fixnum loc obj . args)
    6979      (unless (and (%fixnum? obj) (%fxpositive? obj))
    70         (error-positive-fixnum loc obj (optional args)))
     80        (error-positive-fixnum loc obj (optional args)) )
    7181      obj )
    7282
    7383    (define-inline (%check-natural-fixnum loc obj . args)
    7484      (unless (and (%fixnum? obj) (%fxnatural? obj))
    75         (error-natural-fixnum loc obj (optional args)))
     85        (error-natural-fixnum loc obj (optional args)) )
    7686      obj )
    7787
     
    8090    (define-inline (%check-positive-integer loc obj . args)
    8191      (unless (and (%integer? obj) (%positive? obj))
    82         (error-positive-integer loc obj (optional args)))
     92        (error-positive-integer loc obj (optional args)) )
    8393      obj )
    8494
    8595    (define-inline (%check-natural-integer loc obj . args)
    8696      (unless (and (%integer? obj) (%natural? obj))
    87         (error-natural-integer loc obj (optional args)))
     97        (error-natural-integer loc obj (optional args)) )
    8898      obj )
    8999
     
    92102    (define-inline (%check-positive-number loc obj . args)
    93103      (unless (and (%number? obj) (%positive? obj))
    94         (error-positive-number loc obj (optional args)))
     104        (error-positive-number loc obj (optional args)) )
    95105      obj )
    96106
    97107    (define-inline (%check-natural-number loc obj . args)
    98108      (unless (and (%number? obj) (%natural? obj))
    99         (error-natural-number loc obj (optional args)))
     109        (error-natural-number loc obj (optional args)) )
    100110      obj )
    101111
     
    104114    (define-inline (%check-structure loc obj tag . args)
    105115      (unless (%structure-instance? obj tag)
    106         (error-structure loc obj tag (optional args)))
     116        (error-structure loc obj tag (optional args)) )
    107117      obj )
    108118
     
    116126    (define-inline (%check-argument-count loc argc maxargc)
    117127      (unless (%fx<= argc maxargc)
    118         (error-argument-count loc argc maxargc))
     128        (error-argument-count loc argc maxargc) )
    119129      argc ) ) )
    120130
     
    141151
    142152(define-inline (%check-cardinal-fixnum loc obj . args)
    143   (%check-natural-fixnum loc obj (optional args)))
     153  (%check-natural-fixnum loc obj (optional args)) )
     154
    144155(define-inline (%check-cardinal-integer loc obj . args)
    145   (%check-natural-integer loc obj (optional args)))
     156  (%check-natural-integer loc obj (optional args)) )
     157
    146158(define-inline (%check-cardinal-number loc obj . args)
    147   (%check-natural-number loc obj (optional args)))
     159  (%check-natural-number loc obj (optional args)) )
  • release/4/check-errors/trunk/srfi-4-checks.scm

    r19227 r34206  
    44(module srfi-4-checks
    55
    6   (;export
    7     check-s8vector
    8     check-u8vector
    9     check-s16vector
    10     check-u16vector
    11     check-s32vector
    12     check-u32vector
    13     check-s64vector
    14     check-u64vector
    15     check-f32vector
    16     check-f64vector)
    17  
    18   (import
    19     scheme
    20     chicken
    21     srfi-4
    22     (only data-structures any?)
    23     (only type-checks define-check-type)
    24     srfi-4-errors)
    25  
    26   (require-library srfi-4 type-checks srfi-4-errors)
    27  
     6(;export
     7  check-s8vector
     8  check-u8vector
     9  check-s16vector
     10  check-u16vector
     11  check-s32vector
     12  check-u32vector
     13  check-s64vector
     14  check-u64vector
     15  check-f32vector
     16  check-f64vector)
     17
     18(import scheme)
     19
     20(import chicken)
     21
     22(require-extension srfi-4)
     23
     24(import (only data-structures any?))
     25(require-library data-structures)
     26
     27(import (only type-checks define-check-type))
     28(require-library type-checks)
     29
     30(require-extension srfi-4-errors)
     31
    2832(define-check-type s8vector)
    2933(define-check-type u8vector)
  • release/4/check-errors/trunk/srfi-4-errors.scm

    r19227 r34206  
    44(module srfi-4-errors
    55
    6   (;export
    7     error-s8vector
    8     error-u8vector
    9     error-s16vector
    10     error-u16vector
    11     error-s32vector
    12     error-u32vector
    13     error-s64vector
    14     error-u64vector
    15     error-f32vector
    16     error-f64vector)
    17  
    18   (import
    19     scheme
    20     chicken
    21     srfi-4
    22     (only type-errors define-error-type))
    23  
    24   (require-library srfi-4 type-errors)
    25  
     6(;export
     7  error-s8vector
     8  error-u8vector
     9  error-s16vector
     10  error-u16vector
     11  error-s32vector
     12  error-u32vector
     13  error-s64vector
     14  error-u64vector
     15  error-f32vector
     16  error-f64vector)
     17
     18(import scheme)
     19
     20(import chicken)
     21
     22(require-extension srfi-4)
     23
     24(import (only type-errors define-error-type))
     25(require-library type-errors)
     26
    2627(define-error-type s8vector)
    2728(define-error-type u8vector)
  • release/4/check-errors/trunk/type-checks.scm

    r22412 r34206  
    11;;;; type-checks.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, Apr '09
    34
     
    67(module type-checks
    78
    8   (;export
    9     define-check-type
    10     define-check+error-type
    11     check-defined-value
    12     check-bound-value
    13     check-number
    14     check-fixnum
    15     check-flonum
    16     check-integer
    17     check-real
    18     check-complex
    19     check-rational
    20     check-exact
    21     check-inexact
    22     check-positive-fixnum
    23     check-natural-fixnum
    24     check-positive-integer
    25     check-natural-integer
    26     check-positive-number
    27     check-natural-number
    28     check-procedure check-closure
    29     check-input-port
    30     check-output-port
    31     check-list
    32     check-pair
    33     check-blob
    34     check-vector
    35     check-structure
    36     check-record
    37     check-record-type
    38     check-symbol
    39     check-keyword
    40     check-string
    41     check-char
    42     check-boolean
    43     check-alist
    44     check-minimum-argument-count check-argument-count
    45     check-closed-interval check-open-interval
    46     check-half-closed-interval check-half-open-interval
    47     ;
    48     check-cardinal-fixnum
    49     check-cardinal-integer
    50     check-cardinal-number)
    51 
    52   (import chicken scheme type-errors)
    53 
    54   (require-library type-errors)
    55 
    56   (declare (bound-to-procedure ##sys#structure?))
     9(;export
     10define-check-type
     11define-check+error-type
     12check-defined-value
     13check-bound-value
     14check-number
     15check-fixnum
     16check-flonum
     17check-integer
     18check-real
     19check-complex
     20check-rational
     21check-exact
     22check-inexact
     23check-positive-fixnum
     24check-natural-fixnum
     25check-positive-integer
     26check-natural-integer
     27check-positive-number
     28check-natural-number
     29check-procedure check-closure
     30check-input-port
     31check-output-port
     32check-list
     33check-pair
     34check-blob
     35check-vector
     36check-structure
     37check-record
     38check-record-type
     39check-symbol
     40check-keyword
     41check-string
     42check-char
     43check-boolean
     44check-alist
     45check-minimum-argument-count check-argument-count
     46check-closed-interval check-open-interval
     47check-half-closed-interval check-half-open-interval
     48;
     49check-cardinal-fixnum
     50check-cardinal-integer
     51check-cardinal-number)
     52
     53(import chicken scheme type-errors)
     54
     55(require-library type-errors)
     56
     57(declare (bound-to-procedure ##sys#structure?))
    5758
    5859;;
     
    7778
    7879    ;; Backwards
    79     (define (check-cardinal-fixnum . _) (begin))
    80     (define (check-cardinal-integer . _) (begin))
    81     (define (check-cardinal-number . _) (begin))
    82 
    83     (define (check-positive-fixnum . _) (begin))
    84     (define (check-natural-fixnum . _) (begin))
    85     (define (check-positive-integer . _) (begin))
    86     (define (check-natural-integer . _) (begin))
    87     (define (check-positive-number . _) (begin))
    88     (define (check-natural-number . _) (begin))
    89     (define (check-structure . _) (begin))
    90     (define (check-record . _) (begin))
    91     (define (check-record-type . _) (begin))
    92     (define (check-minimum-argument-count . _) (begin))
    93     (define (check-argument-count . _) (begin))
    94     (define (check-closed-interval . _) (begin))
    95     (define (check-open-interval . _) (begin))
    96     (define (check-half-closed-interval . _) (begin))
    97     (define (check-half-open-interval . _) (begin)) )
     80    (define (check-cardinal-fixnum loc obj . _) obj)
     81    (define (check-cardinal-integer loc obj . _) obj)
     82    (define (check-cardinal-number loc obj . _) obj)
     83
     84    (define (check-positive-fixnum loc obj . _) obj)
     85    (define (check-natural-fixnum loc obj . _) obj)
     86    (define (check-positive-integer loc obj . _) obj)
     87    (define (check-natural-integer loc obj . _) obj)
     88    (define (check-positive-number loc obj . _) obj)
     89    (define (check-natural-number loc obj . _) obj)
     90    (define (check-structure loc obj . _) obj)
     91    (define (check-record loc obj . _) obj)
     92    (define (check-record-type loc obj . _) obj)
     93    (define (check-minimum-argument-count loc obj . _) obj)
     94    (define (check-argument-count loc obj . _) obj)
     95    (define (check-closed-interval loc obj . _) obj)
     96    (define (check-open-interval loc obj . _) obj)
     97    (define (check-half-closed-interval loc obj . _) obj)
     98    (define (check-half-open-interval loc obj . _) obj) )
    9899
    99100  (else
     
    257258(define (check-half-closed-interval loc num min max . args)
    258259  (unless (and (<= min num) (< num max))
    259     (error-half-closed-interval loc num min max (optional args))) 
     260    (error-half-closed-interval loc num min max (optional args)))
    260261  num)
    261262
  • release/4/check-errors/trunk/type-errors.scm

    r27970 r34206  
    11;;;; type-errors.scm
     2;;;; Kon Lovett, Jun '17
    23;;;; Kon Lovett, Apr '09
    34
     
    1415(module type-errors
    1516
    16   (;export
    17     make-bad-argument-message
    18     make-type-name-message
    19     make-error-type-message
    20     signal-type-error
    21     error-argument-type
    22     warning-argument-type
    23     (define-error-type error-argument-type)
    24     error-bound-value
    25     error-defined-value
    26     error-number
    27     error-fixnum
    28     error-flonum
    29     error-integer
    30     error-real
    31     error-complex
    32     error-rational
    33     error-exact
    34     error-inexact
    35     error-positive-number
    36     error-natural-number
    37     error-positive-fixnum
    38     error-natural-fixnum
    39     error-positive-integer
    40     error-natural-integer
    41     error-procedure error-closure
    42     error-input-port
    43     error-output-port
    44     error-list
    45     error-pair
    46     error-blob
    47     error-vector
    48     error-structure
    49     error-record
    50     error-record-type
    51     error-symbol
    52     error-keyword
    53     error-string
    54     error-char
    55     error-boolean
    56     error-plist
    57     error-alist
    58     error-minimum-argument-count
    59     error-argument-count
    60     error-interval
    61     error-closed-interval error-open-interval
    62     error-half-open-interval error-half-closed-interval
    63     ;
    64     error-cardinal-fixnum
    65     error-cardinal-integer
    66     error-cardinal-number)
    67 
    68   (import scheme chicken foreign (only data-structures ->string conc))
    69 
    70   (require-library data-structures)
    71 
    72   (declare
    73     (pure
    74       vowel? get-indefinite-article
    75       make-error-type-message make-type-name-message
    76       make-bad-argument-message)
    77     (bound-to-procedure ##sys#signal-hook ##sys#error-hook) )
     17(;export
     18  make-bad-argument-message
     19  make-type-name-message
     20  make-error-type-message
     21  signal-type-error
     22  error-argument-type
     23  warning-argument-type
     24  (define-error-type error-argument-type)
     25  error-bound-value
     26  error-defined-value
     27  error-number
     28  error-fixnum
     29  error-flonum
     30  error-integer
     31  error-real
     32  error-complex
     33  error-rational
     34  error-exact
     35  error-inexact
     36  error-positive-number
     37  error-natural-number
     38  error-positive-fixnum
     39  error-natural-fixnum
     40  error-positive-integer
     41  error-natural-integer
     42  error-procedure error-closure
     43  error-input-port
     44  error-output-port
     45  error-list
     46  error-pair
     47  error-blob
     48  error-vector
     49  error-structure
     50  error-record
     51  error-record-type
     52  error-symbol
     53  error-keyword
     54  error-string
     55  error-char
     56  error-boolean
     57  error-plist
     58  error-alist
     59  error-minimum-argument-count
     60  error-argument-count
     61  error-interval
     62  error-closed-interval error-open-interval
     63  error-half-open-interval error-half-closed-interval
     64  ;
     65  error-cardinal-fixnum
     66  error-cardinal-integer
     67  error-cardinal-number)
     68
     69(import scheme)
     70
     71(import chicken foreign)
     72
     73(import (only data-structures ->string conc))
     74(require-library data-structures)
     75
     76(declare
     77  (pure
     78    vowel? appropriate-indefinite-article
     79    make-error-type-message make-type-name-message
     80    make-bad-argument-message)
     81  (bound-to-procedure
     82    ##sys#signal-hook ##sys#error-hook) )
    7883
    7984;;;
    8085
    81 ; maybe a problem with expansion environment namespace pollution
     86(define (->boolean obj)
     87  (and
     88    obj
     89    #t ) )
     90
     91;(maybe a problem with expansion environment namespace pollution)
    8292(define-for-syntax (symbolize . elts)
    8393  (string->symbol (apply conc (map strip-syntax elts))) )
    8494
    85 (define (vowel? ch) (and (memq ch '(#\a #\e #\i #\o #\u)) #t))
    86 
    87 (define (get-indefinite-article wrdstr)
    88   (if (vowel? (string-ref wrdstr 0)) 'an
    89     'a) )
    90 
    9195;;
    9296
    9397(define (make-bad-argument-message #!optional argnam)
    94   (if (not argnam) "bad argument"
     98  (if (not argnam)
     99    "bad argument"
    95100    (string-append "bad `" (->string argnam) "' argument") ) )
    96101
    97102(define (make-type-name-message typnam)
    98   (let ((typnam (->string typnam)))
    99     (conc (get-indefinite-article typnam) #\space typnam) ) )
     103  (or
     104    (localized-type-name-message typnam)
     105    (->string typnam)) )
    100106
    101107(define (make-error-type-message typnam #!optional argnam)
     
    118124
    119125(define (warning-argument-type loc obj typnam #!optional argnam)
    120   (warning
    121     (string-append
    122       (if loc (conc #\( (symbol->string loc) #\) #\space) "")
    123       (conc (make-error-type-message typnam argnam) #\: #\space)
    124       (->string obj))) )
     126  (let ((typ-msg (conc (make-error-type-message typnam argnam) #\: #\space) )
     127        (obj-str (->string obj) ) )
     128    (let* ((wrn-msg (string-append typ-msg obj-str) )
     129           (wrn-msg
     130            (if loc
     131              (string-append (location-message loc) wrn-msg)
     132              wrn-msg ) ) )
     133      (warning wrn-msg) ) ) )
     134
     135(define (location-message loc)
     136  (conc #\( (symbol->string loc) #\) #\space) )
    125137
    126138;;
     
    201213    num) )
    202214
     215(define-constant +left-open-interval+ '|(|)     ;'|]|
     216(define-constant +right-open-interval+ '|)|)    ;'|[|
     217
     218(define-constant +left-closed-interval+ '|[|)
     219(define-constant +right-closed-interval+ '|]|)
     220
    203221(define (error-closed-interval loc num min max #!optional argnam)
    204   (error-interval loc num '|[| min max '|]| argnam))
     222  (error-interval loc num +left-closed-interval+ min max +right-closed-interval+ argnam))
    205223
    206224(define (error-open-interval loc num min max #!optional argnam)
    207   (error-interval loc num '|]| min max '|[| argnam))
     225  (error-interval loc num +left-open-interval+ min max +right-open-interval+ argnam))
    208226
    209227(define (error-half-open-interval loc num min max #!optional argnam)
    210   (error-interval loc num '|]| min max '|]| argnam))
     228  (error-interval loc num +left-open-interval+ min max +right-closed-interval+ argnam))
    211229
    212230(define (error-half-closed-interval loc num min max #!optional argnam)
    213   (error-interval loc num '|[| min max '|[| argnam))
     231  (error-interval loc num +left-closed-interval+ min max +right-open-interval+ argnam))
    214232
    215233(define (error-minimum-argument-count loc argc minargc)
    216   (##sys#error-hook (foreign-value "C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR" int) loc
    217                     minargc argc #f) )
     234  (##sys#error-hook
     235    (foreign-value "C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR" int)
     236    loc
     237    minargc argc #f) )
    218238
    219239(define (error-argument-count loc argc maxargc)
    220   (##sys#error-hook (foreign-value "C_BAD_ARGUMENT_COUNT_ERROR" int) loc
    221                     maxargc argc #f) )
     240  (##sys#error-hook
     241    (foreign-value "C_BAD_ARGUMENT_COUNT_ERROR" int)
     242    loc
     243    maxargc argc #f) )
    222244
    223245;; Backwards
     
    227249(define error-cardinal-number error-natural-number)
    228250
     251;;;
     252
     253;;
     254
     255(define (localized-type-name-message typnam)
     256  ;FIXME en only
     257  (let ((typnam (->string typnam)))
     258    (conc (appropriate-indefinite-article typnam) #\space typnam) ) )
     259
     260;;
     261
     262(define +english-vowels+ '(#\a #\e #\i #\o #\u))
     263(define +english-indefinite-articles+ '(an a))
     264
     265(define (vowel? ch)
     266  (->boolean (memq ch +english-vowels+)) )
     267
     268(define (appropriate-indefinite-article wrdstr)
     269  (if (vowel? (string-ref wrdstr 0))
     270    (car +english-indefinite-articles+)
     271    (cadr +english-indefinite-articles+) ) )
     272
    229273) ;module type-errors
Note: See TracChangeset for help on using the changeset viewer.