X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsset.lisp;h=609f5556ff4d538af4b6ae8f5d452f4f3d1c7428;hb=a4882e3023fdd5e777169a4cbede33605281173c;hp=4f7f1eb528ce1de7aa362ecbc5a9a6619a5ac4e1;hpb=8375acd89ba695e2fc838fffd5211a5ddf9c3b0d;p=sbcl.git diff --git a/src/compiler/sset.lisp b/src/compiler/sset.lisp index 4f7f1eb..609f555 100644 --- a/src/compiler/sset.lisp +++ b/src/compiler/sset.lisp @@ -20,7 +20,7 @@ ;;; that no ordering has been assigned yet (although an ordering must ;;; be assigned before doing set operations.) (def!struct (sset-element (:constructor nil) - (:copier nil)) + (:copier nil)) (number nil :type (or index null))) (defstruct (sset (:copier nil)) @@ -42,18 +42,18 @@ (declaim (ftype (sfunction (sset-element sset) boolean) sset-adjoin)) (defun sset-adjoin (element set) (let ((number (sset-element-number element)) - (elements (sset-elements set))) + (elements (sset-elements set))) (do ((prev elements current) - (current (cdr elements) (cdr current))) - ((null current) - (setf (cdr prev) (list element)) - t) + (current (cdr elements) (cdr current))) + ((null current) + (setf (cdr prev) (list element)) + t) (let ((el (car current))) - (when (>= (sset-element-number el) number) - (when (eq el element) - (return nil)) - (setf (cdr prev) (cons element current)) - (return t)))))) + (when (>= (sset-element-number el) number) + (when (eq el element) + (return nil)) + (setf (cdr prev) (cons element current)) + (return t)))))) ;;; Destructively remove ELEMENT from SET. If element was in the set, ;;; then return true, otherwise return false. @@ -61,11 +61,11 @@ (defun sset-delete (element set) (let ((elements (sset-elements set))) (do ((prev elements current) - (current (cdr elements) (cdr current))) - ((null current) nil) + (current (cdr elements) (cdr current))) + ((null current) nil) (when (eq (car current) element) - (setf (cdr prev) (cdr current)) - (return t))))) + (setf (cdr prev) (cdr current)) + (return t))))) ;;; Return true if ELEMENT is in SET, false otherwise. (declaim (ftype (sfunction (sset-element sset) boolean) sset-member)) @@ -91,69 +91,69 @@ ;;; destructively modifying SET1. We return true if SET1 was modified, ;;; false otherwise. (declaim (ftype (sfunction (sset sset) boolean) sset-union sset-intersection - sset-difference)) + sset-difference)) (defun sset-union (set1 set2) (let* ((prev-el1 (sset-elements set1)) - (el1 (cdr prev-el1)) - (changed nil)) + (el1 (cdr prev-el1)) + (changed nil)) (do ((el2 (cdr (sset-elements set2)) (cdr el2))) - ((null el2) changed) + ((null el2) changed) (let* ((e (car el2)) - (num2 (sset-element-number e))) - (loop - (when (null el1) - (setf (cdr prev-el1) (copy-list el2)) - (return-from sset-union t)) - (let ((num1 (sset-element-number (car el1)))) - (when (>= num1 num2) - (if (> num1 num2) - (let ((new (cons e el1))) - (setf (cdr prev-el1) new) - (setq prev-el1 new - changed t)) - (shiftf prev-el1 el1 (cdr el1))) - (return)) - (shiftf prev-el1 el1 (cdr el1)))))))) + (num2 (sset-element-number e))) + (loop + (when (null el1) + (setf (cdr prev-el1) (copy-list el2)) + (return-from sset-union t)) + (let ((num1 (sset-element-number (car el1)))) + (when (>= num1 num2) + (if (> num1 num2) + (let ((new (cons e el1))) + (setf (cdr prev-el1) new) + (setq prev-el1 new + changed t)) + (shiftf prev-el1 el1 (cdr el1))) + (return)) + (shiftf prev-el1 el1 (cdr el1)))))))) (defun sset-intersection (set1 set2) (let* ((prev-el1 (sset-elements set1)) - (el1 (cdr prev-el1)) - (changed nil)) + (el1 (cdr prev-el1)) + (changed nil)) (do ((el2 (cdr (sset-elements set2)) (cdr el2))) - ((null el2) - (cond (el1 - (setf (cdr prev-el1) nil) - t) - (t changed))) + ((null el2) + (cond (el1 + (setf (cdr prev-el1) nil) + t) + (t changed))) (let ((num2 (sset-element-number (car el2)))) - (loop - (when (null el1) - (return-from sset-intersection changed)) - (let ((num1 (sset-element-number (car el1)))) - (when (>= num1 num2) - (when (= num1 num2) - (shiftf prev-el1 el1 (cdr el1))) - (return)) - (pop el1) - (setf (cdr prev-el1) el1) - (setq changed t))))))) + (loop + (when (null el1) + (return-from sset-intersection changed)) + (let ((num1 (sset-element-number (car el1)))) + (when (>= num1 num2) + (when (= num1 num2) + (shiftf prev-el1 el1 (cdr el1))) + (return)) + (pop el1) + (setf (cdr prev-el1) el1) + (setq changed t))))))) (defun sset-difference (set1 set2) (let* ((prev-el1 (sset-elements set1)) - (el1 (cdr prev-el1)) - (changed nil)) + (el1 (cdr prev-el1)) + (changed nil)) (do ((el2 (cdr (sset-elements set2)) (cdr el2))) - ((null el2) changed) + ((null el2) changed) (let ((num2 (sset-element-number (car el2)))) - (loop - (when (null el1) - (return-from sset-difference changed)) - (let ((num1 (sset-element-number (car el1)))) - (when (>= num1 num2) - (when (= num1 num2) - (pop el1) - (setf (cdr prev-el1) el1) - (setq changed t)) - (return)) - (shiftf prev-el1 el1 (cdr el1)))))))) + (loop + (when (null el1) + (return-from sset-difference changed)) + (let ((num1 (sset-element-number (car el1)))) + (when (>= num1 num2) + (when (= num1 num2) + (pop el1) + (setf (cdr prev-el1) el1) + (setq changed t)) + (return)) + (shiftf prev-el1 el1 (cdr el1)))))))) ;;; Destructively modify SET1 to include its union with the difference ;;; of SET2 and SET3. We return true if SET1 was modified, false @@ -161,59 +161,59 @@ (declaim (ftype (sfunction (sset sset sset) boolean) sset-union-of-difference)) (defun sset-union-of-difference (set1 set2 set3) (let* ((prev-el1 (sset-elements set1)) - (el1 (cdr prev-el1)) - (el3 (cdr (sset-elements set3))) - (changed nil)) + (el1 (cdr prev-el1)) + (el3 (cdr (sset-elements set3))) + (changed nil)) (do ((el2 (cdr (sset-elements set2)) (cdr el2))) - ((null el2) changed) + ((null el2) changed) (let* ((e (car el2)) - (num2 (sset-element-number e))) - (loop - (when (null el3) - (loop - (when (null el1) - (setf (cdr prev-el1) (copy-list el2)) - (return-from sset-union-of-difference t)) - (let ((num1 (sset-element-number (car el1)))) - (when (>= num1 num2) - (if (> num1 num2) - (let ((new (cons e el1))) - (setf (cdr prev-el1) new) - (setq prev-el1 new changed t)) - (shiftf prev-el1 el1 (cdr el1))) - (return)) - (shiftf prev-el1 el1 (cdr el1)))) - (return)) - (let ((num3 (sset-element-number (car el3)))) - (when (<= num2 num3) - (unless (= num2 num3) - (loop - (when (null el1) - (do ((el2 el2 (cdr el2))) - ((null el2) - (return-from sset-union-of-difference changed)) - (let* ((e (car el2)) - (num2 (sset-element-number e))) - (loop - (when (null el3) - (setf (cdr prev-el1) (copy-list el2)) - (return-from sset-union-of-difference t)) - (setq num3 (sset-element-number (car el3))) - (when (<= num2 num3) - (unless (= num2 num3) - (let ((new (cons e el1))) - (setf (cdr prev-el1) new) - (setq prev-el1 new changed t))) - (return)) - (pop el3))))) - (let ((num1 (sset-element-number (car el1)))) - (when (>= num1 num2) - (if (> num1 num2) - (let ((new (cons e el1))) - (setf (cdr prev-el1) new) - (setq prev-el1 new changed t)) - (shiftf prev-el1 el1 (cdr el1))) - (return)) - (shiftf prev-el1 el1 (cdr el1))))) - (return))) - (pop el3)))))) + (num2 (sset-element-number e))) + (loop + (when (null el3) + (loop + (when (null el1) + (setf (cdr prev-el1) (copy-list el2)) + (return-from sset-union-of-difference t)) + (let ((num1 (sset-element-number (car el1)))) + (when (>= num1 num2) + (if (> num1 num2) + (let ((new (cons e el1))) + (setf (cdr prev-el1) new) + (setq prev-el1 new changed t)) + (shiftf prev-el1 el1 (cdr el1))) + (return)) + (shiftf prev-el1 el1 (cdr el1)))) + (return)) + (let ((num3 (sset-element-number (car el3)))) + (when (<= num2 num3) + (unless (= num2 num3) + (loop + (when (null el1) + (do ((el2 el2 (cdr el2))) + ((null el2) + (return-from sset-union-of-difference changed)) + (let* ((e (car el2)) + (num2 (sset-element-number e))) + (loop + (when (null el3) + (setf (cdr prev-el1) (copy-list el2)) + (return-from sset-union-of-difference t)) + (setq num3 (sset-element-number (car el3))) + (when (<= num2 num3) + (unless (= num2 num3) + (let ((new (cons e el1))) + (setf (cdr prev-el1) new) + (setq prev-el1 new changed t))) + (return)) + (pop el3))))) + (let ((num1 (sset-element-number (car el1)))) + (when (>= num1 num2) + (if (> num1 num2) + (let ((new (cons e el1))) + (setf (cdr prev-el1) new) + (setq prev-el1 new changed t)) + (shiftf prev-el1 el1 (cdr el1))) + (return)) + (shiftf prev-el1 el1 (cdr el1))))) + (return))) + (pop el3))))))