Ignore:
Timestamp:
12/07/03 16:50:03 (18 years ago)
Author:
piso
Message:

FILL: use SIMPLE-STRING-FILL if possible.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/fill.lisp

    r2248 r4999  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: fill.lisp,v 1.1 2003-06-10 16:05:43 piso Exp $
     4;;; $Id: fill.lisp,v 1.2 2003-12-07 16:50:03 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    1818;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    1919
    20 (in-package "COMMON-LISP")
     20(in-package "SYSTEM")
    2121
    22 (export 'fill)
     22;;; Adapted from CMUCL.
    2323
    24 ;;; From CMUCL.
     24(defun list-fill (sequence item start end)
     25  (do ((current (nthcdr start sequence) (cdr current))
     26       (index start (1+ index)))
     27      ((or (atom current) (and end (= index end)))
     28       sequence)
     29    (rplaca current item)))
    2530
    26 (defmacro vector-fill (sequence item start end)
    27   `(do ((index ,start (1+ index)))
    28        ((= index ,end) ,sequence)
    29      (setf (aref ,sequence index) ,item)))
    30 
    31 (defmacro list-fill (sequence item start end)
    32   `(do ((current (nthcdr ,start ,sequence) (cdr current))
    33         (index ,start (1+ index)))
    34        ((or (atom current) (and end (= index ,end)))
    35         sequence)
    36      (rplaca current ,item)))
    37 
    38 (defun list-fill* (sequence item start end)
    39   (list-fill sequence item start end))
    40 
    41 (defun vector-fill* (sequence item start end)
    42   (when (null end) (setq end (length sequence)))
    43   (vector-fill sequence item start end))
     31(defun vector-fill (sequence item start end)
     32  (unless end
     33    (setf end (length sequence)))
     34  (do ((index start (1+ index)))
     35      ((= index end) sequence)
     36    (setf (aref sequence index) item)))
    4437
    4538(defun fill (sequence item &key (start 0) end)
    46   (if (listp sequence)
    47       (list-fill* sequence item start end)
    48       (vector-fill* sequence item start end)))
    49 
     39  (cond ((listp sequence)
     40         (list-fill sequence item start end))
     41        ((and (stringp sequence)
     42              (zerop start)
     43              (null end))
     44         (simple-string-fill sequence item))
     45        (t
     46         (vector-fill sequence item start end))))
Note: See TracChangeset for help on using the changeset viewer.