Page 1 of 5

Better then loop/iterate?

Posted: Mon Mar 16, 2009 1:55 pm
by Jasper
Update: I made a little project on Berlios I don't expect to work on much, though. The dayly tarball hasn't come yet,(as of 20-3-'09) btw.

As i have said a couple of times, i have been messing with making a loop-like micro. Loop itself is not that good; not being lispy. Iterate improves, but 'for .. in ..' sort of notation seems silly to me. (I'd have done it for-in .. ..)

So i messed around making a loop thing for myself. I noted that one important thing iteration does is create variables for the user that are implicit, and which are then used either to collect something or to recurse over something. Symbol-macrolets and macrolet are useful in this too. Also, sometimes you want the 'incrementation' to be after the body, implicitly.
And it should also be extensible, of course. (And usually this means any of the keywords in it should be defined via the normal extending way.)

At first i made a lot of stuff i threw away later, firstly because the loop had its own language separate from common-lisp, and it irked me to have to redo even the simple stuff like: when, cond, unless, secondly because parsing the common lisp language for stuff that implied variables was a simply bad idea. Finally i landed on what i will be posting here.

Basically now what you enter the looping macro consists of two parts, the one from which the information in a let, symbol-macrolet, flet, macrolet, and the things that have to go after the main body are gathered, and the main body, which can use all those. So here is the code: (less then 100 lines of code dunno how to let mac count 'em. Anyway, might want to copy it to an editor for better readability.)

Code: Select all

(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)))))))
Here is how it works: The thing that determines what is in the *let's is a list of association lists with different names referring them. :post refers to stuff that has to go after the body.
If the first element is a symbol rather then an association list, that means that an extension is used, and extension is just a function with some arguments, that produces the association lists as described before. Extensions may also refer to other extensions.(I just noticed, that it may only be one other, but i guess an extension could probably fix it.)
Finally, the whole thing returns the following variables, nil if they do not exist: (values ret val-0 val-1 val-2 ...

Here are some basic extensions.(They don't have to be bound to keywords, of course!)

Code: Select all

(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))))))))
And some usage, of course: collecting numbers.(Hmm should've made a :repeat.. annoying to develop on other computer then you post with)

Code: Select all

(umac ((:return) (:list) (:sum i))
  (until (> i 10))
  (summing 1)
  (collecting val-0))
New list, adding ten to old list.

Code: Select all

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

Re: Better then loop/iterate?

Posted: Mon Mar 16, 2009 4:24 pm
by Harleqin
When I have to do something "loopy", I look for a fitting language construct in Common Lisp in roughly the following order:
  • 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*
Of course, it is always nice to have another tool in the box. About where in this list would you put your construct?

Re: Better then loop/iterate?

Posted: Tue Mar 17, 2009 4:35 am
by Jasper
It might be crappy but this is currently pretty much the sequence. My attitude is a little like 'just do it damit'
  • 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)
The ones based on functions seemed a little weirdly named. Also, when you collect stuff in some way, like summing, consing, appending, working with a stream, etcetera, it would seem better to let the callback do the work, because otherwise the function with function as argument has to gather all the stuff internally, and every different way would need it's own implementation. Unless you provide functions to specify how it, but that would make it a bit more complicated to use.

