Changeset 13753 in project for release/4/apropos/trunk/apropos.scm
- Timestamp:
- 03/14/09 08:20:47 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/apropos/trunk/apropos.scm
r13748 r13753 38 38 ;; 39 39 40 (cond-expand41 (unsafe42 (include "chicken-primitive-object-inlines") )43 (else ) )44 45 40 ;; Argument Checking 46 41 47 42 (define-inline (%check-search-pattern loc obj argnam) 48 (cond-expand 49 (unsafe 50 (unless (or (%keyword? obj) (%symbol? obj) (%string? obj) (regexp? obj)) 51 (error-invalid-search loc obj argnam) ) ) 52 (else 53 (unless (or (keyword? obj) (symbol? obj) (string? obj) (regexp? obj)) 54 (error-invalid-search loc obj argnam) ) ) ) ) 43 (unless (or (keyword? obj) (symbol? obj) (string? obj) (regexp? obj)) 44 (error-invalid-search loc obj argnam) ) ) 55 45 56 46 #; ;UNUSED … … 111 101 112 102 (define (symbol=? x y) 113 (cond-expand 114 (unsafe 115 (%string=? (%symbol-string x) (%symbol-string y)) ) 116 (else 117 (let ((sx (##sys#symbol->string x)) 118 (sy (##sys#symbol->string y)) 119 (px (##sys#qualified-symbol-prefix x)) 120 (py (##sys#qualified-symbol-prefix y))) 121 (cond (px (and py (string=? px py) (string=? sx sy))) 122 (py (or (not px) (and (string=? px py) (string=? sx sy)))) 123 (else (string=? sx sy) ) ) ) ) ) ) 103 (let ((sx (##sys#symbol->string x)) 104 (sy (##sys#symbol->string y)) 105 (px (##sys#qualified-symbol-prefix x)) 106 (py (##sys#qualified-symbol-prefix y))) 107 (cond (px (and py (string=? px py) (string=? sx sy))) 108 (py (or (not px) (and (string=? px py) (string=? sx sy)))) 109 (else (string=? sx sy) ) ) ) ) 124 110 125 111 (define (symbol<? x y) 126 (cond-expand 127 (unsafe 128 (%string<? (%symbol-string x) (%symbol-string y)) ) 129 (else 130 (let ((sx (##sys#symbol->string x)) 131 (sy (##sys#symbol->string y)) 132 (px (##sys#qualified-symbol-prefix x)) 133 (py (##sys#qualified-symbol-prefix y))) 134 (cond (px (and py (string<? px py) (string<? sx sy))) 135 (py (or (not px) (and (string<? px py) (string<? sx sy)))) 136 (else (string<? sx sy) ) ) ) ) ) ) 112 (let ((sx (##sys#symbol->string x)) 113 (sy (##sys#symbol->string y)) 114 (px (##sys#qualified-symbol-prefix x)) 115 (py (##sys#qualified-symbol-prefix y))) 116 (cond (px (and py (string<? px py) (string<? sx sy))) 117 (py (or (not px) (and (string<? px py) (string<? sx sy)))) 118 (else (string<? sx sy) ) ) ) ) 137 119 138 120 (define (symbol-print-length sym) 139 (cond-expand 140 (unsafe 141 (let ((siz (%string-size (%symbol-string sym)))) 142 ; assumes keyword style is not #:none 143 (cond ((%keyword? sym) siz) 144 ; compensate for the '##' 145 ((%qualified-symbol? sym) (%fx+ siz 2)) 146 ; plain old string 147 (else siz) ) ) ) 148 (else 149 (let ([len (string-length (##sys#symbol->qualified-string sym))]) 150 (if (keyword? sym) (- len 2) ; compensate for leading '###' when only a ':' is printed 151 len ) ) ) ) ) 121 (let ([len (string-length (##sys#symbol->qualified-string sym))]) 122 (if (keyword? sym) (- len 2) ; compensate for leading '###' when only a ':' is printed 123 len ) ) ) 152 124 153 125 (define (max-symbol-print-width syms) … … 157 129 158 130 (define (symbol-match? sym regexp) 159 (cond-expand 160 (unsafe 161 (string-search regexp (%symbol-string sym)) ) 162 (else 163 (string-search regexp (symbol->string sym)) ) ) ) 131 (string-search regexp (symbol->string sym)) ) 164 132 165 133 ;; Environment Search
Note: See TracChangeset
for help on using the changeset viewer.