mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-15 09:20:23 -07:00
Code Issues Projects Releases Packages Wiki Activity

Split out the sequence macros into a separate file

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-20 12:41:38 +02:00
parent ec0ddc1174
commit 4ce6c85438
2 changed files with 56 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

38
src/lsp/seqlib.lsp
View file

@ -12,9 +12,12 @@
;;;; sequence routines
(in-package "SYSTEM")
#+ecl-min
(eval-when (:execute)
(load (merge-pathnames "seqmacros.lsp" *load-truename*)))
(defun seqtype (sequence)
(declare (si::c-local))
(cond ((listp sequence) 'list)
@ -33,39 +36,6 @@
(optimize (speed 3) (safety 0)))
(funcall f x))
(eval-when (:compile-toplevel :execute)
(defmacro with-predicate ((predicate) &body body)
`(let ((,predicate (si::coerce-to-function ,predicate)))
(macrolet ((,predicate (&rest args)
`(locally (declare (optimize (safety 0) (speed 3)))
(funcall (the function ,',predicate) ,@args))))
,@body)))
(defmacro with-key ((akey) &body body)
`(let ((,akey (if ,akey (si::coerce-to-function ,akey) #'identity)))
(macrolet ((,akey (value)
`(locally (declare (optimize (safety 0) (speed 3)))
(funcall (the function ,',akey) ,value))))
,@body)))
(defmacro with-tests (&whole whole (test test-not &optional key) &body body)
(when key
(setf body `((with-key (,key) ,@body))))
`(let ((,test (if ,test (si::coerce-to-function ,test)))
(,test-not (if ,test-not (si::coerce-to-function ,test-not))))
(and test test-not (test-error))
(macrolet ((compare (v1 v2)
`(locally (declare (optimize (safety 0) (speed 3)))
(cond (test (funcall (the function test) ,v1 ,v2))
(test-not (not (funcall (the function test-not)
,v1 ,v2)))
(t (eql ,v1 ,v2))))
))
,@body)))
(defmacro with-start-end (start end seq &body body)
`(multiple-value-bind (,start ,end)
(sequence-start-end 'subseq ,seq ,start ,end)
(declare (fixnum ,start ,end))
,@body)))
(defun reduce (function sequence
&key from-end
(start 0)

52
src/lsp/seqmacros.lsp Normal file
View file

@ -0,0 +1,52 @@
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SYSTEM -*-
;;;;
;;;; Copyright (c) 2010, Juan Jose Garcia-Ripoll
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Library General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later version.
;;;;
;;;; See file '../Copyright' for full details.
;;;;
;;;; SEQMACROS -- Macros that are used to expand sequence routines
;;;;
(in-package "SYSTEM")
(defmacro with-predicate ((predicate) &body body)
`(let ((,predicate (si::coerce-to-function ,predicate)))
(macrolet ((,predicate (&rest args)
`(locally (declare (optimize (safety 0) (speed 3)))
(funcall (the function ,',predicate) ,@args))))
,@body)))
(defmacro with-key ((akey) &body body)
`(let ((,akey (if ,akey (si::coerce-to-function ,akey) #'identity)))
(macrolet ((,akey (value)
`(locally (declare (optimize (safety 0) (speed 3)))
(funcall (the function ,',akey) ,value))))
,@body)))
(defmacro with-tests (&whole whole (test test-not &optional key) &body body)
(when key
(setf body `((with-key (,key) ,@body))))
`(let ((,test (if ,test (si::coerce-to-function ,test)))
(,test-not (if ,test-not (si::coerce-to-function ,test-not))))
(and test test-not (test-error))
(macrolet ((compare (v1 v2)
`(locally (declare (optimize (safety 0) (speed 3)))
(cond (test (funcall (the function test) ,v1 ,v2))
(test-not (not (funcall (the function test-not)
,v1 ,v2)))
(t (eql ,v1 ,v2))))
))
,@body)))
(defmacro with-start-end (start end seq &body body)
`(multiple-value-bind (,start ,end)
(sequence-start-end 'subseq ,seq ,start ,end)
(declare (fixnum ,start ,end))
,@body))