;;;-*- Mode: Lisp; Package: UTILS -*-

(in-package :utils)

#+ignore
(eval-when (:compile-toplevel :load-toplevel :execute)
  (export '(collecting collect collect-append inca)))

#||
Even better is to decouple COLLECT from LOOP altogether. Just the
same way as PROG has been successully split into LET, BLOCK and
TAGBODY, the COLLECT part can be taken out from LOOP. This has the
added benefit that it can be used without any looping.

   > (collecting
       (collect 'foo)
       (collect 'bar))
   (FOO BAR)

   > (collecting
       (collect 'foo)
       (loop for i from 1 to 10 do (collect i))
       (collect 'end))
   (FOO 1 2 3 4 5 6 7 8 9 10 END)

> but the problem THEN becomes the code-walking needed to do to find
> that the body actually contains a COLLECT form so you know to generate
> the bound variables it will need.

Not at all. Every time you think you need a code walker, MACROLET is the
answer. Here is an implementation of COLLECTING and COLLECT.

                  Bruno Haible
||#

#+old
(defmacro collecting (&body forms)
  (let ((a (gensym))
        (b (gensym))
        (c (gensym)))
    `(let ((,a nil) (,b nil))
       (macrolet ((collect (form)
                    `((lambda (,',c)
                        (if ,',a
                          (setf (cdr ,',b) (setf ,',b ,',c))
                          (setf ,',a (setf ,',b ,',c))))
                      (list ,form))))
         (progn ,@forms)
         ,a ))))

(defmacro collecting (&body forms)
  (let ((a (gensym))
        (b (gensym))
        (c (gensym))
        (f (gensym)))
    `(let ((,a nil) (,b nil))
       (macrolet ((collect (form)
                    `((lambda (,',c)
                        (if ,',a
                          (setf (cdr ,',b) (setf ,',b ,',c))
                          (setf ,',a (setf ,',b ,',c))))
                      (list ,form)))
                  (collect-append (form)
                    `(mapc (lambda (,',c)
                             (let ((,',f (list ,',c)))
                               (if ,',a
                                   (setf (cdr ,',b) (setf ,',b ,',f))
                                 (setf ,',a (setf ,',b ,',f)))))
                       ,form)))
         (progn ,@forms)
         ,a))))

#+test
(collecting
 (loop for x on '(1 2 3 4)
       do (collect-append (list x))))

(defmacro collect (form)
  (declare (ignore form))
  (error "collect used outside of collecting"))

(defmacro collect-append (form)
  (declare (ignore form))
  (error "collect-append used outside of collecting"))

;; add collect-new!

;;;;;;;; -------------------

(defmacro collecting-into (vars &body forms)
  (let ((b (gensym "B-"))
        (c (gensym "C-"))
	(f (gensym "F-")))
    `(let ((,b nil)
	   ,@(mapcar (lambda (var)
		       `(,var nil))
		     vars))
       (macrolet ((collect-into (var form)
		    `((lambda (,',c)
			(if ,var
			    (setf (cdr (getf ,',b ',var)) (setf (getf ,',b ',var) ,',c))
			  (setf ,var (setf (getf ,',b ',var) ,',c))))
		      (list ,form)))
		  (collect-append-to (var form)
                    `(mapc (lambda (,',c)
                             (let ((,',f (list ,',c)))
                               (if ,var
                                   (setf (cdr (getf ,',b ',var)) (setf (getf ,',b ',var) ,',f))
				   (setf ,var (setf (getf ,',b ',var) ,',f)))))
                       ,form)))
         (progn ,@forms)))))

(defmacro collect-into (var form)
  (declare (ignore var form))
  (error "collect used outside of collecting"))

(defmacro collect-append-to (var form)
  (declare (ignore var form))
  (error "collect-append used outside of collecting"))

#+test
(collecting-into (a b)
  (loop for x in '(1 2 3 4)
	do (collect-into a x)
	(collect-into b (- x)))
  (collect-append-to a '("a" "b" "c"))
  (collect-into a 9)
  (print (list a b)))

;;----- other macros

(defmacro with-gensyms ((&rest vars) &body body)
  (let ((bindings (mapcar (lambda (var)
			    `(,var (gensym)))
			  vars)))
    `(let ,bindings ,@body)))

#-lispworks
(defmacro when-let ((value form) &body body)
  `(let ((,value ,form))
     (when ,value ,@body)))  

(defmacro if-let ((value form) &body body)
  `(let ((,value ,form))
     (if ,value ,@body)))

(defmacro min-or-nil (&rest numbers-or-nil)
  (let ((numbers (gensym)))
    `(let ((,numbers (delete-if #'not (list ,@numbers-or-nil))))
       (when ,numbers
         (reduce #'min ,numbers)))))

(defmacro string-member (string list-of-strings)
  `(member ,string ,list-of-strings :test 'string=))

(defmacro string-member-equal (string list-of-strings)
  `(member ,string ,list-of-strings :test 'string-equal))

(defmacro find-equal (item sequence)
  `(find ,item ,sequence :test 'equal))

; increment after
(defmacro inca (place &optional (increment 1))
  (let ((val (gensym)))
    `(let ((,val ,place))
       (prog1 ,val (setf ,place (+ ,val ,increment))))))

(defmacro ncat (string-var &rest strings)
  `(setf ,string-var
         ,(append
           (list `concatenate `(quote string))
           (list string-var)
           strings)))

(defmacro ncat-with-prefix (string-var prefix &rest strings)
  `(if (string= ,string-var "")
     (setf ,string-var
           ,(append
             (list `concatenate `(quote string))
             (list string-var)
             strings))
     (setf ,string-var
           ,(append
             (list `concatenate `(quote string))
             (list string-var)
             (list prefix)
             strings))))

(defmacro concat (&rest strings)
  `(concatenate 'string ,@strings))

(defmacro string-starts-with-p (str start-str)
  (let ((len (gensym))
        (sub-len (gensym)))
    `(let ((,len (length ,str))
           (,sub-len (length ,start-str)))
       (and (<= ,sub-len ,len)
            (string= ,str ,start-str :end1 ,sub-len)))))

(defmacro string-ends-with-p (str end-str)
  (let ((len (gensym))
        (sub-len (gensym)))
    `(let ((,len (length ,str))
           (,sub-len (length ,end-str)))
       (and (<= ,sub-len ,len)
            (string= ,str ,end-str :start1 (- ,len ,sub-len))))))

(defmacro trim-ends (string)
  (let ((length (gensym)))
    `(let ((,length (length ,string)))
       (if (> ,length 1)
         (subseq ,string 1 (1- ,length))
         ""))))

(defmacro trim-last (string)
  (let ((length (gensym)))
    `(let ((,length (length ,string)))
       (if (> ,length 1)
         (subseq ,string 0 (1- ,length))
         ""))))

(defmacro with-stream-lines ((stream line) &body body)
  `(let (,line)
     (loop do (setf ,line (read-line ,stream nil :eof))
           until (eq ,line :eof)
           do
           ,@body)))

(defmacro with-file-lines ((line path &key
				 #+sbcl(external-format sb-impl::*default-external-format*)
				 #+allegro(external-format excl::*default-external-format*))
			   &body body)
  (let ((stream (gensym)))
    `(with-open-file (,stream ,path #-mcl :external-format #-mcl ,external-format)
      (with-stream-lines (,stream ,line)
	,@body))))

:eof