mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-04-27 11:40:45 -07:00
Code Issues Projects Releases Packages Wiki Activity

Simplified the code in seqlib.lsp, replacing (C[AD]R (TRULY-THE CONS ...)) with (CONS-C[AD]R ...)

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-11-30 10:37:29 +01:00
parent d4f3cab76f
commit 5f95206e67
1 changed files with 32 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

64
src/lsp/seqlib.lsp
View file

@ -83,12 +83,12 @@
(setf sequence output
end (- end start) start 0)))
(while (plusp start)
(setf sequence (cdr (truly-the cons sequence))
(setf sequence (cons-cdr sequence)
start (1- start)
end (1- end)))
(unless ivsp
(setf initial-value (key (car (truly-the cons sequence)))
sequence (cdr (truly-the cons sequence))
(setf initial-value (key (cons-car sequence))
sequence (cons-cdr sequence)
end (1- end)))
(do-sublist (elt sequence 0 end :output initial-value)
(setf initial-value
@ -220,13 +220,13 @@
(index 0))
(declare (fixnum index))
(while (and sequence (< index start))
(setf output (cons (car (truly-the cons sequence)) output)
sequence (cdr (truly-the cons sequence))
(setf output (cons (cons-car sequence) output)
sequence (cons-cdr sequence)
index (1+ index)))
(loop
(unless (< index end) (return))
(let ((elt (car (truly-the cons sequence))))
(setf sequence (cdr (truly-the cons sequence)))
(let ((elt (cons-car sequence)))
(setf sequence (cons-cdr sequence))
(if (compare which (key elt))
(when (zerop (decf %count))
(return))
@ -270,14 +270,14 @@
(declare (fixnum index)
(cons splice))
(while (and sequence (< index start))
(setf sequence (cdr (truly-the cons sequence))
splice (cdr (truly-the cons splice))
(setf sequence (cons-cdr sequence)
splice (cons-cdr splice)
index (1+ index)))
(loop
(unless (< index end)
(return))
(let ((elt (car (truly-the cons sequence))))
(setf sequence (cdr (truly-the cons sequence)))
(let ((elt (cons-car sequence)))
(setf sequence (cons-cdr sequence))
(cond ((compare which (key elt))
(setf (cdr splice) sequence)
(when (zerop (decf %count))
@ -467,8 +467,8 @@
(with-start-end (start end sequence)
(let* ((output nil))
(while (and sequence (plusp start))
(setf output (cons (car (truly-the cons sequence)) output)
sequence (cdr (truly-the cons sequence))
(setf output (cons (cons-car sequence) output)
sequence (cons-cdr sequence)
start (1- start)
end (1- end)))
(let ((start sequence)
@ -480,26 +480,26 @@
;; 2) otherwise, return T only when there are no duplicates
;; after the current one.
(flet ((already-in-list-p (start current end from-end)
(let ((elt (key (car (truly-the cons current)))))
(let ((elt (key (cons-car current))))
(if from-end
(loop
(when (eq start current)
(return nil))
(when (compare elt (key (car (truly-the cons start))))
(when (compare elt (key (cons-car start)))
(return t))
(setf start (cdr (truly-the cons start))))
(setf start (cons-cdr start)))
(loop
(setf current (cdr (truly-the cons current)))
(setf current (cons-cdr current))
(when (eq current end)
(return nil))
(when (compare elt (key (car (truly-the cons current))))
(when (compare elt (key (cons-car current)))
(return t)))))))
(loop
(when (eq sequence end)
(return (nreconc output sequence)))
(unless (already-in-list-p start sequence end from-end)
(push (car (truly-the cons sequence)) output))
(setf sequence (cdr (truly-the cons sequence))))))))))
(push (cons-car sequence) output))
(setf sequence (cons-cdr sequence)))))))))
(defun remove-duplicates (sequence
&key test test-not from-end (start 0) end key)
@ -530,36 +530,36 @@ Returns a copy of SEQUENCE without duplicated elements."
(let* ((splice (cons nil sequence))
(output splice))
(while (and sequence (plusp start))
(setf splice (cdr (truly-the cons splice))
sequence (cdr (truly-the cons sequence))
(setf splice (cons-cdr splice)
sequence (cons-cdr sequence)
start (1- start)
end (1- end)))
(let ((start splice)
(end (nthcdr (- end start) sequence)))
(flet ((already-in-list-p (start current end from-end)
(let ((elt (key (car (truly-the cons current)))))
(let ((elt (key (cons-car current))))
(if from-end
(loop
(when (eq start current)
(return nil))
(when (compare elt (key (car (truly-the cons start))))
(when (compare elt (key (cons-car start)))
(return t))
(setf start (cdr (truly-the cons start))))
(setf start (cons-cdr start)))
(loop
(setf current (cdr (truly-the cons current)))
(setf current (cons-cdr current))
(when (eq current end)
(return nil))
(when (compare elt (key (car (truly-the cons current))))
(when (compare elt (key (cons-car current)))
(return t)))))))
(loop
(when (eq sequence end)
(return (cdr (truly-the cons output))))
(if (already-in-list-p (cdr (truly-the cons start))
(return (cons-cdr output)))
(if (already-in-list-p (cons-cdr start)
sequence end from-end)
(setf sequence (cdr (truly-the cons sequence))
(setf sequence (cons-cdr sequence)
(cdr splice) sequence)
(setf sequence (cdr (truly-the cons sequence))
splice (cdr (truly-the cons splice)))))))))))
(setf sequence (cons-cdr sequence)
splice (cons-cdr splice))))))))))
(defun filter-duplicates-vector (out in start end from-end test test-not key)
(with-tests (test test-not key)