Eliminate remaining uses of find-matching-item.

diff --git a/src/compiler/machines/svm/assembler-compiler.scm b/src/compiler/machines/svm/assembler-compiler.scm
index 1e9690e44abbf6c3adc79d5cf0d643749cbe017e..44385fb337018b16659670dbb7cdd4730c965a18 100644 (file)
--- a/src/compiler/machines/svm/assembler-compiler.scm
+++ b/src/compiler/machines/svm/assembler-compiler.scm
@@ -72,9 +72,9 @@ USA.
            (queue->list defns))))
 
 (define (find-coding-type name coding-types #!optional error?)
-  (or (find-matching-item coding-types
-       (lambda (type)
-         (eq? (coding-type-name type) name)))
+  (or (find (lambda (type)
+             (eq? (coding-type-name type) name))
+           coding-types)
       (and (if (default-object? error?) #t error?)
           (error "Unknown coding-type name:" name))))
 \f
@@ -164,9 +164,9 @@ USA.
     ;; Compute initial references.
     (let ((find-node
           (lambda (coding-type)
-            (find-matching-item nodes
-              (lambda (node)
-                (eq? (vector-ref node 0) coding-type))))))
+            (find (lambda (node)
+                    (eq? (vector-ref node 0) coding-type))
+                  nodes))))
       (for-each (lambda (coding-type from)
                  (for-each (lambda (to)
                              (enqueue! queue (cons from (find-node to))))
@@ -259,9 +259,9 @@ USA.
       (let ((outputs
             (append-map (lambda (input)
                           (let ((abbrev
-                                 (find-matching-item abbrevs
-                                   (lambda (abbrev)
-                                     (syntax-match? (car abbrev) input)))))
+                                 (find (lambda (abbrev)
+                                         (syntax-match? (car abbrev) input))
+                                       abbrevs)))
                             (if abbrev
                                 (begin
                                   (set! any-expansions? #t)
@@ -366,9 +366,9 @@ USA.
                  has-code?
                  (map (lambda (item)
                         (guarantee symbol? item #f)
-                        (or (find-matching-item pvars
-                              (lambda (pv)
-                                (eq? (pvar-name pv) item)))
+                        (or (find (lambda (pv)
+                                    (eq? (pvar-name pv) item))
+                                  pvars)
                             (error "Missing name reference:" item)))
                       coding)))))
 \f
@@ -415,9 +415,9 @@ USA.
         to-expand
         (append-map! (lambda (defn)
                        (let ((pv
-                              (find-matching-item (defn-pvars defn)
-                                (lambda (pv)
-                                  (eq? (pvar-type pv) type-name)))))
+                              (find (lambda (pv)
+                                      (eq? (pvar-type pv) type-name))
+                                    (defn-pvars defn))))
                          (if pv
                              (begin
                                (set! any-changes? #t)
@@ -562,9 +562,9 @@ USA.
 
 (define (map-key-abbrevs keyword key-abbrevs)
   (let ((key-abbrev
-        (find-matching-item key-abbrevs
-          (lambda (key-abbrev)
-            (eq? (key-abbrev-keyword key-abbrev) keyword)))))
+        (find (lambda (key-abbrev)
+                (eq? (key-abbrev-keyword key-abbrev) keyword))
+              key-abbrevs)))
     (if key-abbrev
        (key-abbrev-abbreviation key-abbrev)
        keyword)))

diff --git a/src/compiler/machines/svm/assembler-runtime.scm b/src/compiler/machines/svm/assembler-runtime.scm
index 62d31d9caeba9abfcc5af879178499da1211b0b7..43703e262efa1e3a15f5e835894a32d9407a1eec 100644 (file)
--- a/src/compiler/machines/svm/assembler-runtime.scm
+++ b/src/compiler/machines/svm/assembler-runtime.scm
@@ -45,9 +45,9 @@ USA.
 (define rt-coding-types '())
 
 (define (make-rt-coding-type name defns)
-  (if (find-matching-item rt-coding-types
-       (lambda (rt-coding-type)
-         (eq? (rt-coding-type-name rt-coding-type) name)))
+  (if (find (lambda (rt-coding-type)
+             (eq? (rt-coding-type-name rt-coding-type) name))
+           rt-coding-types)
       (error "Coding type already exists" name)
       (set! rt-coding-types
            (cons (%make-rt-coding-type name defns) rt-coding-types))))
@@ -387,18 +387,18 @@ USA.
   (let ((type (rt-coding-type name))
        (code (read-byte)))
     (let ((defn
-           (find-matching-item (rt-coding-type-defns type)
-            (lambda (defn)
-              (eqv? (rt-defn-code defn) code)))))
+           (find (lambda (defn)
+                   (eqv? (rt-defn-code defn) code))
+                 (rt-coding-type-defns type))))
       (if defn
          (cons (rt-defn-name defn)
                ((rt-defn-decoder defn) read-byte))
          (coding-error code type)))))
 
 (define (rt-coding-type name)
-  (or (find-matching-item rt-coding-types
-       (lambda (rt-coding-type)
-         (eq? (rt-coding-type-name rt-coding-type) name)))
+  (or (find (lambda (rt-coding-type)
+             (eq? (rt-coding-type-name rt-coding-type) name))
+           rt-coding-types)
       (error:bad-range-argument name 'RT-CODING-TYPE)))
 
 (define condition-type:coding-error

diff --git a/src/compiler/machines/svm/disassembler.scm b/src/compiler/machines/svm/disassembler.scm
index 072314581bd16fe740f76644fdc0cbd5cd5d82c2..71311302f5970717a7c10c20e2c8eb257e8755a8 100644 (file)
--- a/src/compiler/machines/svm/disassembler.scm
+++ b/src/compiler/machines/svm/disassembler.scm
@@ -313,13 +313,12 @@ USA.
                 (system-vector-ref block index)))
         (refs (system-hunk3-cxr2 cache))
         (entry
-         (find-matching-item
-          (case kind
-            ((1) (system-hunk3-cxr0 refs))
-            ((2) (system-hunk3-cxr1 refs))
-            (else (error "Not a kind of variable cache:" kind)))
-          (lambda (e)
-            (weak-assq block (cdr e))))))
+         (find (lambda (e)
+                 (weak-assq block (cdr e)))
+               (case kind
+                 ((1) (system-hunk3-cxr0 refs))
+                 ((2) (system-hunk3-cxr1 refs))
+                 (else (error "Not a kind of variable cache:" kind))))))
     (write-string "variable cache for ")
     (if (pair? entry)
        (write (car entry))

diff --git a/src/cref/forpkg.scm b/src/cref/forpkg.scm
index fda8a028fdcffe1e0e0f7b3414e62deef74b0937..f0d5809b4e7bb1db26845a4e3fb0083c50c489f4 100644 (file)
--- a/src/cref/forpkg.scm
+++ b/src/cref/forpkg.scm
@@ -300,9 +300,9 @@ USA.
        (value-cell (expression/value-cell expression)))
     (let ((binding
           (and value-cell
-               (find-matching-item (value-cell/bindings value-cell)
-                 (lambda (binding)
-                   (eq? package* (binding/package binding)))))))
+               (find (lambda (binding)
+                       (eq? package* (binding/package binding)))
+                     (value-cell/bindings value-cell)))))
       (if binding
          (let ((name (binding/name binding)))
            (if (and package

diff --git a/src/cref/object.scm b/src/cref/object.scm
index d4f1d7c812540e5b0f465cad8cd5e614686c6b12..f6956190c8b3e3e4435350ba127925e7704984df 100644 (file)
--- a/src/cref/object.scm
+++ b/src/cref/object.scm
@@ -69,16 +69,16 @@ USA.
   (null? (package/name package)))
 
 (define-integrable (package/find-reference package name)
-  (find-matching-item (package/references package)
-                     (lambda (ref) (eq? (reference/name ref) name))))
+  (find (lambda (ref) (eq? (reference/name ref) name))
+       (package/references package)))
 
 (define-integrable (package/put-reference! package reference)
   (set-package/references! package
                           (cons reference (package/references package))))
 
 (define-integrable (package/find-binding package name)
-  (find-matching-item (package/bindings package)
-                     (lambda (ref) (eq? (binding/name ref) name))))
+  (find (lambda (ref) (eq? (binding/name ref) name))
+       (package/bindings package)))
 
 (define-integrable (package/put-binding! package binding)
   (set-package/bindings! package

diff --git a/src/edwin/sendmail.scm b/src/edwin/sendmail.scm
index c73536b23a328739462559d038a9e1de4821a79b..170401af9c272e31330a85c92aa48936b958f3ae 100644 (file)
--- a/src/edwin/sendmail.scm
+++ b/src/edwin/sendmail.scm
@@ -363,9 +363,9 @@ is inserted."
     (let ((given-header?
           (lambda (name null-true?)
             (let ((header
-                   (find-matching-item headers
-                     (lambda (header)
-                       (string-ci=? (car header) name)))))
+                   (find (lambda (header)
+                           (string-ci=? (car header) name))
+                         headers)))
               (and header
                    (cadr header)
                    (if null-true?
@@ -1786,15 +1786,14 @@ Otherwise, the MIME type is determined from the file's suffix;
             (if prompt?
                 (do-mime)
                 (let ((entry
-                       (find-matching-item
-                           (ref-variable file-type-to-mime-type buffer)
-                         (lambda (entry)
-                           (cond ((string? type)
-                                  (string-ci=? (car entry) type))
-                                 ((not type)
-                                  (not (car entry)))
-                                 (else
-                                  (eq? type 'WILD)))))))
+                       (find (lambda (entry)
+                               (cond ((string? type)
+                                      (string-ci=? (car entry) type))
+                                     ((not type)
+                                      (not (car entry)))
+                                     (else
+                                      (eq? type 'WILD))))
+                             (ref-variable file-type-to-mime-type buffer))))
                   (cond (entry (make-mime-type (cadr entry) (caddr entry)))
                         ((pathname-mime-type pathname))
                         (else

diff --git a/src/edwin/unix.scm b/src/edwin/unix.scm
index 93521f946002cf917aec530b9bc3f2a4965e388d..ca3b700b471b38fce99cc720d8a3d985d4523dc4 100644 (file)
--- a/src/edwin/unix.scm
+++ b/src/edwin/unix.scm
@@ -192,11 +192,11 @@ Includes the new backup.  Must be > 0."
 
 (define (os/newest-backup pathname)
   (or (os/newest-numeric-backup pathname)
-      (find-matching-item
-          (os/directory-list-completions
-           (directory-namestring pathname)
-           (string-append (file-namestring pathname) "~"))
-        os/backup-filename?)))
+      (find
+       os/backup-filename?
+       (os/directory-list-completions
+       (directory-namestring pathname)
+       (string-append (file-namestring pathname) "~")))))
 \f
 (define (os/buffer-backup-pathname truename buffer)
   (call-with-values
@@ -666,9 +666,8 @@ option, instead taking -P <filename>."
 
 (define (os/sendmail-program)
   (or (os/find-program "sendmail" #f (ref-variable exec-path) #f)
-      (find-matching-item
-         '("/usr/sbin/sendmail" "/usr/lib/sendmail" "/usr/ucblib/sendmail")
-       file-executable?)
+      (find file-executable?
+           '("/usr/sbin/sendmail" "/usr/lib/sendmail" "/usr/ucblib/sendmail"))
       "fakemail"))
 
 (define (os/newsrc-file-name server)

diff --git a/src/ffi/generator.scm b/src/ffi/generator.scm
index 6f63df43b36534fe6574cd5da6657e3cd3fc479a..6ec510a60f55d54aa4dd6caa935ac844e0715610 100644 (file)
--- a/src/ffi/generator.scm
+++ b/src/ffi/generator.scm
@@ -147,8 +147,8 @@ Scm_"name" (void)
 "))))))
 
 (define (matching-param? string params)
-  (find-matching-item params
-    (lambda (param) (string=? string (symbol->string (car param))))))
+  (find (lambda (param) (string=? string (symbol->string (car param))))
+       params))
 
 (define (new-variable root-name params)
   ;; Returns a name (string) for a variable that must be distinct from

diff --git a/src/sf/emodel.scm b/src/sf/emodel.scm
index dd83438bd8b0e61004bf0edb59302b1abc74d61b..8292d0bffc740488d148a227149a39663f7987c1 100644 (file)
--- a/src/sf/emodel.scm
+++ b/src/sf/emodel.scm
@@ -50,9 +50,9 @@ USA.
            (and intern? (%variable/make&bind! block name))))))
 
 (define (%block/lookup-name block name)
-  (find-matching-item (block/bound-variables block)
-                     (lambda (variable)
-                       (eq? (variable/name variable) name))))
+  (find (lambda (variable)
+         (eq? (variable/name variable) name))
+       (block/bound-variables block)))
 
 (define (block/limited-lookup block name limit)
   (guarantee symbol? name 'block/limited-lookup)

diff --git a/src/ssp/mod-lisp.scm b/src/ssp/mod-lisp.scm
index a7db288cc1686e86ef9bb018b1abb1346a230688..ccce2e8a9cb210c6f6d887a8b403e5cb92f59e45 100644 (file)
--- a/src/ssp/mod-lisp.scm
+++ b/src/ssp/mod-lisp.scm
@@ -770,9 +770,9 @@ USA.
 (define (define-url-bindings url . klist)
   (guarantee keyword-list? klist 'define-url-bindings)
   (let* ((binding
-         (find-matching-item url-bindings
-           (lambda (binding)
-             (string=? (car binding) url)))))
+         (find (lambda (binding)
+                 (string=? (car binding) url))
+               url-bindings)))
     (if binding
        (do ((klist klist (cddr klist)))
            ((not (pair? klist)))

diff --git a/src/star-parser/shared.scm b/src/star-parser/shared.scm
index dc3f384eaccc1853ded7b062818b5c5c0d20c261..719e5dd229a852010135940833c70a9e85e5a784 100644 (file)
--- a/src/star-parser/shared.scm
+++ b/src/star-parser/shared.scm
@@ -675,12 +675,12 @@ USA.
   (pp pointers)
   (newline)
   |#
-  (cond ((or (find-matching-item pointer-optimizations
-              (lambda (p)
-                (syntax-match? (car p) expression)))
-            (find-matching-item default-pointer-optimizations
-              (lambda (p)
-                (syntax-match? (car p) expression))))
+  (cond ((or (find (lambda (p)
+                    (syntax-match? (car p) expression))
+                  pointer-optimizations)
+            (find (lambda (p)
+                    (syntax-match? (car p) expression))
+                  default-pointer-optimizations))
         => (lambda (p)
              (let ((expression* ((cdr p) expression pointers)))
                (if (equal? expression* expression)
@@ -779,15 +779,15 @@ USA.
 
 (define (%current-pointers pointers)
   (if (car pointers)
-      (find-matching-item (cdr pointers)
-       (lambda (identifiers)
-         (memq (car pointers) identifiers)))
+      (find (lambda (identifiers)
+             (memq (car pointers) identifiers))
+           (cdr pointers))
       '()))
 
 (define (%id-pointers identifier pointers)
-  (or (find-matching-item (cdr pointers)
-       (lambda (ids)
-         (memq identifier ids)))
+  (or (find (lambda (ids)
+             (memq identifier ids))
+           (cdr pointers))
       '()))
 \f
 (define-pointer-optimization

diff --git a/src/xdoc/xdoc.scm b/src/xdoc/xdoc.scm
index 58be6d823bd9973907ebc8a4093e331dc21919c7..067ade24aa6c8f0af764963a31f820c778f1b9ac 100644 (file)
--- a/src/xdoc/xdoc.scm
+++ b/src/xdoc/xdoc.scm
@@ -723,9 +723,9 @@ USA.
     (let per-elt ((elt elt) (containers (xdoc-element-containers elt)))
       (let* ((id (xdoc-db-id elt))
             (suffix (string-append "-" (symbol->string id))))
-       (cond ((find-matching-item bindings
-                (lambda (binding)
-                  (string-suffix? suffix (symbol->string (car binding)))))
+       (cond ((find (lambda (binding)
+                      (string-suffix? suffix (symbol->string (car binding))))
+                    bindings)
               => (lambda (binding)
                    (values (let ((name (symbol->string (car binding))))
                              (substring->symbol
@@ -1178,9 +1178,9 @@ USA.
          #f))))
 
 (define (%find-attribute name attrs)
-  (find-matching-item attrs
-    (lambda (attr)
-      (xml-name=? (xml-attribute-name attr) name))))
+  (find (lambda (attr)
+         (xml-name=? (xml-attribute-name attr) name))
+       attrs))
 
 (define (symbol-attribute name elt error?)
   (let ((string (find-attribute name elt error?)))
@@ -1336,10 +1336,10 @@ USA.
   (%find-result (%find-child elt predicate) error?))
 
 (define (%find-child elt predicate)
-  (find-matching-item (xml-element-contents elt)
-    (lambda (item)
-      (and (xml-element? item)
-          (predicate item)))))
+  (find (lambda (item)
+         (and (xml-element? item)
+              (predicate item)))
+       (xml-element-contents elt)))
 
 (define (%find-result elt error?)
   (if (and (not elt) error?)

diff --git a/src/xml/rdf-struct.scm b/src/xml/rdf-struct.scm
index e691d367c64c46b62160667a3ba19e4a5fd07c9e..70a656714b323f8127fa497c03d19ec4e65d78c9 100644 (file)
--- a/src/xml/rdf-struct.scm
+++ b/src/xml/rdf-struct.scm
@@ -292,11 +292,11 @@ USA.
                  (registry-bindings
                   (check-registry registry 'URI->RDF-PREFIX)))
                 (filter (lambda (p) (string-prefix? (cdr p) s))))
-            (or (find-matching-item alist
-                  (lambda (p)
-                    (and (not (eq? (car p) ':))
-                         (filter p))))
-                (find-matching-item alist filter)))))
+            (or (find (lambda (p)
+                        (and (not (eq? (car p) ':))
+                             (filter p)))
+                      alist)
+                (find filter alist)))))
       (if p
          (values (car p) (cdr p))
          (begin

diff --git a/src/xml/xml-parser.scm b/src/xml/xml-parser.scm
index e6d90c06bc681a2b78a30700fd0c1e38be34a6b7..a8ebcaaaa5bd47d5dfc89a78ad59e723ad5f5200 100644 (file)
--- a/src/xml/xml-parser.scm
+++ b/src/xml/xml-parser.scm
@@ -430,9 +430,9 @@ USA.
 (define (process-attr-decls name attrs p)
   (let ((decl
         (and (or *standalone?* *internal-dtd?*)
-             (find-matching-item *att-decls*
-               (lambda (decl)
-                 (xml-name=? (xml-!attlist-name decl) name))))))
+             (find (lambda (decl)
+                     (xml-name=? (xml-!attlist-name decl) name))
+                   *att-decls*))))
     (if decl
        (do ((defns (xml-!attlist-definitions decl) (cdr defns))
             (attrs attrs (process-attr-defn (car defns) attrs p)))
@@ -444,9 +444,9 @@ USA.
        (type (cadr defn))
        (default (caddr defn)))
     (let ((attr
-          (find-matching-item attrs
-            (lambda (attr)
-              (xml-name=? (car (xml-attribute-name attr)) name)))))
+          (find (lambda (attr)
+                  (xml-name=? (car (xml-attribute-name attr)) name))
+                attrs)))
       (if attr
          (let ((av (xml-attribute-value attr)))
            (if (and (pair? default)
@@ -946,9 +946,9 @@ USA.
          (make-xml-parameter-entity-ref name)))))
 
 (define (find-parameter-entity name)
-  (find-matching-item *parameter-entities*
-    (lambda (entity)
-      (eq? name (xml-parameter-!entity-name entity)))))
+  (find (lambda (entity)
+         (eq? name (xml-parameter-!entity-name entity)))
+       *parameter-entities*))
 
 (define *parameter-entities*)
 \f

diff --git a/src/xml/xml-rpc.scm b/src/xml/xml-rpc.scm
index 82b17c0ad72e7b3e0e47899e369b383c5f00de47..a0453b67c5b585a4ab9993c0fe9cb56624ae4a36 100644 (file)
--- a/src/xml/xml-rpc.scm
+++ b/src/xml/xml-rpc.scm
@@ -199,10 +199,10 @@ USA.
     child))
 
 (define (%named-child name elt)
-  (find-matching-item (xml-element-contents elt)
-    (lambda (item)
-      (and (xml-element? item)
-          (xml-name=? (xml-element-name item) name)))))
+  (find (lambda (item)
+         (and (xml-element? item)
+              (xml-name=? (xml-element-name item) name)))
+       (xml-element-contents elt)))
 
 (define (single-child elt)
   (let ((children (all-children elt)))