[PHP-DOC] cvs: phpdoc / common.dsl.in From: Hartmut Holzgraefe (hartmut <email protected>)
Date: 10/09/00

hholzgra Mon Oct 9 07:49:57 2000 EDT

  Modified files:
    /phpdoc common.dsl.in
  Log:
  added quicksort code (taken from dsssl mailing list) for later use
  
  
Index: phpdoc/common.dsl.in
diff -u phpdoc/common.dsl.in:1.6 phpdoc/common.dsl.in:1.7
--- phpdoc/common.dsl.in:1.6 Sun Aug 13 17:19:36 2000
+++ phpdoc/common.dsl.in Mon Oct 9 07:49:56 2000
@@ -1,6 +1,6 @@
 ;; -*- Scheme -*-
 ;;
-;; $Id: common.dsl.in,v 1.6 2000/08/14 00:19:36 jah Exp $
+;; $Id: common.dsl.in,v 1.7 2000/10/09 14:49:56 hholzgra Exp $
 ;;
 ;; This file contains stylesheet customization common to the HTML
 ;; and print versions.
@@ -29,3 +29,44 @@
 (define (php-code code)
   (make processing-instruction
     data: (string-append "php " code "?")))
+
+(define quicksort
+ (quicksort::generic null? car cdr append cons '()))
+
+(define nl-quicksort
+ (quicksort::generic node-list-empty?
+ node-list-first
+ node-list-rest
+ node-list
+ node-list
+ (empty-node-list)))
+
+(define quicksort::generic
+ (lambda(is-null? first others concat add empty)
+ (letrec ((collect
+ ;; Collect is an helper function doing the real work
+
+ (lambda (pivot ls lgroup rgroup less?)
+ (if (is-null? ls)
+ (concat (impl lgroup less?)
+ (add pivot (impl rgroup less?)))
+ (if (less? pivot (first ls))
+ (collect pivot (others ls) lgroup
+ (add (first ls) rgroup)
+ less?)
+ (collect pivot (others ls)
+ (add (first ls) lgroup)
+ rgroup
+ less?)))))
+ (impl
+ ;; impl first test some trivial sorting case and then call
+ ;; the procedure collect
+ (lambda (ls less?)
+ (if (or (is-null? ls) (is-null? (others ls)))
+ ls
+ (collect (first ls) (others ls) empty empty less?)))))
+ ;; we return the new defined procedure
+ impl)))
+
+
+