Advertisement
Guest User

pop-n

a guest
Sep 2nd, 2018
229
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 1.44 KB | None | 0 0
  1. (defmacro pop-n (place n &environment env)
  2.   (multiple-value-bind (vars vals stores setter getter)
  3.       (get-setf-expansion place env)
  4.     (let ((old-head (gensym "OLDHEAD-"))
  5.           (new-head (gensym "NEWHEAD-"))
  6.           (num (gensym "N-")))
  7.       `(let ,(mapcar #'list vars vals)
  8.          (let* ((,old-head ,getter)
  9.                 (,num ,n)
  10.                 (,new-head (nthcdr ,num ,old-head))
  11.                 (,(first stores) ,new-head)
  12.                 ,@(rest stores))
  13.            ,setter
  14.            (when ,new-head
  15.               (setf (cdr (nthcdr (1- ,num) ,old-head)) nil))
  16.            ,old-head
  17.            )))))
  18.  
  19.  
  20. ;; (defun test1 (list)
  21. ;;   (loop while list
  22. ;;         for sublist = (pop-n list 4)
  23. ;;         collect sublist))
  24.  
  25. ;; (let ((inputs
  26. ;;        (list (list 1 2 3 4)
  27. ;;              (list 1 2 3 4 5 6 7 8)
  28. ;;              (list 1 2 3 4 5 6 7)
  29. ;;              (list 1)
  30. ;;              (list))))
  31. ;;   (dolist (input inputs)
  32. ;;     (print (test1 input))))
  33.  
  34. ;; (defstruct container
  35. ;;   (list nil :type list))
  36.  
  37. ;; (defun test2 (c)
  38. ;;   (loop while (container-list c)
  39. ;;         for sublist = (pop-n (container-list c) 4)
  40. ;;         collect sublist))
  41.  
  42. ;; (let ((inputs
  43. ;;        (list (list 1 2 3 4)
  44. ;;              (list 1 2 3 4 5 6 7 8)
  45. ;;              (list 1 2 3 4 5 6 7)
  46. ;;              (list 1)
  47. ;;              (list))))
  48. ;;   (dolist (input inputs)
  49. ;;     (print (test2 (make-container :list input)))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement