[Openmcl-devel] Stupid unicode tricks (for Scheme fans only)

[Ron Garret]

If you don't like Scheme, ignore this message.

There's a hack at http://www.flownet.com/ron/lisp/nx1-combination-hook.lisp 
  that makes CCL treat ((...) ...) syntax in a Scheme-like manner,  
i.e. by transforming ((...) ...) into (funcall (...) ...).  (Actually,  
it runs through a macro expansion so you can customize this behavior.   
Examples in the code.)  Once you've done that, and with your unicode  
encoding set to utf-8, you can do this:


(defun flatten (l)
  (cond ((null l) l)
        ((atom l) (list l))
        (t (append (flatten (car l)) (flatten (cdr l))))))

(defun convert-args (args)
  (cond ( (null args) nil )
        ( (atom args) (list '&rest args) )
        (t (cons (car args) (convert-args (cdr args))))))

(defmacro λ (args &body body)
  (let ((args (remove-if (lambda (x) (eql #\& (elt (symbol-name x)  
0))) (flatten args))))
    `(lambda ,(convert-args args)
       (flet ,(mapcar (lambda (arg) `(,arg (&rest args) (apply ,arg  
args))) args)
         , at body))))

(defmacro define (name value)
  `(progn (setf ,name ,value) (defun ,name (&rest args) (apply ,name  
args))))


which in turn lets you do this:


(define Y (λ (f) ((λ (h) (λ (x) ((f (h h)) x))) (λ (h) (λ (x) ((f  
(h h)) x))))))

; or

(define Y (λ (f) ((λ (g) (g g)) (λ (h) (λ (x) ((f (h h)) x))))))


(define fact* (λ (f) (λ (n) (if (zerop n) 1 (* n (f (1- n)))))))

((Y fact*) 15)


which I thought was kinda cool, so I thought I'd share it.

rg