Function: semanticdb-typecache-merge-streams

semanticdb-typecache-merge-streams is a byte-compiled function defined in db-typecache.el.gz.

Signature

(semanticdb-typecache-merge-streams CACHE1 CACHE2)

Documentation

Merge into CACHE1 and CACHE2 together. The Caches will be merged in place.

Source Code

;; Defined in /usr/src/emacs/lisp/cedet/semantic/db-typecache.el.gz
(defun semanticdb-typecache-merge-streams (cache1 cache2)
  "Merge into CACHE1 and CACHE2 together.  The Caches will be merged in place."
  (if (or (and (not cache1) (not cache2))
	  (and (not (cdr cache1)) (not cache2))
	  (and (not cache1) (not (cdr cache2))))
      ;; If all caches are empty OR
      ;; cache1 is length 1 and no cache2 OR
      ;; no cache1 and length 1 cache2
      ;;
      ;; then just return the cache, and skip all this merging stuff.
      (or cache1 cache2)

    ;; Assume we always have datatypes, as this typecache isn't really
    ;; useful without a typed language.
    (require 'semantic/sort)
    (let ((S (semantic-sort-tags-by-name-then-type-increasing
	      ;; I used to use append, but it copied cache1 but not cache2.
	      ;; Since sort was permuting cache2, I already had to make sure
	      ;; the caches were permute-safe.  Might as well use nconc here.
	      (nconc cache1 cache2)))
	  (ans nil)
	  (next nil)
	  (prev nil)
	  (type nil))
      ;; With all the tags in order, we can loop over them, and when
      ;; two have the same name, we can either throw one away, or construct
      ;; a fresh new tag merging the items together.
      (while S
	(setq prev (car ans))
	(setq next (car S))
	(if (or
	     ;; CASE 1 - First item
	     (null prev)
	     ;; CASE 2 - New name
	     (not (string= (semantic-tag-name next)
			   (semantic-tag-name prev))))
	    (setq ans (cons next ans))
	  ;; ELSE - We have a NAME match.
	  (setq type (semantic-tag-type next))
	  (if (or (semantic-tag-of-type-p prev type) ; Are they the same datatype
		  (semantic-tag-faux-p prev)
		  (semantic-tag-faux-p next) ; or either a faux tag?
		  )
	      ;; Same Class, we can do a merge.
	      (cond
	       ((and (semantic-tag-of-class-p next 'type)
		     (string= type "namespace"))
		;; Namespaces - merge the children together.
		(setcar ans
			(semanticdb-typecache-faux-namespace
			 (semantic-tag-name prev) ; - they are the same
			 (semanticdb-typecache-merge-streams
			  (semanticdb-typecache-safe-tag-members prev)
			  (semanticdb-typecache-safe-tag-members next))
			 ))
		)
	       ((semantic-tag-prototype-p next)
		;; NEXT is a prototype... so keep previous.
		nil			; - keep prev, do nothing
		)
	       ((semantic-tag-prototype-p prev)
		;; PREV is a prototype, but not next.. so keep NEXT.
		;; setcar - set by side-effect on top of prev
		(setcar ans next)
		)
	       (t
		;;(message "Don't know how to merge %s.  Keeping first entry." (semantic-tag-name next))
		))
	    ;; Not same class... but same name
					;(message "Same name, different type: %s, %s!=%s"
					;	   (semantic-tag-name next)
					;	   (semantic-tag-type next)
					;        (semantic-tag-type prev))
	    (setq ans (cons next ans))
	    ))
	(setq S (cdr S)))
      (nreverse ans))))