goo-compat.lisp

gistfile1.el

;;  5:37am Tuesday,28 October 2008
(defpackage :goo (:use :cl :compat-utils))

(in-package :goo)

(defmacro op (fn &rest args)
  `(lambda (_) (,fn ,@args)))

(defalias d. cl:defconstant)
(defalias dv cl:defvar)
;; def
;; let -> let*
;; set
;; use
;; export
;; use/export
;(defalias seq cl:progn)
(defmacro seq (&body body)
  `(progn ,@body))
;; {}
;; if
;; and
;; or
;; unless
;; when
;; cond
;; case
;; (CASE[-BY] ,value [ ,test ]((,@keys) ,@body) ...)

(define-macro-helper *case-by-to-cond (value fn clause)
  (destructuring-bind (keys &rest body) clause
    (if (consp keys)
        `((member (funcall ,fn ,value) ',keys) ,@body)
        `((eql (funcall ,fn ,value) ',keys) ,@body))))

(defmacro case-by (value test &rest clauses)
  (let ((/value (gensym)))
    `(let ((,/value ,value))
       (cond ,@(mapcar (lambda (x)
                         (*case-by-to-cond /value test x))
                       clauses)))))

(define-macro-helper split-by-def (expr)
  (do ((x expr (cdr x))
       ans)
      ((endp x) (nreverse ans))
    (destructuring-bind (head &rest tail) x
      (if (consp head)
          (if (string-equal 'def (car head))
              (return
                (nreverse 
                 (push (if (and (consp (cadr head))
                                (string-equal 'tup (caadr head)))
                           (let ((tup (cadr head)))
                             `(multiple-value-bind ,(cdr tup) ,(caddr head)
                                ,@(split-by-def tail)))
                           `(let (,(cdar x))
                              ,@(split-by-def tail)))
                       ans)))
              (push (split-by-def head) ans))
          (push head ans)))))

;; with-defをseqにしてしまうというのが良いアイディアに思える
;; がその場合、seqは一回しか展開されないように、入れ子を排除
;; する必要がある。面倒なのでwith-defとしてしまっている。

(defmacro with-def (&body body)
  `(progn
     ,@(split-by-def body)))

#|(with-def 
  (def x 3)
  x
  (def (tup x y) (values x 4))
  (list x y))|#

(defmacro df (name arg &body body)
  `(defun ,name ,arg
     (with-def
       ,@body)))


#|(df fib (n)
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))|#

#|(df hello (n)
  (def x (list n n))
  x)|#

#|(df hello (list.list sym.symbol => list)
  )|#