;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; Copyright (C) 2007-2010, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions are ;; met: ;; ;; - Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; ;; - Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in ;; the documentation and/or other materials provided with the ;; distribution. ;; ;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the ;; names of its contributors may be used to endorse or promote products ;; derived from this software without specific prior written permission. ;; ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS ;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A ;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER ;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (IMPORT-MODULE "vmlisp") (in-package "BOOT") ;;macros from file vmlisp are necessary to compile this file (DEFUN |intersection| (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2) (PROG (I H V) (SETQ V (SETQ H (CONS NIL NIL))) (COND ( (NOT (LISTP LIST-OF-ITEMS-1)) (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) ) (COND ( (NOT (LISTP LIST-OF-ITEMS-2)) (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) ) LP (COND ( (NOT (CONSP LIST-OF-ITEMS-1)) (RETURN (QCDR H)) ) ( (|member| (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1)))) (QCDR H)) ) ( (|member| I LIST-OF-ITEMS-2) (QRPLACD V (SETQ V (CONS I NIL))) ) ) (GO LP) ) ) (DEFUN |union| (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2) (PROG (I H V) (SETQ H (SETQ V (CONS NIL NIL))) (COND ( (NOT (LISTP LIST-OF-ITEMS-1)) (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) ) (COND ( (NOT (LISTP LIST-OF-ITEMS-2)) (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) ) LP1 (COND ( (NOT (CONSP LIST-OF-ITEMS-1)) (COND ( (CONSP LIST-OF-ITEMS-2) (SETQ LIST-OF-ITEMS-1 (RESETQ LIST-OF-ITEMS-2 NIL)) ) ( 'T (RETURN (QCDR H)) ) ) ) ( (NOT (|member| (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1)))) (QCDR H))) (QRPLACD V (SETQ V (CONS I NIL))) ) ) (GO LP1) ) ) (DEFUN SETDIFFERENCE (LIST-OF-ITEMS-1 LIST-OF-ITEMS-2) (PROG (I H V) (SETQ H (SETQ V (CONS NIL NIL))) (COND ( (NOT (LISTP LIST-OF-ITEMS-1)) (SETQ LIST-OF-ITEMS-1 (LIST LIST-OF-ITEMS-1)) ) ) (COND ( (NOT (LISTP LIST-OF-ITEMS-2)) (SETQ LIST-OF-ITEMS-2 (LIST LIST-OF-ITEMS-2)) ) ) LP1 (COND ( (NOT (CONSP LIST-OF-ITEMS-1)) (RETURN (QCDR H)) ) ( (|member| (SETQ I (QCAR (RESETQ LIST-OF-ITEMS-1 (QCDR LIST-OF-ITEMS-1)))) (QCDR H)) ) ( (NOT (|member| I LIST-OF-ITEMS-2)) (QRPLACD V (SETQ V (CONS I NIL))) ) ) (GO LP1) ) )