[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: 'let' for functions ?
From: |
Ed L Cashin |
Subject: |
Re: 'let' for functions ? |
Date: |
Sat, 26 Apr 2003 16:20:28 -0400 |
User-agent: |
Gnus/5.090014 (Oort Gnus v0.14) Emacs/21.2 (i386-debian-linux-gnu) |
Oliver Scholz <alkibiades@gmx.de> writes:
> Ed L Cashin <ecashin@uga.edu> writes:
> [...]
>> As an exercise I tried in vain to create a simple implementation of
>> labels that wouldn't require loading cl. I couldn't do it, though,
>> and had to get on with what I was supposed to be doing. ;)
...
> I am not a Lisp-Guru, but here is my version anyways. I'd like to hear
> whether there is any problem with this approach:
>
> (defmacro my-simple-labels (spec &rest body)
> ;; We `fset' the symbols temporarily and restore the original state
> ;; after the body form was executed.
> (let ((symbol (make-symbol "symbol"))
> (definition (make-symbol "definition"))
> (sfunc (make-symbol "sfunc")))
> `(progn
> (let (,symbol)
> (dolist (,definition ',spec)
> (setq ,symbol (car ,definition))
> ;; Store function definition, if necessary.
> (when (fboundp ,symbol)
> (put ,symbol 'my-simple-labels (symbol-function ,symbol)))
> ;; New function definition.
> (fset ,symbol (cons 'lambda (cdr ,definition)))))
> (unwind-protect (progn ,@body)
> ;; Clean-up
> (let (,sfunc)
> (dolist (,symbol ',(mapcar 'car spec))
> (setq ,sfunc (get ,symbol 'my-simple-labels))
> (if ,sfunc
> (fset ,symbol ,sfunc)
> (fmakunbound ,symbol))))))))
Hey, wow. (And you claim not to be a lisp guru! ;)
It seems to work well for these two tests: recursion and mutual
recursion.
(my-simple-labels
((f (s n)
(if (> n 0)
(progn
(insert (format "s: %s\n" s))
(f s (1- n))))))
(f "hi" 4))
Inserts "s: hi\n" four times.
(my-simple-labels
((f (s n)
(if (> n 0)
(progn
(insert (format "f: %s\n" s))
(g s (1- n)))))
(g (s n)
(if (> n 0)
(progn
(insert (format "g: %s\n" s))
(f s (1- n))))))
(f "hi" 4))
Inserts "f: hi\n" and "g: hi\n" alternately, twice each.
--
--Ed L Cashin PGP public key: http://noserose.net/e/pgp/