Changeset 36563 in project


Ignore:
Timestamp:
09/08/18 20:21:06 (2 months ago)
Author:
kon
Message:

remove article stuff

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/mailbox/trunk/mailbox.scm

    r36562 r36563  
    6666  (only (chicken port) with-output-to-port)
    6767  (only (chicken format) printf)
    68   (only (chicken string) conc ->string)
     68  (only (chicken string) ->string)
    6969  (only (srfi 1) append! delete! list-copy last-pair)
    7070  (only (srfi 18)
     
    7575  (only record-variants define-record-type-variant))
    7676
    77 ;;;
    78 
    79 ;;
    80 
    81 (define-inline (->boolean x)
    82   (and x #t) )
     77;;; Support
     78
     79;;
     80
     81(define-type srfi-18-time (struct time))
     82
     83;;
     84
     85(define-inline (->boolean obj) (and obj #t))
    8386
    8487;;;(only type-errors define-error-type)
     
    8689;;
    8790
    88 (define-inline (localized-type-name-message typnam)
    89   ;FIXME en only
    90   (conc (appropriate-indefinite-article typnam) " " typnam) )
    91 
    92 ;;
    93 
    94 (define +english-vowels+ '(#\a #\e #\i #\o #\u))
    95 (define +english-indefinite-articles+ '(an a))
    96 
    97 (define-inline (vowel? ch)
    98   (->boolean (memq ch +english-vowels+)) )
    99 
    100 (define-inline (appropriate-indefinite-article wrd)
    101   (let ((s (->string wrd)))
    102     (if (vowel? (string-ref s 0))
    103       (car +english-indefinite-articles+)
    104       (cadr +english-indefinite-articles+) ) ) )
    105 
    106 ;;
    107 
    108 (define-inline (make-bad-argument-message #!optional argnam)
     91(define (make-bad-argument-message #!optional argnam)
    10992  (if (not argnam)
    11093    "bad argument"
    111     (conc "bad " #\` argnam #\' " argument") ) )
    112 
    113 (define-inline (make-type-name-message typnam)
    114   (or
    115     (localized-type-name-message typnam)
    116     (->string typnam)) )
    117 
    118 (define-inline (make-error-type-message typnam #!optional argnam)
    119   (string-append
    120     (make-bad-argument-message argnam)
    121     " type - not "
    122     (make-type-name-message typnam)) )
    123 
    124 ;;
    125 
    126 (define-inline (error-list loc obj #!optional argnam)
     94    (string-append "bad `" (->string argnam) "' argument") ) )
     95
     96(define (make-error-type-message typnam #!optional argnam)
     97  (string-append (make-bad-argument-message argnam) " type - not " (->string typnam)) )
     98
     99;;
     100
     101(define (error-list loc obj #!optional argnam)
    127102  (##sys#signal-hook #:type-error loc obj (make-error-type-message 'list argnam) obj) )
    128103
     
    169144    (define ($thread-blocked? th) (eq? 'blocked (##sys#slot th 3)))
    170145    (define ($thread-blocked-for-timeout? th) (and (##sys#slot th 4) (not (##sys#slot th 11)))) ) )
    171 
    172 ;;; Support
    173 
    174 (define-type srfi-18-time (struct time))
    175 
    176 (define-inline (->boolean obj)
    177   (and obj #t) )
    178146
    179147;;; Mailbox Support
Note: See TracChangeset for help on using the changeset viewer.