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)))))))
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))))))))
Code: Select all
(umac ((:return) (:list) (:sum i))
(until (> i 10))
(summing 1)
(collecting val-0))
Code: Select all
(umac ((:list) (:for-list el (list 1 2 3 4 5 6 7 8)))
(collecting (+ el 10)))