Changeset 9541


Ignore:
Timestamp:
May 17, 2008, 2:02:47 AM (11 years ago)
Author:
mikel
Message:

udpated sequence utils

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/library/sequence-utils.lisp

    r9540 r9541  
    33;;;; FILE IDENTIFICATION
    44;;;;
    5 ;;;; Name:          split-if.lisp
    6 ;;;; Version:       0.1
     5;;;; Name:          sequence-utils.lisp
     6;;;; Version:       0.2
    77;;;; Project:       utilities
    8 ;;;; Purpose:       utilities for splitting sequences
     8;;;; Purpose:       utilities for working with sequences
    99;;;;
    1010;;;; ***********************************************************************
     
    1212(in-package "CCL")
    1313
     14;;; -----------------------------------------------------------------
     15;;; splitting sequences
     16;;; -----------------------------------------------------------------
    1417
    1518;;; Split a sequence SEQ at each point where TEST is true
     
    4144                     (split-if (lambda (c) (member c '(#\return #\newline) :test #'char=))
    4245                               text))))
     46
     47;;; -----------------------------------------------------------------
     48;;; matching subsequences
     49;;; -----------------------------------------------------------------
     50
     51(defun match-subsequence (subseq seq &key (test #'eql) (start 0))
     52  (let ((max-index (1- (length seq))))
     53    (block matching
     54      ;; search for mismatches
     55      (dotimes (i (length subseq))
     56        (let ((pos (+ start i)))
     57          (when (or (> pos max-index)
     58                    (not (funcall test (elt seq pos)
     59                                  (elt subseq i))))
     60            (return-from matching nil))))
     61      ;; no mismatches found; return true
     62      (return-from matching t))))
     63
     64(defun %find-matching-subsequence-backward (subseq seq &key (test #'eql) (start 0) end)
     65  (let ((end (or end (length seq)))
     66        (pos end)
     67        (min-index (or start 0)))
     68    (block finding
     69      (dotimes (i (- (length seq) start))
     70        (setf pos (- end i))
     71        (if (<= pos min-index)
     72            (return-from finding nil)
     73            (when (match-subsequence subseq seq :test test :start pos)
     74              (return-from finding pos))))
     75      nil)))
     76
     77(defun %find-matching-subsequence-forward (subseq seq &key (test #'eql) (start 0) end)
     78  (let ((pos start)
     79        (max-index (or end (length seq))))
     80    (block finding
     81      (dotimes (i (- (length seq) start))
     82        (setf pos (+ start i))
     83        (if (>= pos max-index)
     84            (return-from finding nil)
     85            (when (match-subsequence subseq seq :test test :start pos)
     86              (return-from finding pos))))
     87      nil)))
     88
     89(defun find-matching-subsequence (subseq seq &key (test #'eql) (start 0) end from-end)
     90  (if from-end
     91      (%find-matching-subsequence-backward subseq seq :test test :start start :end end)
     92      (%find-matching-subsequence-forward subseq seq :test test :start start :end end)))
Note: See TracChangeset for help on using the changeset viewer.