;ELC ;;; compiled by jwz@thalidomide on Wed Mar 23 19:19:07 1994 ;;; from file /th/jwz/emacs19/lisp/vm/sets.el ;;; emacs version 19.10 Lucid (beta8). ;;; bytecomp version 2.22; 22-dec-93. ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "This file was compiled for Emacs 19.")) (provide 'sets) (defconst sets-version "1.04" "\ Version number of the sets implementation.") (defvar sets-typetag '(set) "\ Value is used to distinguish sets from other vectors. The value of this variable is stored in each set structure, but not the set itself.") (defconst sets-vector-length 6 "\ Length of the vector used as a set structure.") (defvar sets-id 0 "\ A number that is assigned to each set so that each has a unique identifier. The value of this variable is incremented each time a new set is created.") (byte-code "MMMMMMMMMMMMMMMMMM" [sets-typetag-of #[(set) "H" [set 0] 2] sets-id-of #[(set) "H" [set 1] 2] sets-cardinality-of #[(set) "H" [set 2] 2] sets-=-function-of #[(set) "H" [set 3] 2] sets-<-function-of #[(set) "H" [set 4] 2] sets-tree-of #[(set) "H" [set 5] 2] sets-set-typetag-of #[(set tag) "\nI" [set 0 tag] 3] sets-set-id-of #[(set id) "\nI" [set 1 id] 3] sets-set-cardinality-of #[(set n) "\nI" [set 2 n] 3] sets-set-=-function-of #[(set f) "\nI" [set 3 f] 3] sets-set-<-function-of #[(set f) "\nI" [set 4 f] 3] sets-set-tree-of #[(set tree) "\nI" [set 5 tree] 3] sets-tree-value-of #[(tree) "H" [tree 0] 2] sets-tree-left-of #[(tree) "H" [tree 1] 2] sets-tree-right-of #[(tree) "H" [tree 2] 2] sets-set-tree-value-of #[(tree value) "\nI" [tree 0 value] 3] sets-set-tree-left-of #[(tree left) "\nI" [tree 1 left] 3] sets-set-tree-right-of #[(tree right) "\nI" [tree 2 right] 3]] 2) (fset 'sets-setp #[(object) " ! G\nU !=" [vectorp object sets-vector-length sets-typetag sets-typetag-of] 3 "\ Returns t if OBJECT is a set."]) (fset 'sets-check-set #[(object) " !? D\"" [sets-setp object signal wrong-type-argument setp] 4 "\ If OBJECT is not a set, signal wrong-type-argument."]) (fset 'sets-make-set #[(&optional =-func <-func) " \" \" \"T \"  \" \" \" )" [make-vector sets-vector-length nil s sets-set-typetag-of sets-typetag sets-set-id-of sets-id sets-set-cardinality-of 0 sets-set-=-function-of =-func sets-= sets-set-<-function-of <-func sets-< sets-set-tree-of] 3 "\ Returns an empty set. Sets can contain any type of Emacs Lisp object as well as other sets. You can also create sets capable of containing your own user defined types. To do this you need to write Lisp functions that do the 'equals' and 'less-than' comparison for objects of your defined type. Then you must pass these two functions to this function as its first and second arguments respectively. You will be able to use all the set manipulation functions on the returned set. Unless your comparison functions can also handle other object types, you will not be able to reliably insert other object types into sets created to handle your private types."]) (byte-code "MM" [sets-make-tree #[nil "\"" [make-vector 3 nil] 3] sets-set-xxxxxx #[(set job &rest items) " !‰ ! ! \n   !=  @\" \" \"  @!\"=‰d=\nT=N!! !\" != !\" !\"!! !\" != !\" !\"! \" != \" \"!!  ! ! Tm!!TmW !\" !\" != !\" !\"!\" !\" != !\" !\", !S\"‰U  @!\"! !TS=‰U=‰U=S    @\" \" !T\" !S\"WS !S! !TS=‰U=‰U=S    @\" \" !T\" !S\"WS !S A !=\n ." [sets-check-set set nil sets-=-function-of sets-<-function-of <-func =-func level tree parent member newtree items sets-tree-of 1 job insert sets-make-tree sets-set-tree-value-of sets-set-tree-of sets-set-cardinality-of sets-tree-value-of t delete sets-tree-left-of sets-tree-right-of sets-set-tree-left-of sets-set-tree-right-of 0 after-level after before-level before sets-cardinality-of lsh sets-balance-set-tree] 9]] 2) (fset 'sets-set-insert #[(set &rest items) "\n $" [apply sets-set-xxxxxx set insert items] 5 "\ Insert remaining arguments into SET. Returns SET."]) (fset 'sets-set-delete #[(set &rest items) "\n $" [apply sets-set-xxxxxx set delete items] 5 "\ Delete remaining arguments from SET. Returns SET."]) (fset 'sets-set-member #[(set item) " #" [sets-set-xxxxxx set member item] 4 "\ Returns t if SET contains ITEM."]) (fset 'sets-set-cardinality #[(set) " ! !" [sets-check-set set sets-cardinality-of] 2 "\ Returns the number of members in SET."]) (byte-code "MMM" [sets-inorder-maptree #[(tree function) "!! \" !!! \"" [tree sets-tree-left-of sets-inorder-maptree function sets-tree-right-of] 3] sets-inorder-maptreevalues #[(tree function) "!! \" !!!! \"" [tree sets-tree-left-of sets-inorder-maptreevalues function sets-tree-value-of sets-tree-right-of] 3] sets-balance-set-tree #[(set) " !V !\" !T\"ĉ ! \n  \"  !э \nH\" \nH\"." [sets-cardinality-of set 2 make-vector nil sets-tree-of tree stop-at link-to fill node-vector value-vector 0 sets-inorder-maptree #[(tree) " !I I T" [value-vector fill sets-tree-value-of tree node-vector] 4] 1 done (byte-code " \nH H\" T V  \nH H\" T V \nT UR\"K" [sets-set-tree-left-of node-vector fill link-to stop-at sets-set-tree-right-of throw done t] 5) #[(tree) " \n H\" T" [sets-set-tree-value-of tree value-vector fill] 4] sets-set-tree-of] 7]] 2) (fset 'sets-print-set #[(set) "!!\"!)" [princ "{" nil first-node-printed sets-inorder-maptree sets-tree-of set #[(tree) "!  !!" [first-node-printed princ " " tree prin1 sets-tree-value-of] 3] "}"] 3 "\ Print SET using {...} notation. The null set is printed as {}."]) (fset 'sets-set-union #[(&rest sets) "\n\n@!\n@!\nA\n@!\n@!\"\nAm )" [nil newset sets sets-check-set sets-copy-set sets-inorder-maptree sets-tree-of #[(tree) " !\"" [sets-set-insert newset sets-tree-value-of tree] 4] sets-make-set] 4 "\ Return the union of all the set arguments. That is, the returned set will contain all the elements of the sets passed to this function."]) (fset 'sets-set-intersection #[(&rest sets) " @! @! @ A @! !\"\n! Aj\n *" [nil current-intersection newset sets sets-check-set sets-copy-set sets-inorder-maptree sets-tree-of #[(tree) " @ !\"? !\"" [sets-set-member sets sets-tree-value-of tree sets-set-delete newset] 4] sets-make-set] 4 "\ Return the intersection of all the set arguments. That is, the returned set will contain all the common elements of the sets passed to this function."]) (byte-code "MMMM" [sets-type #[(object) ";‡9Ç!Ň:Ƈ!ȇ!ʇ!̇!·χ" [object number string symbol sets-setp set cons vectorp vector markerp marker bufferp buffer windowp window exotic] 2] sets-= #[(p q) ": : =! ! =??:: :@ @\"A Ad \")!G\n \n GU?? \nW H  H\" T c+!! !U! !*" [p q sets-type type-q type-p t return-value sets-= vectorp 0 stop-at i sets-setp sets-id-of prin1-to-string] 5] sets-< #[(p q) " !\n! = \nW > \n ! \nW : :\n: @\n@\" A\nAh \n\" ! G   \nGU \nGWʪ  W  H\n H\" T c? \n\"+ ! !\n!W !\n!*" [sets-type p q type-q type-p (string symbol) markerp sets-= sets-< vectorp t 0 stop-at i return-value sets-setp sets-id-of prin1-to-string] 5] sets-copy-set #[(set) " ! ! !\" !\" )" [sets-check-set set sets-make-set sets-=-function-of sets-<-function-of newset sets-inorder-maptree sets-tree-of #[(tree) " !\"" [sets-set-insert newset sets-tree-value-of tree] 4]] 4]] 2) (fset 'sets-set #[(&rest items) " #" [apply sets-set-insert sets-make-set items] 4 "\ Returns a new set containing all of the arguments."]) (fset 'sets-mapset #[(function set) " ! ! \"" [sets-check-set set sets-inorder-maptreevalues sets-tree-of function] 3 "\ Call FUNCTION with each element of SET as an argument."])