An example of datastructure with dispatch, very much alpha version

double-linked-list-dispatched.lisp

(ql:quickload 'adhoc-polymorphic-functions)
(use-package :adhoc-polymorphic-functions)


;(define-polymorphic-function make (type size))  ;;This one is harder that you might think
(define-polymorphic-function push-front (data container))
(define-polymorphic-function push-back (data container))
(define-polymorphic-function pop-front (container))
(define-polymorphic-function pop-back (container))
(define-polymorphic-function size (container))
(define-polymorphic-function empty-p (container))

(defmacro define-double-linked-list (type default)
  (let* ((node (intern (concatenate 'string        "NODE-" (string type))))
         (make-node (intern (concatenate 'string   "MAKE-" (string node))))
         (node-data (intern (concatenate 'string   (string node) "-DATA")))
         (node-next (intern (concatenate 'string   (string node) "-NEXT")))
         (node-prev (intern (concatenate 'string   (string node) "-PREV")))
         (dl-list (intern (concatenate 'string    "DL-LIST-" (string type))))
         (dl-list-anchor (intern (concatenate 'string (string dl-list) "-ANCHOR")))
         (make-dl-list (intern (concatenate 'string  "MAKE-" (string dl-list))))
         (%make-dl-list (intern (concatenate 'string  "%MAKE-" (string dl-list)))))
    `(progn
       (defstruct ,node
         (prev nil :type (or ,node null))
         (data ,default :type ,type)
         (next nil :type (or ,node null)))


       (defstruct ,dl-list
         (anchor (,make-node) :type ,node))

       (deftype dl-list (typename) (intern (concatenate 'string "DL-LIST-" (string typename))))

       (defpolymorph push-front ((data ,type) (dl-list (dl-list ,type))) ,type
         (let* ((anchor (,dl-list-anchor dl-list))
                (current (,node-next anchor))
                (new-node (,make-node :data data :prev anchor :next current)))
           (setf (,node-prev current) new-node
                 (,node-next anchor) new-node)
           data))

       (defpolymorph push-back ((data ,type) (dl-list (dl-list ,type))) ,type
         (let* ((anchor (,dl-list-anchor dl-list))
                (current (,node-prev anchor))
                (new-node (,make-node :data data :prev current :next anchor)))
           (setf (,node-next current) new-node
                 (,node-prev anchor) new-node)
           data))

       (defun ,%make-dl-list (size)
         (let ((newlist (,make-dl-list)))
           (setf (,node-next #1=(,dl-list-anchor newlist)) #1#
                 (,node-prev (,dl-list-anchor newlist)) #1#)
           (loop :repeat size :do (push-back ,default newlist))
           newlist))

       (defpolymorph pop-back ((dl-list (dl-list ,type))) ,type
         (let* ((anchor (,dl-list-anchor dl-list))
                (current (,node-prev anchor)))
           (setf (,node-prev anchor) (,node-prev current)
                 (,node-next (,node-prev current)) anchor)
           (,node-data current)))


       (defpolymorph pop-front ((dl-list (dl-list ,type))) ,type
         (let* ((anchor (,dl-list-anchor dl-list))
                (current (,node-next anchor)))
           (setf (,node-next anchor) (,node-next current)
                 (,node-prev (,node-next current)) anchor)
           (,node-data current)))

       (defpolymorph empty-p ((dl-list (dl-list ,type))) boolean
         (eq #2=(,dl-list-anchor dl-list) (,node-next #2#)))

       (defmethod print-object ((object ,dl-list) stream)
         (loop :for node := (,node-next (,dl-list-anchor object)) :then (,node-next node)
               :until (eq node (,dl-list-anchor object))
               :do (format stream "~s " (,node-data node)))))))


(defun make (type size)
  (let* ((%type (sb-ext:typexpand type))
         (maker (intern (concatenate 'string "%MAKE-" (string %type)))))
    (funcall maker size)))

(define-compiler-macro make (type size &environment env)
  (let* ((%type (sb-ext:typexpand (eval type) env))
         (maker (intern (concatenate 'string "%MAKE-" (string %type)))))
    `(,maker ,size)))


;; Example of usage
(define-double-linked-list fixnum 0)  ;;For Implementation of defaults for types see my other gist