;;; pan.lisp --- Pandoric macros

 ;;; Code:

 (in-package :std/macs)

 (in-readtable :std)

 (defun pandoriclet-get (letargs)

   `(case sym

      ,@(mapcar #`(((car ,a1)) (car ,a1))

         letargs)

      (t (error

          "Unknown pandoric get: ~a"

          sym))))

 (defun pandoriclet-set (letargs)

   `(case sym

      ,@(mapcar #`(((car ,a1))

                   (setq (car ,a1) val))

         letargs)

      (t (error

          "Unknown pandoric set: ~a"

          sym))))

 (defmacro pandoriclet (letargs &rest body)

   (let ((letargs (cons

                   (std/list:let-binding-transform

                    letargs))))

     `(let (,@letargs)

        ,@(butlast body)

        (dlambda

         (:pandoric-get (sym)

                        ,(pandoriclet-get letargs))

         (:pandoric-set (sym val)

                        ,(pandoriclet-set letargs))

         (t (&rest args)

 (declaim (inline get-pandoric))

 (defun get-pandoric (box sym)

   (funcall box :pandoric-get sym))

 (defsetf get-pandoric (box sym) (val)

   `(progn

      (funcall ,box :pandoric-set ,sym ,val)

      ,val))

 (defmacro! with-pandoric (syms o!box &rest body)

   `(symbol-macrolet

        (,@(mapcar #`(,a1 (get-pandoric ,g!box ,a1))

                   syms))

      ,@body))

 ;; (defun pandoric-hotpatch (box new)

 (defmacro pandoric-recode (vars box new)

 (defmacro plambda (largs pargs &rest body)

   (let ((pargs (mapcar #'list pargs)))

        (setq

               (:pandoric-get (sym)

                              ,(pandoriclet-get pargs))

               (:pandoric-set (sym val)

                              ,(pandoriclet-set pargs))

               (t (&rest args)

 (defvar pandoric-eval-tunnel)

 (defmacro pandoric-eval (vars expr)

   `(let ((pandoric-eval-tunnel

            (plambda () ,vars t)))

      (eval `(with-pandoric

               ,',vars pandoric-eval-tunnel

               ,,expr))))