If you use callbacks to gather, you only need to have different functions for different ways of iterating. This is btw another advantage of this way over loop and iter, you can do: (Should've called :single-round \:once..) (all untested)

Code: Select all

(defun add-1 (list)
  (umac ((:list) (:single-round)) (map nil (lambda (x) (collecting (+ x 1))))))
Hmm, i don't think that is best, maybe instead of the multitude of map* functions, use reduce?

Code: Select all

(defun consa (list add) '(,@list ,add))
(defun add-1 (list)
  (reduce (lambda (out el) (consa out (+ el 1)) list))
Here i find myself wishing i could make the lambda with a stack language: '1 + consa' would produce that. I guess that wouldn't be readable enough either though. Or do the lambda cheaper ($ (consa $1 (+ $2 1)), but also a little bit dense..

I have thought about higher functions, like when i thought about having (not function) be equivalent to (lambda (&rest rest) (not (function @rest))), or if there is spillover: (f-a f-b) eqv to (lambda ([stuff of f-b] [stuff of f-a]) (f-a (f-b [stuff of f-b]) [stuff-of-f-a])). Maybe i should make a little macro, maybe instead (ho () f-a f-b) can do that, or even (ho (f-d) f-a f-b f-c), that would make reduce look a lot more attractive.(f-d being arguments before f-a f-b f-c, etc. Ah shit i don't really see how to do the lambda in the defun right now. I need to think about this more.
With this stuff using functions taking functions as arguments would be much more attractive, not having to have (lambda (arguments) ..) floating around everywhere.

The umac macro i made here makes me doubt. Lets ask the question how we would make a lisp that does this with regular macros. I'd do it with scope; defvars, defun, defmacro, defsymbol-macro limited to the bodies of progn, lambda, etc. You could do pretty the thing i did with umac by having a scope-transparent-progn, and making the macro output a scope-transparent-progn have the defvars etc. in it. But then i ask of myself why still have a let, flet, macrolet?

Somewhat relatedly, i am also doubting whether s-expressions are really the way we should write everything. Sure, what we write should trivially be converted to s-expressions, but there is a lot that does that. not~expr -> (not expr) for single-argumented functions and numerically, a + b -> (+ a b), same for *, etc. would need to work out precidence.
The thing here that is related that we could write (def symbol expr) for a variable and (def (fun-name arguments) (progn body)) for functions, now we can think about scoping and call {...} (progn ...) and a := b (def a b), and we would get functions written more like ocaml or something.

Code: Select all

(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))
  }
That might not look very lispy, but the layer of veneer on the s-expressions is very thin. (Note that definining functions with := only has an expression, not a body; you need to either use {} to get a body.) It kills a tonne of hooks, even more could be removed with this idea but i decided not to overload it with too many ideas.

Re: Better then loop/iterate?

Posted: Tue Mar 17, 2009 5:31 am
by Harleqin

Code: Select all

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

Re: Better then loop/iterate?

Posted: Tue Mar 17, 2009 9:20 am
by gugamilare
I hate loop and love iterate. One problem (which is mostly not a big deal) is that iterate sometimes does not respect order of the computation (I do not have examples of this right now), but it works quite well. The only big problem with iterate is that the symbols you have to use are the ones exported from iterate package. You cannot, for instance,

Code: Select all

(iter:iter (:for i from 0 to 10) (print i))
You can't even

Code: Select all

(iter:iter (for i from 0 to 10) (print i))
unless the package :iter is being used (i.e. with (use-package :iter)). I would prefer to be able to use keywords instead.

The thing I most like about iterate is that it macroexpands into very readable code (except that it macroexpands every macro being used in the body of the loop) - SBCL's loop macroexpansion, for instance, is a nightmare. Iter also has the advantage of not doing function calls whenever they are not needed (of flets) - it creates just lexical bindings.

By the way, one performance hint. Collecting elements into a list does not need to walk into the list until the last position. You can explicitly create a collector this way:

Code: Select all

(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)

Re: Better then loop/iterate?

Posted: Tue Mar 17, 2009 3:20 pm
by Jasper
@Harleqin: I get it, keep it simple, stupid :) I went a little crazy with alternative syntax. Might be a good way to attract people that are crazy with syntax, or hate parentheses to lisp though..

I agree just by comparing loop with the docs of iterate that the latter is superior. It also looks like i underestimated iterate, according to that, iterate actually can read normal macros, actually expanding them to look inside. I had thought of that, but wanted to take an easy route after all that mucking about.

Unless there are some other snags, iterate is probably much better then what i made. I think i will just finish what i have. (I already removed that silly assoc list.) Even the problem of having to use the package doesn't seem very important. They're probably not keywords because some of them are regular macros, and they didn't want to be inconsistent.

Thanks for the hint, I don't get it though. List starts nil, whenever collect is called, the second clause is called, only affecting last, so list stays nil.. Also what i already got seems straightforward enough.

Re: Better then loop/iterate?

Posted: Tue Mar 17, 2009 5:05 pm
by gugamilare
Hum, I had fixed that, but copied the wrong version. Basically, it works with 2 variables, the "list" itself and "last", which is analogous to (last list) (i.e. if you call (last list) you obtain the same value which last is bound to)..

Code: Select all

(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)

Re: Better then loop/iterate?

Posted: Wed Mar 18, 2009 5:43 pm
by Jasper
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. The specification that we are listing already also specifies a variable to list into. Hmm, maybe next to a :list i need a :list-into extension..

Spotted a disadvantage with the optimization, other extensions which do not play well with the 'last variable, break it. And currently they can't work well with it; 'last is a gensym. Added a function fix-list that sets last correctly.
gugamilare wrote:The thing I most like about iterate is that it macroexpands into very readable code
I can't make umac do this, not if i don't look into the body to see if the flets/macrolets etc. are actually used. At least excess unused variables/flets shouldn't make.

I think i will put it online somewhere under the public domain, as a small 'you see what you do with this, please try iterate first' thing.

Re: Better then loop/iterate?

Posted: Wed Mar 18, 2009 7:20 pm
by gugamilare
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.

Code: Select all

(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)
This should do for multiple arguments.

Re: Better then loop/iterate?

Posted: Wed Mar 18, 2009 11:12 pm
by findinglisp
Call me old-fashioned... I just use LOOP. :shock: Like everybody else, I reach for DOLIST and DOTIMES for the simple stuff, as well as MAPCAR and friends for that type of work, but then it's pretty much straight to LOOP for everything else.

That said, I'm interested in ITERATE. That seems close to LOOP but helpful for curing some of the general LOOP annoyances, as well as being extensible.