seqs.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          seqs.lisp
   6 ;;;; Purpose:       Sequence functions for KMRCL package
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: seqs.lisp,v 1.1 2003/04/29 00:26:21 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; KMRCL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (in-package :kmrcl)
  20
  21
  22 (defun mapappend (func seq)
  23   (apply #'append (mapcar func seq)))
  24
  25 (defun mapcar-append-string-nontailrec (func v)
  26   "Concatenate results of mapcar lambda calls"
  27   (aif (car v)
  28        (concatenate 'string (funcall func it)
  29                     (mapcar-append-string-nontailrec func (cdr v)))
  30        ""))
  31
  32
  33 (defun mapcar-append-string (func v &optional (accum ""))
  34   "Concatenate results of mapcar lambda calls"
  35   (aif (car v)
  36        (mapcar-append-string
  37         func
  38         (cdr v)
  39         (concatenate 'string accum (funcall func it)))
  40        accum))
  41
  42 (defun mapcar2-append-string-nontailrec (func la lb)
  43   "Concatenate results of mapcar lambda call's over two lists"
  44   (let ((a (car la))
  45         (b (car lb)))
  46     (if (and a b)
  47       (concatenate 'string (funcall func a b)
  48                    (mapcar2-append-string-nontailrec func (cdr la) (cdr lb)))
  49       "")))
  50
  51 (defun mapcar2-append-string (func la lb &optional (accum ""))
  52   "Concatenate results of mapcar lambda call's over two lists"
  53   (let ((a (car la))
  54         (b (car lb)))
  55     (if (and a b)
  56         (mapcar2-append-string
  57          func
  58          (cdr la)
  59          (cdr lb)
  60          (concatenate 'string accum (funcall func a b)))
  61       accum)))
  62
  63
  64
  65 (defun nsubseq (sequence start &optional (end (length sequence)))
  66   "Return a subsequence by pointing to location in original sequence"
  67   (make-array (- end start)
  68               :element-type (array-element-type sequence)
  69               :displaced-to sequence
  70               :displaced-index-offset start))