Changeset 15838 in project


Ignore:
Timestamp:
09/12/09 18:56:02 (10 years ago)
Author:
Kon Lovett
Message:

Rel 1.1.1 - no new features, just import specificity.

Location:
release/4/apropos
Files:
2 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/apropos/tags/1.1.1/apropos.scm

    r14211 r15838  
    3838;;;
    3939
    40 ;; Argument Checking
    41 
    42 (define-inline (%search-pattern? obj)
    43   (or (keyword? obj) (symbol? obj) (string? obj) (regexp? obj)) )
    44 
    45 (define-inline (%sort-key? obj)
    46   (or (not obj) (eq? #:name obj) (eq? #:kind obj)) )
    47 
    48 (define-inline (%check-search-pattern loc obj argnam)
    49   (unless (%search-pattern? obj)
    50     (error-search-pattern loc obj argnam) ) )
    51 
    52 (define-inline (%check-sort-key loc obj)
    53   (unless (%sort-key? obj)
    54     (error-sort-key loc obj #:sort) ) )
    55 
    56 #; ;UNUSED
    57 (define-inline (%check-environment* loc obj argnam)
    58   (cond ((##sys#environment? obj) #f)
    59         ((##sys#syntactic-environment? obj) obj)
    60         (else
    61           (error-invalid-environment loc obj argnam) ) ) )
    62 
    63 ;; Module
     40;; Module apropos
    6441
    6542(module apropos (;export
     
    7148  #;apropos/environments #;apropos-list/environments #;apropos-information-list/environments)
    7249
    73 (import scheme chicken srfi-13 regex lolevel data-structures ports extras utils
    74   (only csi toplevel-command)
    75   (only type-errors define-error-type error-argument-type))
    76 
    77 (require-library srfi-13 regex lolevel data-structures ports extras utils type-errors)
     50  (import scheme
     51          (only chicken unless when optional keyword? feature?
     52                        sub1 procedure-information receive fxmax
     53                        string->keyword error)
     54          ;(only srfi-23 error)
     55          (only srfi-13 string-trim-both)
     56          (only regex regexp? regexp-escape regexp string-search)
     57          (only lolevel global-ref global-bound?)
     58          (only data-structures sort any?)
     59          (only ports with-input-from-string)
     60          (only extras read-file read-line)
     61          (only csi toplevel-command)
     62          (only type-checks define-check+error-type)
     63          (only type-errors define-error-type error-argument-type))
     64
     65  (require-library srfi-13 regex lolevel data-structures ports extras type-checks type-errors)
    7866
    7967;;; Support
    8068
     69;; Types
     70
     71(define (search-pattern? obj) (or (keyword? obj) (symbol? obj) (string? obj) (regexp? obj)))
     72(define (sort-key? obj) (or (not obj) (eq? #:name obj) (eq? #:kind obj)))
     73
    8174;; Errors
    82 
    83 (define-error-type search-pattern "symbol/keyword/string/regexp")
    84 
    85 (define-error-type sort-key "#:name, #:kind or #f")
    8675
    8776#; ;UNUSED
     
    9180  (if (keyword? arg) (error loc "unrecognized keyword argument" arg)
    9281      (error loc "unrecognized argument" arg) ) )
     82
     83;; Argument Checking
     84
     85(define-check+error-type search-pattern search-pattern? "symbol/keyword/string/regexp")
     86(define-check+error-type sort-key sort-key? "#:name, #:kind or #f")
     87
     88#; ;UNUSED
     89(define (checked-environment loc obj argnam)
     90  (cond ((##sys#environment? obj) #f)
     91        ((##sys#syntactic-environment? obj) obj)
     92        (else
     93          (error-environment loc obj argnam) ) ) )
    9394
    9495;; Symbols
     
    181182(define (parse-sort-key-argument loc args)
    182183  (receive (sort-key args) (keyword-argument args #:sort #:kind)
    183     (%check-sort-key loc sort-key)
     184    (check-sort-key loc sort-key #:sort)
    184185    (values sort-key args) ) )
    185186
     
    220221                      (error-argument loc arg) ) ) ) ) ) ) )
    221222
    222   (%check-search-pattern loc patt 'pattern)
     223  (check-search-pattern loc patt 'pattern)
    223224  (receive (env macenv qualified?) (parse-rest-arguments)
    224225    (values (*apropos-list loc (make-apropos-regexp patt) env macenv qualified?) macenv) ) )
     
    228229
    229230(define (parse-arguments/environment loc patt env qualified?)
    230   (%check-search-pattern loc patt 'pattern)
    231   (let ((macenv (%check-environment* loc env 'environment)))
     231  (check-search-pattern loc patt 'pattern)
     232  (let ((macenv (checked-environment loc env 'environment)))
    232233    (values (*apropos-list/environment loc (make-apropos-regexp patt) env macenv qualified?) macenv) ) )
    233234
     
    253254                      (loop (cdr args) (cons env envs)) ) ) ) ) ) ) )
    254255
    255   (%check-search-pattern loc patt 'pattern)
     256  (check-search-pattern loc patt 'pattern)
    256257  (receive (envs qualified?) (parse-rest-arguments)
    257258    (let ((regexp (make-apropos-regexp patt)))
     
    259260        (if (null? envs) (reverse envsyms)
    260261            (let* ((env (car envs))
    261                    (macenv (%check-environment* loc env 'environment))
     262                   (macenv (checked-environment loc env 'environment))
    262263                   (make-envsyms
    263264                    (lambda ()
     
    370371
    371372(define (apropos/environment patt env #!key qualified? (sort #:name))
    372   (%check-sort-key 'apropos/environment sort)
     373  (check-sort-key 'apropos/environment sort #:sort)
    373374  (receive (syms macenv)
    374375           (parse-arguments/environment 'apropos/environment patt env qualified?)
     
    402403
    403404<procedure>(apropos-list/environments PATTERN [#:qualified? QUALIFIED?] ENVIRONMENT...)</procedure>
    404 
    405405
    406406Like {{apropos-list}}.
  • release/4/apropos/trunk/apropos.scm

    r14211 r15838  
    3838;;;
    3939
    40 ;; Argument Checking
    41 
    42 (define-inline (%search-pattern? obj)
    43   (or (keyword? obj) (symbol? obj) (string? obj) (regexp? obj)) )
    44 
    45 (define-inline (%sort-key? obj)
    46   (or (not obj) (eq? #:name obj) (eq? #:kind obj)) )
    47 
    48 (define-inline (%check-search-pattern loc obj argnam)
    49   (unless (%search-pattern? obj)
    50     (error-search-pattern loc obj argnam) ) )
    51 
    52 (define-inline (%check-sort-key loc obj)
    53   (unless (%sort-key? obj)
    54     (error-sort-key loc obj #:sort) ) )
    55 
    56 #; ;UNUSED
    57 (define-inline (%check-environment* loc obj argnam)
    58   (cond ((##sys#environment? obj) #f)
    59         ((##sys#syntactic-environment? obj) obj)
    60         (else
    61           (error-invalid-environment loc obj argnam) ) ) )
    62 
    63 ;; Module
     40;; Module apropos
    6441
    6542(module apropos (;export
     
    7148  #;apropos/environments #;apropos-list/environments #;apropos-information-list/environments)
    7249
    73 (import scheme chicken srfi-13 regex lolevel data-structures ports extras utils
    74   (only csi toplevel-command)
    75   (only type-errors define-error-type error-argument-type))
    76 
    77 (require-library srfi-13 regex lolevel data-structures ports extras utils type-errors)
     50  (import scheme
     51          (only chicken unless when optional keyword? feature?
     52                        sub1 procedure-information receive fxmax
     53                        string->keyword error)
     54          ;(only srfi-23 error)
     55          (only srfi-13 string-trim-both)
     56          (only regex regexp? regexp-escape regexp string-search)
     57          (only lolevel global-ref global-bound?)
     58          (only data-structures sort any?)
     59          (only ports with-input-from-string)
     60          (only extras read-file read-line)
     61          (only csi toplevel-command)
     62          (only type-checks define-check+error-type)
     63          (only type-errors define-error-type error-argument-type))
     64
     65  (require-library srfi-13 regex lolevel data-structures ports extras type-checks type-errors)
    7866
    7967;;; Support
    8068
     69;; Types
     70
     71(define (search-pattern? obj) (or (keyword? obj) (symbol? obj) (string? obj) (regexp? obj)))
     72(define (sort-key? obj) (or (not obj) (eq? #:name obj) (eq? #:kind obj)))
     73
    8174;; Errors
    82 
    83 (define-error-type search-pattern "symbol/keyword/string/regexp")
    84 
    85 (define-error-type sort-key "#:name, #:kind or #f")
    8675
    8776#; ;UNUSED
     
    9180  (if (keyword? arg) (error loc "unrecognized keyword argument" arg)
    9281      (error loc "unrecognized argument" arg) ) )
     82
     83;; Argument Checking
     84
     85(define-check+error-type search-pattern search-pattern? "symbol/keyword/string/regexp")
     86(define-check+error-type sort-key sort-key? "#:name, #:kind or #f")
     87
     88#; ;UNUSED
     89(define (checked-environment loc obj argnam)
     90  (cond ((##sys#environment? obj) #f)
     91        ((##sys#syntactic-environment? obj) obj)
     92        (else
     93          (error-environment loc obj argnam) ) ) )
    9394
    9495;; Symbols
     
    181182(define (parse-sort-key-argument loc args)
    182183  (receive (sort-key args) (keyword-argument args #:sort #:kind)
    183     (%check-sort-key loc sort-key)
     184    (check-sort-key loc sort-key #:sort)
    184185    (values sort-key args) ) )
    185186
     
    220221                      (error-argument loc arg) ) ) ) ) ) ) )
    221222
    222   (%check-search-pattern loc patt 'pattern)
     223  (check-search-pattern loc patt 'pattern)
    223224  (receive (env macenv qualified?) (parse-rest-arguments)
    224225    (values (*apropos-list loc (make-apropos-regexp patt) env macenv qualified?) macenv) ) )
     
    228229
    229230(define (parse-arguments/environment loc patt env qualified?)
    230   (%check-search-pattern loc patt 'pattern)
    231   (let ((macenv (%check-environment* loc env 'environment)))
     231  (check-search-pattern loc patt 'pattern)
     232  (let ((macenv (checked-environment loc env 'environment)))
    232233    (values (*apropos-list/environment loc (make-apropos-regexp patt) env macenv qualified?) macenv) ) )
    233234
     
    253254                      (loop (cdr args) (cons env envs)) ) ) ) ) ) ) )
    254255
    255   (%check-search-pattern loc patt 'pattern)
     256  (check-search-pattern loc patt 'pattern)
    256257  (receive (envs qualified?) (parse-rest-arguments)
    257258    (let ((regexp (make-apropos-regexp patt)))
     
    259260        (if (null? envs) (reverse envsyms)
    260261            (let* ((env (car envs))
    261                    (macenv (%check-environment* loc env 'environment))
     262                   (macenv (checked-environment loc env 'environment))
    262263                   (make-envsyms
    263264                    (lambda ()
     
    370371
    371372(define (apropos/environment patt env #!key qualified? (sort #:name))
    372   (%check-sort-key 'apropos/environment sort)
     373  (check-sort-key 'apropos/environment sort #:sort)
    373374  (receive (syms macenv)
    374375           (parse-arguments/environment 'apropos/environment patt env qualified?)
     
    402403
    403404<procedure>(apropos-list/environments PATTERN [#:qualified? QUALIFIED?] ENVIRONMENT...)</procedure>
    404 
    405405
    406406Like {{apropos-list}}.
Note: See TracChangeset for help on using the changeset viewer.