Changeset 37884 in project


Ignore:
Timestamp:
09/07/19 16:06:52 (2 weeks ago)
Author:
Kon Lovett
Message:

simplify matcher

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/apropos/trunk/apropos-api.scm

    r37881 r37884  
    217217              (internal? #f))
    218218  ;
    219   (define (gen-irregex-options-list)
    220     (if case-insensitive? '(case-insensitive) '()) )
    221   ;
    222   (define (gen-irregex patt)
    223     (apply irregex patt (gen-irregex-options-list)) )
    224   ;
    225   (define (gen-irregex-matcher irx)
     219  (define (matcher-for pred? data)
     220    (define (check? str)
     221      (and
     222        (or internal? (not (internal-module-name? str)))
     223        (pred? str data) ) )
    226224    (cond
    227225      ((not split)
    228226        (lambda (sym)
    229           (let ((symstr (symbol->string sym)))
    230             (and
    231               (or internal? (not (internal-module-name? symstr)))
    232               (string-match? symstr irx) ) ) ) )
     227          (check? (symbol->string sym)) ) )
    233228      ((eq? #:module split)
    234229        (lambda (sym)
    235           (let-values (
    236             ((mod nam) (split-prefixed-symbol sym)) )
    237             (and
    238               (or internal? (not (internal-module-name? mod)))
    239               (string-match? mod irx) ) ) ) )
     230          (let-values (((mod nam) (split-prefixed-symbol sym)))
     231            (check? mod) ) ) )
    240232      ((eq? #:name split)
    241233        (lambda (sym)
    242           (let-values (
    243             ((mod nam) (split-prefixed-symbol sym)) )
    244             (and
    245               (or internal? (not (internal-module-name? mod)))
    246               (string-match? nam irx) ) ) ) )
     234          (let-values (((mod nam) (split-prefixed-symbol sym)))
     235            (check? nam) ) ) )
    247236        (else
    248           (error loc "unknown irregex split" split patt) ) ) )
    249   ;
    250   (define (gen-string-matcher str)
    251     (let (
    252       (matcher (if case-insensitive? string-ci-match? string-exact-match?)) )
    253       (cond
    254         ((not split)
    255           (lambda (sym)
    256             (let ((symstr (symbol->string sym)))
    257               (and
    258                 (or internal? (not (internal-module-name? symstr)))
    259                 (matcher symstr str) ) ) ) )
    260         ((eq? #:module split)
    261           (lambda (sym)
    262             (let-values (
    263               ((mod nam) (split-prefixed-symbol sym)) )
    264               (and
    265                 (or internal? (not (internal-module-name? mod)))
    266                 (matcher mod str) ) ) ) )
    267         ((eq? #:name split)
    268           (lambda (sym)
    269             (let-values (
    270               ((mod nam) (split-prefixed-symbol sym)) )
    271               (and
    272                 (or internal? (not (internal-module-name? mod)))
    273                 (matcher nam str) ) ) ) )
    274         (else
    275           (error loc "unknown string split" patt) ) ) ) )
     237          (error loc "unknown symbol split" split patt) ) ) )
     238  ;
     239  (define (string-matcher str)
     240    (let ((pred? (if case-insensitive? string-ci-match? string-exact-match?)))
     241      (matcher-for pred? str) ) )
     242  ;
     243  (define (irregex-options-list)
     244    (if case-insensitive? '(case-insensitive) '()) )
     245  ;
     246  (define (matcher-irregex patt)
     247    (apply irregex patt (irregex-options-list)) )
     248  ;
     249  (define (irregex-matcher irx)
     250    (matcher-for string-match? irx) )
    276251  ;
    277252  (cond
     
    284259    ((string? patt)
    285260      (if force-regexp?
    286         (gen-irregex-matcher (gen-irregex patt))
    287         (gen-string-matcher patt)) )
     261        (irregex-matcher (matcher-irregex patt))
     262        (string-matcher patt)) )
    288263    ;
    289264    ((irregex? patt)
    290       (gen-irregex-matcher patt) )
     265      (irregex-matcher patt) )
    291266    ;
    292267    ((pair? patt)
    293268      (if (not (eq? 'quote (car patt)))
    294         ;then assume an irregex
    295         (gen-irregex-matcher (gen-irregex patt))
     269        ;then assume an irregex form
     270        (irregex-matcher (matcher-irregex patt))
    296271        ;else some form of pattern
    297272        (let ((quoted (cadr patt)))
     
    316291              (else
    317292                (let (
    318                   (modr
     293                  (mod-match?
    319294                    (make-apropos-matcher loc
    320295                      (car quoted)
    321296                      case-insensitive? #:module force-regexp? internal?))
    322                   (namr
     297                  (nam-match?
    323298                    (make-apropos-matcher loc
    324299                      (cdr quoted)
    325300                      case-insensitive? #:name force-regexp? internal?)) )
    326301                  (lambda (sym)
    327                     (and (modr sym) (namr sym)) ) ) ) )
     302                    (and (mod-match? sym) (nam-match? sym)) ) ) ) )
    328303            ;else interpretation of stripped
    329304            (make-apropos-matcher loc
Note: See TracChangeset for help on using the changeset viewer.