pattern-directed-let.lisp

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '(trivia prove)))

(defpackage #:pdl
  (:use #:cl #:trivia #:prove))

(in-package #:pdl)

;; Doesn't work for (x) case
(defmacro hb-let (vs &body forms)
  `(funcall #'(lambda ,(mapcar #'car vs) ,@forms) ,@(mapcar #'cadr vs)))

#+error(hb-let (x) x)

(let (x)
  (princ x))
#+expansion
(funcall (lambda (x) (princ x)) 1)

(defmacro pd-let* (bindings &body body)
  (match bindings
    (nil `(funcall (lambda () ,@body)))
    ((list* (list name value) rest) `(pd-let* ,rest
                                       (funcall (lambda (,name) ,@body) ,value)))
    ;; The guard is to prevent matching the form (x 1 3) and bind name to
    ;; (x 1 3) and rest to nil.
    ((guard (list* name rest)
            (symbolp name)) `(pd-let* ,rest
                          (funcall (lambda (,name) ,@body) nil)))
    (_ (error "Cannot recognize binding clause in pdl-let: ~A" bindings))))

(pd-let* ((x 1))
  (is x 1))

#+error(pd-let* ((x 1 3))
         (princ x))
;; Cannot recognize binding clause in pdl-let: ((X 1 3))
;;    [Condition of type SIMPLE-ERROR]

(pd-let* (x)
  (is x nil))

(pd-let* (x
         (y 2))
  (is x nil)
  (is y 2))

(defmacro pd-let (bindings &body body)
  `(%pd-let ,bindings () () ,@body))

(defmacro %pd-let (bindings names values &body body)
  (match bindings
    (nil `(funcall (lambda (,@names) ,@body) ,@values))
    ((list* (list name value) rest)
     `(%pd-let ,rest
               ,(cons name names)
               ,(cons value values)
        ,@body))
    ((guard (list* name rest)
            (symbolp name))
     `(%pd-let ,rest
               ,(cons name names)
               ,(cons nil values)
        ,@body))
    (_ (error "Cannot recognize binding clause in pdl-let: ~A" bindings))))

(pd-let ((x 1))
  (pd-let ((x 3)
           (y x))
    (is x 3)
    (is y 1)))