; .EnTete "Le-Lisp (c) version 15.2" " " "Les Tris physiques"
; .EnPied "sort.ll" "H-%" " "
; .Annexe H "Les Tris physiques"
; .nr % 1
;
; .Centre "*****************************************************************"
; .Centre " Ce fichier est en lecture seule hors du projet ALE de l'INRIA.  "
; .Centre " Il est maintenu par ILOG SA, 2 Avenue Gallie'ni, 94250 Gentilly "
; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA                 "
; .Centre "*****************************************************************"

; .Centre "$Header: sort.ll,v 4.2 88/08/16 15:55:16 kuczynsk Exp $"

(unless (>= (version) 15.2)
        (error 'load 'erricf 'sort))

; Toutes ces fonctions sont "autoload" dans le syste`me minimum.
 
(de sort (fn l)
    ; trie (au moyen de la fonction fn a` 2 arguments) la liste l
    (if (null (cdr l))
        l
	 (let ((l1 l) (l2))
	      (setq l  (nthcdr (1- (div (length l) 2)) l)
		    l2 (cdr l))
	      (rplacd l ())
	      (ffusion (sort fn l1)
		       (sort fn l2)))))

 (de ffusion (l1 l2)
     ; fusionne physiquement les 2 listes trie'es l1 et l2
     (unless (funcall fn (car l1) (car l2))
	     (psetq l1 l2 l2 l1))
     (prog1 l1
	    (while (and (cdr l1) l2)
		   (when (funcall fn (car l2)(cadr l1))
			 (rplacd l1 (prog1 l2 (setq l2 (cdr l1)))))
		   (nextl l1))
	    (when l2 (rplacd l1 l2))))

 ; Les tris pre'de'finis

 (de sortl (l)
     ; tri classique alphabe'tique.
     (sort 'alphalessp l))

 (de sortn (l)
     ; tri nume'rique
     (sort '< l))

 (de sortp (l)
     ; tri sur les noms des symboles avec les packages 
     (sort 'pkgcmp l))

 (de pkgcmp (a b)                         
     ; compare 2 symboles en conside'rant que
     ; les packages font partie du nom.
     ; Si non symbole: place' devant.
     (if (eq (packagecell a) (packagecell b))
         (alphalessp a b)
         (let ((pa (packagecell a)))
           (or (not (symbolp pa))
               (let ((pb (packagecell b)))
                 (and (symbolp pb)
                      (pkgcmp pa pb))))) ))