API tools faq
paste
Advertisement
logicmoo

Untitled

logicmoo
Dec 24th, 2017
332
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 18.51 KB | None | 0 0
raw download clone embed print report
  1. root@gitlab:/home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl# grep -A 40 -i "defmacro pushnew" . -R
  2.  
  3. --
  4. ./reference/rcyc/cynd/cl.lisp:(defmacro pushnew (item place) (ret `(progn (cpushnew ,item ,place) ,place)))
  5.  
  6. --
  7. ./reference/rcyc/cynd/common.lisp:(defmacro pushnew (item place &key key test test-not) (ret (fif test (list 'cpushnew item place test)(list 'cpushnew item place))))
  8. --
  9. ./reference/rcyc/cynd/cb_prolog.lisp:  (defmacro pushnew (item place) (ret `(progn (cpushnew ,item ,place) ,place)))
  10.  
  11. ./reference/rcyc/cynd/cb_prolog.lisp-  (define map (result-type function &body sequences)
  12. ./reference/rcyc/cynd/cb_prolog.lisp-    (let ((result (map-sequences function sequences)))
  13. ./reference/rcyc/cynd/cb_prolog.lisp-      (ret (fif result-type (coerce result result-type) nil))))
  14. ./reference/rcyc/cynd/cb_prolog.lisp-
  15. --
  16. ./reference/ccl/lib/setf.lisp:(defmacro pushnew (value place &rest keys &environment env)
  17. ./reference/ccl/lib/setf.lisp-  "Takes an object and a location holding a list. If the object is
  18. ./reference/ccl/lib/setf.lisp-  already in the list, does nothing; otherwise, conses the object onto
  19. ./reference/ccl/lib/setf.lisp-  the list. Returns the modified list. If there is a :TEST keyword, this
  20. ./reference/ccl/lib/setf.lisp-  is used for the comparison."
  21. ./reference/ccl/lib/setf.lisp-  (if (not (consp place))
  22. ./reference/ccl/lib/setf.lisp-    `(setq ,place (adjoin ,value ,place ,@keys))
  23. ./reference/ccl/lib/setf.lisp-    (let ((valvar (gensym)))
  24. ./reference/ccl/lib/setf.lisp-      (multiple-value-bind (dummies vals store-var setter getter)
  25. ./reference/ccl/lib/setf.lisp-                           (get-setf-method place env)
  26. ./reference/ccl/lib/setf.lisp-        `(let* ((,valvar ,value)
  27. ./reference/ccl/lib/setf.lisp-                ,@(mapcar #'list dummies vals)
  28. ./reference/ccl/lib/setf.lisp-                (,(car store-var) (adjoin ,valvar ,getter ,@keys)))
  29. ./reference/ccl/lib/setf.lisp-           ,@dummies
  30. ./reference/ccl/lib/setf.lisp-           ,(car store-var)
  31. ./reference/ccl/lib/setf.lisp-           ,setter)))))
  32. ./reference/ccl/lib/setf.lisp-
  33.  
  34. --
  35. ./reference/ccl/lib/setf.lisp:(defmacro pushnew (item place &rest key-args)
  36. ./reference/ccl/lib/setf.lisp-  (let ((item-gsym (gensym)))
  37. ./reference/ccl/lib/setf.lisp-    (if (not (consp place))
  38. ./reference/ccl/lib/setf.lisp-      `(let ((,item-gsym ,item))
  39. ./reference/ccl/lib/setf.lisp-         (setq ,place (adjoin ,item-gsym ,place ,@key-args)))
  40. ./reference/ccl/lib/setf.lisp-      (let* ((arg-num (1- (length place)))
  41. ./reference/ccl/lib/setf.lisp-             (place-args (make-gsym-list arg-num)))
  42. ./reference/ccl/lib/setf.lisp-        `(let ,(cons (list item-gsym item)
  43. ./reference/ccl/lib/setf.lisp-                     (reverse (assoc-2-lists place-args (cdr place))))
  44. ./reference/ccl/lib/setf.lisp-           (setf (,(car place) ,@place-args)
  45. ./reference/ccl/lib/setf.lisp-                 (adjoin ,item-gsym (,(car place) ,@place-args)
  46. ./reference/ccl/lib/setf.lisp-                         ,@key-args)))))))
  47.  
  48. ./reference/jscl/src/setf.lisp:(defmacro pushnew (x place &rest keys &key key test test-not)
  49. ./reference/jscl/src/setf.lisp-  (declare (ignore key test test-not))
  50. ./reference/jscl/src/setf.lisp-  (multiple-value-bind (dummies vals newval setter getter)
  51. ./reference/jscl/src/setf.lisp-      (!get-setf-expansion place)
  52. ./reference/jscl/src/setf.lisp-    (let ((g (gensym))
  53. ./reference/jscl/src/setf.lisp-          (v (gensym)))
  54. ./reference/jscl/src/setf.lisp-      `(let* ((,g ,x)
  55. ./reference/jscl/src/setf.lisp-              ,@(mapcar #'list dummies vals)
  56. ./reference/jscl/src/setf.lisp-              ,@(cdr newval)
  57. ./reference/jscl/src/setf.lisp-              (,v ,getter))
  58. ./reference/jscl/src/setf.lisp-         (if (member ,g ,v ,@keys)
  59. ./reference/jscl/src/setf.lisp-             ,v
  60. ./reference/jscl/src/setf.lisp-             (let ((,(car newval) (cons ,g ,getter)))
  61. ./reference/jscl/src/setf.lisp-               ,setter))))))
  62. --
  63. ./reference/sbcl/src/code/setf.lisp:(sb!xc:defmacro pushnew (obj place &rest keys &environment env)
  64. ./reference/sbcl/src/code/setf.lisp-  "Takes an object and a location holding a list. If the object is
  65. ./reference/sbcl/src/code/setf.lisp-  already in the list, does nothing; otherwise, conses the object onto
  66. ./reference/sbcl/src/code/setf.lisp-  the list. Keyword arguments are accepted as per the ADJOIN function."
  67. ./reference/sbcl/src/code/setf.lisp-  ;; Can't specify the actual keywords above since, apparently,
  68. ./reference/sbcl/src/code/setf.lisp-  ;; non-constant keywords should be accepted.
  69. ./reference/sbcl/src/code/setf.lisp-  (declare (sb!c::lambda-list (obj place &key key test test-not)))
  70. ./reference/sbcl/src/code/setf.lisp-  ;; Passing AFTER-ARGS-BINDP = NIL causes the forms subsequent to PLACE
  71. ./reference/sbcl/src/code/setf.lisp-  ;; to be inserted literally as-is, giving the (apparently) desired behavior
  72. ./reference/sbcl/src/code/setf.lisp-  ;; of *not* evaluating them before the Read/Modify/Write of PLACE, which
  73. ./reference/sbcl/src/code/setf.lisp-  ;; seems to be an exception to the 5.1.3 exception on L-to-R evaluation.
  74. ./reference/sbcl/src/code/setf.lisp-  ;; The spec only mentions that ITEM is eval'd before PLACE.
  75. ./reference/sbcl/src/code/setf.lisp-  (expand-rmw-macro 'adjoin (list obj) place keys nil env '(item)))
  76. --
  77. ./reference/abcl/macros.lisp:(defmacro pushnew (&environment env item place &rest keys)
  78. ./reference/abcl/macros.lisp-  (if (and (symbolp place)
  79. ./reference/abcl/macros.lisp-      (eq place (macroexpand place env)))
  80. ./reference/abcl/macros.lisp-      `(setq ,place (adjoin ,item ,place ,@keys))
  81. ./reference/abcl/macros.lisp-      (multiple-value-bind (dummies vals newval setter getter)
  82. ./reference/abcl/macros.lisp-        (get-setf-expansion place env)
  83. ./reference/abcl/macros.lisp-        (let ((g (gensym)))
  84. ./reference/abcl/macros.lisp-          `(let* ((,g ,item)
  85. ./reference/abcl/macros.lisp-                  ,@(mapcar #'list dummies vals)
  86. ./reference/abcl/macros.lisp-                  (,(car newval) (adjoin ,g ,getter ,@keys)))
  87. ./reference/abcl/macros.lisp-             ,setter)))))
  88. ./reference/abcl/macros.lisp-
  89. --
  90. ./reference/xlisp500/wam-cl-init6.lisp:(defmacro pushnew (item place &rest rest)
  91. ./reference/xlisp500/wam-cl-init6.lisp-  `(unless (member ,item ,place ,@rest)
  92. ./reference/xlisp500/wam-cl-init6.lisp-    (push ,item ,place)))
  93. --
  94. ./reference/clisp/src/places.lisp:(defmacro pushnew (item place &rest keylist &environment env)
  95. ./reference/clisp/src/places.lisp-  (multiple-value-bind (temps subforms stores setterform getterform)
  96. ./reference/clisp/src/places.lisp-      (get-setf-expansion place env)
  97. ./reference/clisp/src/places.lisp-    (let ((itemtemps (gensym-list (length stores)))
  98. ./reference/clisp/src/places.lisp-          (bindlist (mapcar #'list temps subforms))
  99. ./reference/clisp/src/places.lisp-          (oldtemps (gensym-list (length stores))))
  100. ./reference/clisp/src/places.lisp-      (optimized-wrap-multiple-value-bind env itemtemps item
  101. ./reference/clisp/src/places.lisp-        (wrap-let* bindlist
  102. ./reference/clisp/src/places.lisp-          (optimized-wrap-multiple-value-bind env oldtemps getterform
  103. ./reference/clisp/src/places.lisp-            ;; We're not blindly optimizing this to
  104. ./reference/clisp/src/places.lisp-            ;;   (sublis-in-form
  105. ./reference/clisp/src/places.lisp-            ;;     (mapcar #'(lambda (storevar itemvar oldvar)
  106. ./reference/clisp/src/places.lisp-            ;;                 (cons storevar `(ADJOIN ,itemvar ,oldvar ,@keylist)))
  107. ./reference/clisp/src/places.lisp-            ;;             stores itemtemps oldtemps)
  108. ./reference/clisp/src/places.lisp-            ;;     setterform)
  109. ./reference/clisp/src/places.lisp-            ;; because we don't want the ADJOIN forms to be evaluated multiple
  110. ./reference/clisp/src/places.lisp-            ;; times. Instead we rely on simple-occurrence-in-basic-block-p for
  111. ./reference/clisp/src/places.lisp-            ;; doing the analysis.
  112. ./reference/clisp/src/places.lisp-            (optimized-wrap-let* env
  113. ./reference/clisp/src/places.lisp-              (mapcar #'(lambda (storevar itemvar oldvar)
  114. ./reference/clisp/src/places.lisp-                          (list storevar `(ADJOIN ,itemvar ,oldvar ,@keylist)))
  115. ./reference/clisp/src/places.lisp-                      stores itemtemps oldtemps)
  116. ./reference/clisp/src/places.lisp-              setterform)))))))
  117. ./reference/clisp/src/places.lisp-;;;----------------------------------------------------------------------------
  118. --
  119. ./reference/emacs-cl/cl-conses.el:(cl:defmacro PUSHNEW (object place &rest keys)
  120. ./reference/emacs-cl/cl-conses.el-  (MULTIPLE-VALUE-BIND (temps values variables setter getter)
  121. ./reference/emacs-cl/cl-conses.el-      (GET-SETF-EXPANSION place nil) ;TODO: environment
  122. ./reference/emacs-cl/cl-conses.el-    (with-gensyms (obj)
  123. ./reference/emacs-cl/cl-conses.el-      `(LET* ((,obj ,object)
  124. ./reference/emacs-cl/cl-conses.el-            ,@(MAPCAR #'list temps values)
  125. ./reference/emacs-cl/cl-conses.el-            (,(first variables) (ADJOIN ,obj ,getter ,@keys)))
  126. ./reference/emacs-cl/cl-conses.el-       ,setter))))
  127. ./reference/emacs-cl/cl-conses.el-
  128. --
  129. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp:(defmacro pushnew (item place
  130. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                  &environment env
  131. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                  &rest args
  132. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                  &key
  133. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                  (key nil key-p)
  134. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                  (test nil test-p)
  135. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                  (test-not nil test-not-p))
  136. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-  (declare (ignorable test test-not))
  137. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-  (if (and test-p test-not-p)
  138. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-      (progn (warn 'warn-both-test-and-test-not-given
  139. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                  :name 'pushnew)
  140. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-            `(error 'both-test-and-test-not-given :name 'pushnew))
  141. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-      (let ((item-var (gensym)))
  142. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-       (multiple-value-bind (vars vals store-vars writer-form reader-form)
  143. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-           (get-setf-expansion place env)
  144. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-         `(let ((,item-var ,item)
  145. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                ,@(mapcar #'list vars vals)
  146. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                ,@(make-bindings args))
  147. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-            ,@(if key-p `((declare (ignorable key))) `())
  148. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-            (let ((,(car store-vars) ,reader-form))
  149. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-              ,(if key
  150. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                   (if test-p
  151. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                       `(unless (|member test=other key=other|
  152. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                 'pushnew
  153. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                 (funcall key ,item-var)
  154. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                 ,(car store-vars)
  155. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                 test
  156. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                 key)
  157. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                          (push ,item-var ,(car store-vars)))
  158. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                       (if test-not-p
  159. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                           `(unless (|member test-not=other key=other|
  160. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                     'pushnew
  161. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                     (funcall key ,item-var)
  162. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                     ,(car store-vars)
  163. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                     test-not
  164. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                     key)
  165. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                              (push ,item-var ,(car store-vars)))
  166. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                           `(unless (|member test=eql key=other|
  167. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                     'pushnew
  168. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                     (funcall key ,item-var)
  169. ./reference/SICL/Code/Cons/pushnew-defmacro.lisp-                                     ,(car store-vars)
  170. --
  171. ./reference/SICL/Code/Cons-high/cons-high.lisp:(defmacro pushnew (item place
  172. ./reference/SICL/Code/Cons-high/cons-high.lisp-            &environment env
  173. ./reference/SICL/Code/Cons-high/cons-high.lisp-            &rest args
  174. ./reference/SICL/Code/Cons-high/cons-high.lisp-            &key
  175. ./reference/SICL/Code/Cons-high/cons-high.lisp-            (key nil key-p)
  176. ./reference/SICL/Code/Cons-high/cons-high.lisp-            (test nil test-p)
  177. ./reference/SICL/Code/Cons-high/cons-high.lisp-            (test-not nil test-not-p))
  178. ./reference/SICL/Code/Cons-high/cons-high.lisp-  (declare (ignorable test test-not))
  179. ./reference/SICL/Code/Cons-high/cons-high.lisp-  (if (and test-p test-not-p)
  180. ./reference/SICL/Code/Cons-high/cons-high.lisp-      (progn (warn 'warn-both-test-and-test-not-given
  181. ./reference/SICL/Code/Cons-high/cons-high.lisp-            :name 'pushnew)
  182. ./reference/SICL/Code/Cons-high/cons-high.lisp-      `(error 'both-test-and-test-not-given :name 'pushnew))
  183. ./reference/SICL/Code/Cons-high/cons-high.lisp-      (let ((item-var (gensym)))
  184. ./reference/SICL/Code/Cons-high/cons-high.lisp- (multiple-value-bind (vars vals store-vars writer-form reader-form)
  185. ./reference/SICL/Code/Cons-high/cons-high.lisp-     (get-setf-expansion place env)
  186. ./reference/SICL/Code/Cons-high/cons-high.lisp-   `(let ((,item-var ,item)
  187. ./reference/SICL/Code/Cons-high/cons-high.lisp-          ,@(mapcar #'list vars vals)
  188. ./reference/SICL/Code/Cons-high/cons-high.lisp-          ,@(make-bindings args))
  189. ./reference/SICL/Code/Cons-high/cons-high.lisp-      ,@(if key-p `((declare (ignorable key))) `())
  190. ./reference/SICL/Code/Cons-high/cons-high.lisp-      (let ((,(car store-vars) ,reader-form))
  191. ./reference/SICL/Code/Cons-high/cons-high.lisp-        ,(if key
  192. ./reference/SICL/Code/Cons-high/cons-high.lisp-             (if test-p
  193. ./reference/SICL/Code/Cons-high/cons-high.lisp-                 `(unless (|member test=other key=other|
  194. ./reference/SICL/Code/Cons-high/cons-high.lisp-                           'pushnew
  195. ./reference/SICL/Code/Cons-high/cons-high.lisp-                           (funcall key ,item-var)
  196. ./reference/SICL/Code/Cons-high/cons-high.lisp-                           ,(car store-vars)
  197. ./reference/SICL/Code/Cons-high/cons-high.lisp-                           test
  198. ./reference/SICL/Code/Cons-high/cons-high.lisp-                           key)
  199. ./reference/SICL/Code/Cons-high/cons-high.lisp-                    (push ,item-var ,(car store-vars)))
  200. ./reference/SICL/Code/Cons-high/cons-high.lisp-                 (if test-not-p
  201. ./reference/SICL/Code/Cons-high/cons-high.lisp-                     `(unless (|member test-not=other key=other|
  202. ./reference/SICL/Code/Cons-high/cons-high.lisp-                               'pushnew
  203. ./reference/SICL/Code/Cons-high/cons-high.lisp-                               (funcall key ,item-var)
  204. ./reference/SICL/Code/Cons-high/cons-high.lisp-                               ,(car store-vars)
  205. ./reference/SICL/Code/Cons-high/cons-high.lisp-                               test-not
  206. ./reference/SICL/Code/Cons-high/cons-high.lisp-                               key)
  207. ./reference/SICL/Code/Cons-high/cons-high.lisp-                        (push ,item-var ,(car store-vars)))
  208. ./reference/SICL/Code/Cons-high/cons-high.lisp-                     `(unless (|member test=eql key=other|
  209. ./reference/SICL/Code/Cons-high/cons-high.lisp-                               'pushnew
  210. ./reference/SICL/Code/Cons-high/cons-high.lisp-                               (funcall key ,item-var)
  211. ./reference/SICL/Code/Cons-high/cons-high.lisp-                               ,(car store-vars)
  212. --
  213. ./reference/ecl/src/lsp/setf.lsp:(defmacro pushnew (&environment env item place &rest rest)
  214. ./reference/ecl/src/lsp/setf.lsp-  "Syntax: (pushnew form place {keyword-form value-form}*)
  215. ./reference/ecl/src/lsp/setf.lsp-Evaluates FORM first.  If the value is already in the list stored in PLACE,
  216. ./reference/ecl/src/lsp/setf.lsp-does nothing.  Else, conses the value onto the list and makes the result the
  217. ./reference/ecl/src/lsp/setf.lsp-new value of PLACE.  Returns NIL.  KEYWORD-FORMs and VALUE-FORMs are used to
  218. ./reference/ecl/src/lsp/setf.lsp-check if the value of FORM is already in PLACE as if their values are passed
  219. ./reference/ecl/src/lsp/setf.lsp-to MEMBER."
  220. ./reference/ecl/src/lsp/setf.lsp-  (declare (notinline mapcar))
  221. ./reference/ecl/src/lsp/setf.lsp-  (multiple-value-bind (vars vals stores store-form access-form)
  222. ./reference/ecl/src/lsp/setf.lsp-      (get-setf-expansion place env)
  223. ./reference/ecl/src/lsp/setf.lsp-    (when (trivial-setf-form place vars stores store-form access-form)
  224. ./reference/ecl/src/lsp/setf.lsp-      (return-from pushnew `(setq ,place (adjoin ,item ,place ,@rest))))
  225. ./reference/ecl/src/lsp/setf.lsp-    ;; The item to be pushed has to be evaluated before the destination
  226. ./reference/ecl/src/lsp/setf.lsp-    (unless (constantp item env)
  227. ./reference/ecl/src/lsp/setf.lsp-      (setq vals (cons item vals)
  228. ./reference/ecl/src/lsp/setf.lsp-            item (gensym)
  229. ./reference/ecl/src/lsp/setf.lsp-            vars (cons item vars)))
  230. ./reference/ecl/src/lsp/setf.lsp-    `(let* ,(mapcar #'list
  231. ./reference/ecl/src/lsp/setf.lsp-                    (append vars stores)
  232. ./reference/ecl/src/lsp/setf.lsp-                    (append vals
  233. ./reference/ecl/src/lsp/setf.lsp-                            (list (list* 'adjoin item access-form rest))))
  234. ./reference/ecl/src/lsp/setf.lsp-       (declare (:read-only ,@vars)) ; Beppe
  235. ./reference/ecl/src/lsp/setf.lsp-       ,store-form)))
  236. ./reference/ecl/src/lsp/setf.lsp-root@gitlab:/home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl#
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!