ℹ️ Your data is safe here... unless you make the SNIP gods angry. And let's just say they have a really bad sense of humor.

From Trent, 1 Year ago, written in Plain Text.
This paste will cross the great divide in 1 Second.
Embed
  1. (provide "fun")
  2.  
  3. (defun caar (a)         (car (car a)))
  4. (defun cadr (a)         (nth 1 a))
  5. (defun cdar (a)         (cdr (car a)))
  6. (defun cddr (a)         (nthcdr 2 a))
  7. (defun caaar (a)        (car (car (car a))))
  8. (defun caadr (a)        (car (car (cdr a))))
  9. (defun cadar (a)        (car (cdr (car a))))
  10. (defun caddr (a)        (nth 2 a))
  11. (defun cdaar (a)        (cdr (car (car a))))
  12. (defun cdadr (a)        (cdr (car (cdr a))))
  13. (defun cddar (a)        (cdr (cdr (car a))))
  14. (defun cdddr (a)        (nthcdr 3 a))
  15. (defun caaaar (a)       (car (car (car (car a)))))
  16. (defun caaadr (a)       (car (car (car (cdr a)))))
  17. (defun caadar (a)       (car (car (cdr (car a)))))
  18. (defun caaddr (a)       (car (car (cdr (cdr a)))))
  19. (defun cadaar (a)       (car (cdr (car (car a)))))
  20. (defun cadadr (a)       (car (cdr (car (cdr a)))))
  21. (defun caddar (a)       (car (cdr (cdr (car a)))))
  22. (defun cadddr (a)       (nth 3 a))
  23. (defun cdaaar (a)       (cdr (car (car (car a)))))
  24. (defun cdaadr (a)       (cdr (car (car (cdr a)))))
  25. (defun cdadar (a)       (cdr (car (cdr (car a)))))
  26. (defun cdaddr (a)       (cdr (car (cdr (cdr a)))))
  27. (defun cddaar (a)       (cdr (cdr (car (car a)))))
  28. (defun cddadr (a)       (cdr (cdr (car (cdr a)))))
  29. (defun cdddar (a)       (cdr (cdr (cdr (car a)))))
  30. (defun cddddr (a)       (nthcdr 4 a))
  31.  
  32. (defun second (a)       (nth 1 a))
  33. (defun third (a)        (nth 2 a))
  34. (defun fourth (a)       (nth 3 a))
  35. (defun fifth (a)        (nth 4 a))
  36. (defun sixth (a)        (nth 5 a))
  37. (defun seventh (a)      (nth 6 a))
  38. (defun eighth (a)       (nth 7 a))
  39. (defun ninth (a)        (nth 8 a))
  40. (defun tenth (a)        (nth 9 a))
  41.  
  42. (defun copy-seq (sequence)      (subseq sequence 0))
  43.  
  44. (defmacro push (object place)
  45.     (list 'setf place (list 'cons object place)))
  46.  
  47. (defmacro pop (place)
  48.     (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place))))
  49.  
  50. (defmacro prog (init &rest body)
  51.     `(block nil (let ,init (tagbody ,@body))))
  52.  
  53. (defmacro prog* (init &rest body)
  54.     `(block nil (let* ,init (tagbody ,@body))))
  55.  
  56. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57. ;; setf
  58. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  59. (defsetf car (list) (value)     `(progn (rplaca ,list ,value) ,value))
  60. (defsetf cdr (list) (value)     `(progn (rplacd ,list ,value) ,value))
  61.  
  62. (defsetf caar (list) (value)    `(progn (rplaca (car ,list) ,value) ,value))
  63. (defsetf cadr (list) (value)    `(progn (rplaca (cdr ,list) ,value) ,value))
  64. (defsetf cdar (list) (value)    `(progn (rplacd (car ,list) ,value) ,value))
  65. (defsetf cddr (list) (value)    `(progn (rplacd (cdr ,list) ,value) ,value))
  66. (defsetf caaar (list) (value)   `(progn (rplaca (caar ,list) ,value) ,value))
  67. (defsetf caadr (list) (value)   `(progn (rplaca (cadr ,list) ,value) ,value))
  68. (defsetf cadar (list) (value)   `(progn (rplaca (cdar ,list) ,value) ,value))
  69. (defsetf caddr (list) (value)   `(progn (rplaca (cddr ,list) ,value) ,value))
  70. (defsetf cdaar (list) (value)   `(progn (rplacd (caar ,list) ,value) ,value))
  71. (defsetf cdadr (list) (value)   `(progn (rplacd (cadr ,list) ,value) ,value))
  72. (defsetf cddar (list) (value)   `(progn (rplacd (cdar ,list) ,value) ,value))
  73. (defsetf cdddr (list) (value)   `(progn (rplacd (cddr ,list) ,value) ,value))
  74. (defsetf caaaar (list) (value)  `(progn (rplaca (caaar ,list) ,value) ,value))
  75. (defsetf caaadr (list) (value)  `(progn (rplaca (caadr ,list) ,value) ,value))
  76. (defsetf caadar (list) (value)  `(progn (rplaca (cadar ,list) ,value) ,value))
  77. (defsetf caaddr (list) (value)  `(progn (rplaca (caddr ,list) ,value) ,value))
  78. (defsetf cadaar (list) (value)  `(progn (rplaca (cdaar ,list) ,value) ,value))
  79. (defsetf cadadr (list) (value)  `(progn (rplaca (cdadr ,list) ,value) ,value))
  80. (defsetf caddar (list) (value)  `(progn (rplaca (cddar ,list) ,value) ,value))
  81. (defsetf cadddr (list) (value)  `(progn (rplaca (cdddr ,list) ,value) ,value))
  82. (defsetf cdaaar (list) (value)  `(progn (rplacd (caaar ,list) ,value) ,value))
  83. (defsetf cdaadr (list) (value)  `(progn (rplacd (caadr ,list) ,value) ,value))
  84. (defsetf cdadar (list) (value)  `(progn (rplacd (cadar ,list) ,value) ,value))
  85. (defsetf cdaddr (list) (value)  `(progn (rplacd (caddr ,list) ,value) ,value))
  86. (defsetf cddaar (list) (value)  `(progn (rplacd (cdaar ,list) ,value) ,value))
  87. (defsetf cddadr (list) (value)  `(progn (rplacd (cdadr ,list) ,value) ,value))
  88. (defsetf cdddar (list) (value)  `(progn (rplacd (cddar ,list) ,value) ,value))
  89. (defsetf cddddr (list) (value)  `(progn (rplacd (cdddr ,list) ,value) ,value))
  90.  
  91. (defsetf first (list) (value)   `(progn (rplaca ,list ,value) ,value))
  92. (defsetf second (list) (value)  `(progn (rplaca (nthcdr 1 ,list) ,value) ,value))
  93. (defsetf third (list) (value)   `(progn (rplaca (nthcdr 2 ,list) ,value) ,value))
  94. (defsetf fourth (list) (value)  `(progn (rplaca (nthcdr 3 ,list) ,value) ,value))
  95. (defsetf fifth (list) (value)   `(progn (rplaca (nthcdr 4 ,list) ,value) ,value))
  96. (defsetf sixth (list) (value)   `(progn (rplaca (nthcdr 5 ,list) ,value) ,value))
  97. (defsetf seventh (list) (value) `(progn (rplaca (nthcdr 6 ,list) ,value) ,value))
  98. (defsetf eighth (list) (value)  `(progn (rplaca (nthcdr 7 ,list) ,value) ,value))
  99. (defsetf ninth (list) (value)   `(progn (rplaca (nthcdr 8 ,list) ,value) ,value))
  100. (defsetf tenth (list) (value)   `(progn (rplaca (nthcdr 9 ,list) ,value) ,value))
  101.  
  102. (defsetf rest (list) (value)    `(progn (rplacd ,list ,value) ,value))
  103.  
  104. (defun xedit::nth-store (index list value)
  105.     (rplaca (nthcdr index list) value) value)
  106. (defsetf nth xedit::nth-store)
  107.  
  108. (defsetf aref (array &rest indices) (value)
  109.     `(xedit::vector-store ,array ,@indices ,value))
  110.  
  111. (defsetf get (symbol key &optional default) (value)
  112.     `(xedit::put ,symbol ,key ,value))
  113.  
  114. (defsetf char xedit::char-store)
  115. (defsetf schar xedit::char-store)
  116. (defsetf elt xedit::elt-store)
  117.  
  118. (defsetf subseq (sequence start &optional end) (value)
  119.     `(progn (replace ,sequence ,value :start1 ,start :end1 ,end) ,value))