Better then loop/iterate?

(defpackage #:umac
  (:use #:common-lisp)
  (:export umac def-umac
	   values-default values-d
	   collecting appending summing until while force-return))

(in-package #:umac)

(defvar *have-umac-hash* (make-hash-table))

(defun first-match (list eql-to &optional (match-fun #'eql))
  (dolist (el list)
    (when (funcall match-fun el eql-to)
      (return el))))

(defun append-nonmatching (list appended &optional (match-fun #'eql))
  "Append elements of appended if match-fun returns false."
  (let (left)
    (dolist (a appended)
      (unless (first-match list a match-fun)
	(setf left `(,@left ,a))))
    (append list left)))

(defun delist (x) (if (listp x) (car x) x))

(defmacro setf- (change set &rest args)
  `(setf ,set (,change ,set ,@args)))

(defmacro umac ((&rest rest) &body body)
  "Umac allows you to make variables and functions/macros manipulating them
in one sentence.
Elements of rest are either references to extensions, or assoc-lists, when the \
latter, :let ->into let, :flet into flet, :mlet -> into macrolet, \
:smlet -> into symbol-macrolet, :post -> added behind the body."
  (let (got-let got-smlet got-flet got-mlet got-post)
    (do ((iter rest iter)) ((null iter) nil)
      (symbol-macrolet ((el (car iter)))
	(if (symbolp (car el)) ;If symbol get what the *have-umac-hash* provides.
	    ;Uses iterator as a 'stack' too.
	  (setf iter `(,(funcall (gethash (car el) *have-umac-hash*) el)
		       ,@(cdr iter)))
	  (flet ((append-nm (list append-key) ;Otherwise Just process it.
		   (append-nonmatching list (cdr (assoc append-key el))
				       (lambda (a b) (eql (delist a) (delist b))))))
	    (setf- append-nm got-let   :let)
	    (setf- append-nm got-smlet :smlet)
	    (setf- append-nm got-flet  :flet)
	    (setf- append-nm got-mlet  :mlet)
	    (setf- append-nm got-post  :post)
	    (setf- cdr iter)))))
    `(let (,@got-let)
     (symbol-macrolet (,@got-smlet)
     (flet ((values-default ()
	      ,(flet ((get-var (name)
			(when (first-match got-let name
				(lambda (el eql-to) (eql (delist el) eql-to)))
			  name)))
		 `(values ,(get-var 'ret)   ,(get-var 'val-0) ,(get-var 'val-1)
			  ,(get-var 'val-2) ,(get-var 'val-3) ,(get-var 'val-4)
			  ,(get-var 'val-5) ,(get-var 'val-6) ,(get-var 'val-7))))
            ,@got-flet)
     (macrolet ((values-d () (values-default))
		,@got-mlet)
       (do () (nil nil)
	 ,@body
	 ,@got-post)
       (values-default)))))))

(defmacro def-umac (name (&rest arguments) &body body)
  "Defines a umac for you. Return either an assoc-list, or a reference to\
 another extension, with arguments."
  (let ((args (gensym)) (self (gensym)) (gname (gensym))
	(docstr (when (stringp (car body)) (list (car body)))))
  `(let ((,gname ,name))
     (setf (gethash ,gname *have-umac-hash*)
	   (lambda (,args)
	     ,@docstr
	     (destructuring-bind (,self ,@arguments) ,args
	       (unless (eql ,self ,gname)
		 (error "First argument not repeat of have-umac"))
	       ,@(if docstr (cdr body) body)))))))

(in-package #:umac)

(def-umac :list (&optional (list-into 'ret) initial)
  "Listing stuff; collecting, appending"
  `((:let (,list-into ,initial))
    (:flet (collecting (&rest collected)
	     (setf- append ,list-into collected))
           (appending (&rest appended)
	     (dolist (el appended)
	       (setf- append ,list-into el))))))

(def-umac :sum (&optional (sum-onto 'ret) (initial 0))
  "Summing onto a variable; summing"
  `((:let  (,sum-onto ,initial))
    (:mlet (summing (&rest added)
	     `(setf- + ,',sum-onto ,@added)))))

(def-umac :ops (&optional (onto 'ret) initial)
  "Changing stuff with any operation."
  `((:let (,onto ,initial))
    (:mlet (op (op-name &rest args)
 		 `(setf- ,op-name ,,onto ,@args)))))

(def-umac :return ()
  "Returning; until, while. WARNING uses (return), will behave such!"
  `((:mlet (force-return (returned)
	      `(setf ret ,returned))
           (until (&rest and)
	     `(when (and ,@and) (return)))
	   (while (&rest and)
	     `(unless (and ,@and) (return))))))

(def-umac :single-round ()
  "Return after single run of umac. (Put at end!)"
  `((:post (return))))

(def-umac :for-list (var list &optional (end-cond :stop) (iter (gensym)))
  "An iterator over a list. Set end-cond to :continue to not stop when \
list runs out."
  `((:let   (,iter ,list)) (:smlet (,var (car ,iter)))
    (:post  (setf- cdr ,iter)
            ,@(case end-cond
	       (:continue nil)
	       (:stop `((when (null ,iter) (return))))))))

(umac ((:return) (:list) (:sum i))
  (until (> i 10))
  (summing 1)
  (collecting val-0))

(umac ((:list) (:for-list el (list 1 2 3 4 5 6 7 8)))
  (collecting (+ el 10)))

• DOTIMES, DORANGE (a simple macro to write)
• Built-in list or sequence manipulation: MAPCAR, MAPLIST, MAPCAN, MAPCON, MAPC, MAPL; MAP, REDUCE, COUNT (-IF, -IF-NOT), FIND, POSITION, SEARCH, REMOVE (-IF, -IF-NOT, -DUPLICATES), DELETE (-IF, -IF-NOT, -DUPLICATES), (N)SUBSTITUTE (-IF, -IF-NOT), MAP-INTO
• DOLIST
• Recursion (with tail call optimization)
• DO
• DO*

• dolist, dotimes.
• loop (which is pretty bad..)
• do (ok, but not too readable.)
• If i need a stack, recursively. (Unless a stack happens to fall in my lap, like the code in OP)

(defun add-1 (list)
  (umac ((:list) (:single-round)) (map nil (lambda (x) (collecting (+ x 1))))))

(defun consa (list add) '(,@list ,add))
(defun add-1 (list)
  (reduce (lambda (out el) (consa out (+ el 1)) list))

(defmacro for-list (el list &optional (iter (gensym))
  (post-body `(progn ,iter = (cdr ,iter) /*Add to post-body*/
                                (when (null iter) (finish)))) /*Stop at end of list.*/
  `(transparent-progn
      ,iter := ,list
      (def-symbol-macro ,el (car ,iter))))

(defmacro equip-listing (&optional (out-var 'ret)) /*Ret being default return.*/
  `(transparent-progn
      (collecting &rest args) := { (append ,out-var (list args)) }
      (appending &rest args) := { (append ,out-var args) }))

(add-list list &optional (add 1)) := 
  { (for-list el list) (equip-listing)   /*Make this scope one that iterates a list, and get stuff to collect with.*/
    (collecting (+ el add))
  }

(defun add-1 (list)
  (mapcar (lambda (x) (+ x 1)) list))

(iter:iter (:for i from 0 to 10) (print i))

(iter:iter (for i from 0 to 10) (print i))

(let ((list nil)
      (last nil))
  (flet ((collect (elt)
           (if list
               (setf list (list elt) last list)
               (setf (cdr last) (list elt)))))
    (dotimes (i 100)
      (collect i)))
  list)

(let ((list nil)
      (last nil))
  (flet ((collect (elt)
           (if (null list)
               (setf list (list elt) last list)
               (setf (cdr last) (list elt) last (cdr last)))))
    (dotimes (i 100)
      (collect i)))
  list)

gugamilare wrote:The thing I most like about iterate is that it macroexpands into very readable code

Jasper wrote:Implemented. I tried to get it to work for a list directly, but somehow (setf last (last last)) doesn't get it to work properly. I just did it by adding them one by one. I have (collecting &rest collected), instead of a single argument; i wouldn't know what to do with the rest of the arguments anyway.

(let ((list nil)
      (last nil))
  (flet ((collect (&rest elts)
           (if (null list)
               (setf list elts last list)
               (setf (cdr last) elts last (last elts)))))
    (dotimes (i 100)
      (collect i)))
  list)

(require :iterate)
(in-package #:iterate)

(defmacro for-range (var from to)
  `(for ,var from ,from to ,to))

(iter (for-range k 0 10)
      (collect k))

Jasper wrote:I guess loop is alright, but it is so damn ugly. It is a stranger in s-expression land. That, in itself is fine by me, but it is also unclear how to convert the thing into s-expressions.

findinglisp wrote:Well, LOOP is just one big sexpr.

• Extensible via regular macros and drivers. Would've been nice if they allowed 'regular macros' but only inside the iterate construct, since many of the macros wouldn't make sense outside anyway.
• The body of iter is a regular body. You can just write any code there if it doesn't collide with iters stuff.
• An advantage of looking through macroexpansion output is that you can put collector anywhere, including callbacks: iter can:

  (in-package #:iterate)
  (defun repeated (n fn) (dotimes (k n) (funcall fn n)))
  (iter (repeat 1)
        (repeated 5 (lambda (x) (collect x))))

  And loop cant:

  (loop repeat 1
    do (repeated 5 (lambda (x) (collect x))))

  So iterate can be used in callbacks. Very useful, imo. (I'd even make a (iter-once ..) for it.

• umac macroexpansion produces a whole bunch of stuff in let, flet, macrolet etc. that are not needed. It can't scan whether they are needed.
• Special stuff that creates toplevel stuff in flet, macrlet, etc. have to be in the list on top of the code. (Although one might not care, not going to read macroexpansion anyway.)
• It misses some features, many of these can still be fixed, but some not through extensions. Don't know how to do this one though. (Maybe prog and go)

(loop for elt in list
      (if elt (collect elt)))

(loop for elt in list
      if elt collect elt)

(loop for elt in list
      (case elt
        ((:foo :bar) (do-something-with elt)
        (nil nil)
        (t (collect elt))))

(iter (for list in lists)
      (mapcar #'(lambda (elt) (if elt (collect elt)))
              list))

Jasper wrote:

findinglisp wrote:Well, LOOP is just one big sexpr.

Well, without messing with the reader, i would have to be at least one, no?

I agree that much of my reaction to loop is esthetic/emotional, though. And i am also a novice in iterate. I know some real advantages though:
<<lots of good stuff deleted>>

findinglisp wrote:That said, LOOP is standard and documented, and you can always count on it being there. It certainly has limitations (the extensibility of ITERATE is very interesting, too), but a flawed standard is often better than a perfect extension in terms of creating a baseline for interoperability.

(loop for elt in list
     do (print elt)
     finally (return list))

gugamilare wrote:

findinglisp wrote:That said, LOOP is standard and documented, and you can always count on it being there. It certainly has limitations (the extensibility of ITERATE is very interesting, too), but a flawed standard is often better than a perfect extension in terms of creating a baseline for interoperability.

Well, I get your point, but don't completelly agree. Having one single implementation of iterate means it will work the same way everywhere. On the other hand, old implementations of clisp didn't support using loop keywords after do, like:

(loop for elt in list
     do (print elt)
     finally (return list))

I believe one "good" thing of loop being a standard is no dependencies. When I create a small library (like storable-functions), I don't like to make the user to install a library bigger than my library itself just to be "confortable". So I just use loop itself and, whenever I need to collect inside a mapcar, I let around a "with-collectors" macro (like arnesi's).

what iterate doc about higher order functions wrote:One problem with higher-order functions is that they are inefficient, requiring multiple calls on their argument function. While the the built-ins, like map and mapcar, can be open-coded, that cannot be so easily done for user-written functions. Also, using higher-order functions often results in the creation of intermediate sequences that could be avoided if the iteration were written out explicitly.

Jasper wrote:

what iterate doc about higher order functions wrote:One problem with higher-order functions is that they are inefficient, requiring multiple calls on their argument function. While the the built-ins, like map and mapcar, can be open-coded, that cannot be so easily done for user-written functions. Also, using higher-order functions often results in the creation of intermediate sequences that could be avoided if the iteration were written out explicitly.

Isn't that just untrue?

(reduce '+ (mapcar (lambda (x) (* x 2)) '(1 2 3 4)))

(reduce (lambda (x y) (+ x (* 2 y))) '(1 2 3 4) :initial-element 0)

(let ((list '(1 2 3 4)))
  (reduce '+ (map-into list (lambda (x) (* x 2)) list)))

gugamilare wrote:Reducing in place? Ok:

(reduce (lambda (x y) (+ x (* 2 y))) '(1 2 3 4) :initial-element 0)

what about this, then:

(let ((list '(1 2 3 4)))
  (reduce '+ (map-into list (lambda (x) (* x 2)) list)))

?

(let ((res 0)
  (map nil (lambda (x) (incf res (* x 2))) '(1 2 3 4)))
  res)

dmitry_vk wrote:but writing such transformations by hand is tedious.

(define-compiler-macro reduce (&whole whole fun list &key (start 0))
  (cond
    ((listp list)
     (case (car list)
       (mapcar ;Kill redundant list creation.
	(destructuring-bind (fun slist) (cdr list)
	  (let ((res (gensym)))
	    `(let ((,res 0))
	       (map nil (lambda (x)
			  (setf ,res (funcall ,fun x)))
		    ,slist)
	       ,res))))
       (t
	whole)))
    (t
     whole)))

(defmacro reduce-c (fun list &key (start 0))
  (cond
    ((listp list)
     (case (car list)
       (mapcar ;Kill redundant list creation.
	(destructuring-bind (fun slist) (cdr list)
	  (let ((res (gensym)))
	    `(let ((,res 0))
	       (map nil (lambda (x)
			  (setf ,res (funcall ,fun x)))
		    ,slist)
	       ,res))))
       (t
	`(reduce ,fun ,list :start ,start))))
    (t
     `(reduce ,fun ,list :start ,start))))

(reduce '+ (mapcar (lambda (x) (* x 2)) '(1 2 3 4)))

(reduce-c '+ (mapcar (lambda (x) (* x 2)) '(1 2 3 4)))

nuntius wrote:"The Anatomy of a Loop: A Story of Scope and Control" by Olin Shivers
http://www.international-lisp-conferenc ... ivers_olin

The paper can be found at
http://www.ccs.neu.edu/home/shivers/citations.html

Jasper wrote:

dmitry_vk wrote:but writing such transformations by hand is tedious.

This is lisp!
...
This needs to incorporate more &key arguments, and more killing of intermediate lists, from other sources, but it can work. I don't think define-compiler-macro is the most powerful optimalization technique that can exist in principle, but it is pretty good. (Do any non-lisp languages even have it?) As for testing, the reduce-c macro-equivalent does seem to work.

(reduce #'+ '(1 2 3 4) :key (lambda (x) (* 2 x)))

Ramarren wrote:SERIES package does fusion/deforestation for Common Lisp, although no one seems to be actually using it, possibly because it seems very Haskellish way to code. Although as far as I know Haskell doesn't do fusion by default, at least not in stable GHC?

Jasper wrote:I also tried to read the thesis nuntius posted, but i don't think i have the background knowledge to understand properly. Is it [url=http://en.wikipedia.org/wiki/Graph_theory]graph theory that i am missing?

Jasper wrote: Another thing that struck me is this tidbit of the manual. From here.

what iterate doc about higher order functions wrote:One problem with higher-order functions is that they are inefficient, requiring multiple calls on their argument function. While the the built-ins, like map and mapcar, can be open-coded, that cannot be so easily done for user-written functions. Also, using higher-order functions often results in the creation of intermediate sequences that could be avoided if the iteration were written out explicitly.

Isn't that just untrue? If the functions are constant or based on higher-order functions on constants, you should be able to expand them just as macros, with similar results. What i actually consider to be the use for iterate, is that it is more convenient. Especially in iterating while accumulating/collecting it can be very handy.

nuntius wrote:Yeah, Olin's paper isn't an easy read. From watching his talk, I gathered that it also requires a significant codebase to implement.

findinglisp wrote:Which part do you think might not be true, the first statement about not being able to open-code user-written functions or the second part about creating intermediate sequences?

• Look for funcalls, where did the argument for the funcall come from?
• A variable: See where variable came from, do one of below for what you find. (Might not be possible if turns out depending on non-constant functions, or if someone is iterating by changing a function or something like that, then again you can't compare with macros at that point; macros have no analogy except going through eval.) If used more then once, might want to expand into a local flet to let lisp decide whether to inline.
• (funcall (lambda(,@args) ,@body) ,@got-> expand to (let (,@(combine args got)) ,@body), and then repeat the looking for funcalls.
• (funcall (some-fun ,@args) ,@got) -> expand some-fun until you either find you can't, or find the final lambda. When latter do above.
• (funcall #',fun-name ,@got) and (funcall ',fun-name ,@got) Easy, (,fun-name ,@got)

Jasper wrote:What is open-coding exactly(sorry :p ) whatever it is, inlining achieves it.(Right?)

Maybe i should be more specific: The sequence to expand functions as function of functions:

• Look for funcalls, where did the argument for the funcall come from?
• A variable: See where variable came from, do one of below for what you find. (Might not be possible if turns out depending on non-constant functions, or if someone is iterating by changing a function or something like that, then again you can't compare with macros at that point; macros have no analogy except going through eval.) If used more then once, might want to expand into a local flet to let lisp decide whether to inline.
• (funcall (lambda(,@args) ,@body) ,@got-> expand to (let (,@(combine args got)) ,@body), and then repeat the looking for funcalls.
• (funcall (some-fun ,@args) ,@got) -> expand some-fun until you either find you can't, or find the final lambda. When latter do above.
• (funcall #',fun-name ,@got) and (funcall ',fun-name ,@got) Easy, (,fun-name ,@got)

Edit: I forgot mentioning functions taking arguments inside the function to be inlined, you can inline those aswel, using the same method.
I guess i have not covered apply yet.

As for user-written intermediate sequences, i don't know of anything that can be done about that, besides define-compiler-macros specific to the functions. To be honest, functions taking functions as arguments and having as their way of output what they return strikes me as the wrong way to do it, except for very simple stuff like lists. If your program is a little more complicated, you have to think about how to collect the data to return together. It is like connecting each of the houses to the powerplant individually. You wouldn't have to do that if you just let the function return nothing(or maybe some information it stumbles upon and would be wasteful to waste.), letting the callbacks do the work like collection.

• With a macro with a specific variable(of any *let) creation area. The umac this thread was begun with somewhat does that.(Looking at the source code, i see i didn't write it so it can fix (2) currently, easily fixed, and then it'll do it.) Advantages is clear distinction between variables and body, and separate namespace for 'macros to create variables'.(def-umac) You could make a with-slots for the umac, for instance. (maybe not so inferior to iterate after all.)
• An iterate-like approach, working in a scope-like manner. here the advantage is that regular macros can make variables. It likely needs a 'scope-transparant'
• Loop like approach, much like the iterate approach, but just with symbols(which also need to indicate regular body elements). Don't really like it. Nor do i know how to make it properly flexible. WITH somewhat does this.

(defmacro denest ((&rest args) &body body)
  (if (null args)
    `(progn ,@body)
    `(,@(car args)
      (denest (,@(cdr args)) ,@body))))

(defmacro summing ((&optional (initial 0) (onto (gensym))) &body body)
  `(let ((,onto ,initial))
     (macrolet ((sum (&rest summed)
		 (list 'setf ',onto (append (list '+ ',onto) summed)))) ;Too lazy to figure out how to backquote here.
       ,@body)
     ,onto))

(denest ((summing ())
	      (dolist (el (list 1 2 3 4))))
  (sum el))

Jasper wrote:I have been a little annoyed by this: Having flets, lets, macrolets and symbol-macrolets separate all the time has disadvantages.

1) More nested then need be, implying more parenthesis, more depth of indentation.

2) Sometimes need lets or flets in some specific order, causing more nesting.

So it might be better to use macros that create all these macros at the same time, and it seems to be the only disadvantage of that is that it punishes the user a little less when he doesn't create sub functions fast enough. I don't think that is worth it; programmers need to recognize that themselves anyway.

There are a bunch of ways to do this:

• With a macro with a specific variable(of any *let) creation area. The umac this thread was begun with somewhat does that.(Looking at the source code, i see i didn't write it so it can fix (2) currently, easily fixed, and then it'll do it.) Advantages is clear distinction between variables and body, and separate namespace for 'macros to create variables'.(def-umac) You could make a with-slots for the umac, for instance. (maybe not so inferior to iterate after all.)
• An iterate-like approach, working in a scope-like manner. here the advantage is that regular macros can make variables. It likely needs a 'scope-transparant'

(defmacro denest* ((&rest args) &body body)
  (if (null args)
    `(progn ,@body)
    `(,(caar args) (,@(cdar args)) ;Edit, made a silly mistake, forgot to change this to denest* too.
      (denest*(,@(cdr args)) ,@body))))

Jasper wrote: 2) Sometimes need lets or flets in some specific order, causing more nesting.

(denest ((collecting (nil list))
  	      (summing (0 a))
 	       (:return (values a list)) ;Override return of summing. (summing overrided that of collecting) does (return-from denest value)
	       (dolist (el (list 1 2 3 4))))
  (summing el)
  (collecting a))

(denest ((collecting ())
	       (:integer-block ((i 0 10) (j 0 10)) ()))
  (when (and (= i 5) (= j 5))
    (finish)) ;finish does (return-from denest-prev-ret), which then returns whatever that macro intended to return. (Unfortunately requires a block for that.)
  (collecting (list i j)))

dmitry_vk wrote:

Jasper wrote:I have been a little annoyed by this: Having flets, lets, macrolets and symbol-macrolets separate all the time has disadvantages.

1) More nested then need be, implying more parenthesis, more depth of indentation.

2) Sometimes need lets or flets in some specific order, causing more nesting.

So it might be better to use macros that create all these macros at the same time, and it seems to be the only disadvantage of that is that it punishes the user a little less when he doesn't create sub functions fast enough. I don't think that is worth it; programmers need to recognize that themselves anyway.

There are a bunch of ways to do this:

• With a macro with a specific variable(of any *let) creation area. The umac this thread was begun with somewhat does that.(Looking at the source code, i see i didn't write it so it can fix (2) currently, easily fixed, and then it'll do it.) Advantages is clear distinction between variables and body, and separate namespace for 'macros to create variables'.(def-umac) You could make a with-slots for the umac, for instance. (maybe not so inferior to iterate after all.)
• An iterate-like approach, working in a scope-like manner. here the advantage is that regular macros can make variables. It likely needs a 'scope-transparant'

There is a metabang-bind project. It does what you describe and is extensible.

(define-binder (:macro (name symbol) args decls body)
  `(,name ,@args ,@body))

• You have to explicitly 'import' macros.
• define-binder requires more learning then just making a regular macro and plugging it into denest, or using def-denest-macro for utilizing the keywords also. (def-denest-macro works just like defmacro, except the name must be a keyword, and it only works in denest or when using it via use-denest-macro.
• The arguments for let-star are limited to the form (var val) (Rather annoying when using the :macro like that.)

(defmacro denest (&rest forms)
  (if (null (cdr forms))
    (car forms)
    `(,@(car forms) (denest ,@(cdr forms)))))