Doing some templates

template.lisp

(defun encode-type (typename)
  (let ((str ""))
    (labels ((rec (name)
               (when name
                 (if (listp name)
                     (mapcar #'rec name)
                     (setf str (concatenate 'string str "-" (format nil "~s" name)))))))
      (rec typename)
      str)))


(defun node (&key element-type)
  (let ((name (intern (concatenate 'string "NODE" (encode-type element-type)))))
    (eval `(defclass ,name ()
             ((x :type ,element-type))))
    (make-instance name)))




;; Example
(defun tuple (&rest types)
  (let ((name (intern (apply #'concatenate 'string "TUPLE" (mapcar #'encode-type types)))))
    (eval `(progn
             (defstruct ,name
               ,@(loop :for type :in types
                       :for i :from 1
                       :collect `(,(intern (format nil "~:@(~r~)" i))
                                  ,(default type)
                                  :type ,type)))
             (deftype tuple (&rest types)
               ,name)))
    (funcall (intern (concatenate 'string "MAKE-" name)))))


(define-compiler-macro tuple (&whole form &rest types &environment env)
  (if (every (lambda (x) (constantp x env)) types)
      (let* ((typenames (mapcar (lambda (x) (sb-ext::eval-in-lexenv x env)) types))
             (name (intern (apply #'concatenate 'string "TUPLE" (mapcar #'encode-type typenames)))))
        (eval (print
                `(progn
                   (defstruct ,name
                     ,@(loop :for type :in typenames
                             :for i :from 1
                             :collect `(,(intern (format nil "~:@(~r~)" i))
                                        ,(default type)
                                        :type ,type)))
                   (deftype tuple (&rest types)
                     (intern (apply #'concatenate 'string "TUPLE" (mapcar #'encode-type types)))))))
        `(,(intern (concatenate 'string "MAKE-" (string name)))))
      form))


(defmacro tuple-match (names tuple &body body)
  `(symbol-macrolet ,(loop :for name :in names
                           :for i :from 1
                           :unless (eql name '_)
                             :collect `(,name (,(intern (format nil "TUPLE-~:@(~r~)" i)) ,tuple)))
     ,@body))

;; NOTE: this will not work as is due to tuple-names being horribly long. I coould either ask for a tuple type from the environment 
;; and generate a proper accessor (not worth it) or just use static-dispatch -- whcih is what we are working on.