diff -Naur srfi-95-old/mulapply.scm srfi-95-new/mulapply.scm
--- srfi-95-old/mulapply.scm	1969-12-31 16:00:00.000000000 -0800
+++ srfi-95-new/mulapply.scm	2010-01-15 07:14:01.905945141 -0800
@@ -0,0 +1,29 @@
+; "mulapply.scm" Redefine APPLY take more than 2 arguments.
+;Copyright (C) 1991, 2003 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+;@
+(define apply
+  (letrec ((apply-2 apply)
+	   (append-to-last
+	    (lambda (lst)
+	      (if (null? (cdr lst))
+		  (car lst)
+		  (cons (car lst) (append-to-last (cdr lst)))))))
+    (lambda args
+      (apply-2 (car args) (append-to-last (cdr args))))))
+
diff -Naur srfi-95-old/srfi-95.meta srfi-95-new/srfi-95.meta
--- srfi-95-old/srfi-95.meta	1969-12-31 16:00:00.000000000 -0800
+++ srfi-95-new/srfi-95.meta	2010-01-15 07:14:01.905945141 -0800
@@ -0,0 +1,11 @@
+((egg "srfi-95.egg")
+ (files "vector-lib.scm"
+        "vector-lib.setup"
+        "mulapply.scm"
+        "TODO"
+        "tests/run.scm")
+ (category data)
+ (license "Public Domain")
+ (author "Richard A. O'Keefe, ported to hygienic Chicken with test suite by Peter Danenberg")
+ (synopsis "Sorting and merging")
+ (test-depends test))
diff -Naur srfi-95-old/srfi-95.scm srfi-95-new/srfi-95.scm
--- srfi-95-old/srfi-95.scm	1969-12-31 16:00:00.000000000 -0800
+++ srfi-95-new/srfi-95.scm	2010-01-15 07:14:01.905945141 -0800
@@ -0,0 +1,210 @@
+;;; "sort.scm" Defines: sorted?, merge, merge!, sort, sort!
+;;; Author : Richard A. O'Keefe (based on Prolog code by D.H.D.Warren)
+;;;
+;;; This code is in the public domain.
+
+;;; Updated: 11 June 1991
+;;; Modified for scheme library: Aubrey Jaffer 19 Sept. 1991
+;;; Updated: 19 June 1995
+;;; (sort, sort!, sorted?): Generalized to strings by jaffer: 2003-09-09
+;;; (sort, sort!, sorted?): Generalized to arrays by jaffer: 2003-10-04
+;;; jaffer: 2006-10-08:
+;;; (sort, sort!, sorted?, merge, merge!): Added optional KEY argument.
+;;; jaffer: 2006-11-05:
+;;; (sorted?, merge, merge!, sort, sort!): Call KEY arg at most once
+;;; per element.
+;;; jaffer: 2007-01-29: Final SRFI-95.
+
+;; (require 'array)
+;; (require 'multiarg-apply)		; used in SORT
+
+;;; chicken-specific module
+(module
+srfi-95
+(sorted? merge merge! sort sort!)
+
+(import scheme chicken)
+
+(use data-structures srfi-63)
+
+(include "mulapply.scm")
+
+;; (define identity (lambda x x))
+
+;;; (sorted? sequence less?)
+;;; is true when sequence is a list (x0 x1 ... xm) or a vector #(x0 ... xm)
+;;; such that for all 1 <= i <= m,
+;;;	(not (less? (list-ref list i) (list-ref list (- i 1)))).
+;@
+(define (sorted? seq less? . opt-key)
+  (define key (if (null? opt-key) identity (car opt-key)))
+  (cond ((null? seq) #t)
+	((array? seq)
+	 (let ((dimax (+ -1 (car (array-dimensions seq)))))
+	   (or (<= dimax 1)
+	       (let loop ((idx (+ -1 dimax))
+			  (last (key (array-ref seq dimax))))
+		 (or (negative? idx)
+		     (let ((nxt (key (array-ref seq idx))))
+		       (and (less? nxt last)
+			    (loop (+ -1 idx) nxt))))))))
+	((null? (cdr seq)) #t)
+	(else
+	 (let loop ((last (key (car seq)))
+		    (next (cdr seq)))
+	   (or (null? next)
+	       (let ((nxt (key (car next))))
+		 (and (not (less? nxt last))
+		      (loop nxt (cdr next)))))))))
+
+;;; (merge a b less?)
+;;; takes two lists a and b such that (sorted? a less?) and (sorted? b less?)
+;;; and returns a new list in which the elements of a and b have been stably
+;;; interleaved so that (sorted? (merge a b less?) less?).
+;;; Note:  this does _not_ accept arrays.  See below.
+;@
+(define (merge a b less? . opt-key)
+  (define key (if (null? opt-key) identity (car opt-key)))
+  (cond ((null? a) b)
+	((null? b) a)
+	(else
+	 (let loop ((x (car a)) (kx (key (car a))) (a (cdr a))
+		    (y (car b)) (ky (key (car b))) (b (cdr b)))
+	   ;; The loop handles the merging of non-empty lists.  It has
+	   ;; been written this way to save testing and car/cdring.
+	   (if (less? ky kx)
+	       (if (null? b)
+		   (cons y (cons x a))
+		   (cons y (loop x kx a (car b) (key (car b)) (cdr b))))
+	       ;; x <= y
+	       (if (null? a)
+		   (cons x (cons y b))
+		   (cons x (loop (car a) (key (car a)) (cdr a) y ky b))))))))
+
+(define (sort:merge! a b less? key)
+  (define (loop r a kcara b kcarb)
+    (cond ((less? kcarb kcara)
+	   (set-cdr! r b)
+	   (if (null? (cdr b))
+	       (set-cdr! b a)
+	       (loop b a kcara (cdr b) (key (cadr b)))))
+	  (else				; (car a) <= (car b)
+	   (set-cdr! r a)
+	   (if (null? (cdr a))
+	       (set-cdr! a b)
+	       (loop a (cdr a) (key (cadr a)) b kcarb)))))
+  (cond ((null? a) b)
+	((null? b) a)
+	(else
+	 (let ((kcara (key (car a)))
+	       (kcarb (key (car b))))
+	   (cond
+	    ((less? kcarb kcara)
+	     (if (null? (cdr b))
+		 (set-cdr! b a)
+		 (loop b a kcara (cdr b) (key (cadr b))))
+	     b)
+	    (else			; (car a) <= (car b)
+	     (if (null? (cdr a))
+		 (set-cdr! a b)
+		 (loop a (cdr a) (key (cadr a)) b kcarb))
+	     a))))))
+
+;;; takes two sorted lists a and b and smashes their cdr fields to form a
+;;; single sorted list including the elements of both.
+;;; Note:  this does _not_ accept arrays.
+;@
+(define (merge! a b less? . opt-key)
+  (sort:merge! a b less? (if (null? opt-key) identity (car opt-key))))
+
+(define (sort:sort-list! seq less? key)
+  (define keyer (if key car identity))
+  (define (step n)
+    (cond ((> n 2) (let* ((j (quotient n 2))
+			  (a (step j))
+			  (k (- n j))
+			  (b (step k)))
+		     (sort:merge! a b less? keyer)))
+	  ((= n 2) (let ((x (car seq))
+			 (y (cadr seq))
+			 (p seq))
+		     (set! seq (cddr seq))
+		     (cond ((less? (keyer y) (keyer x))
+			    (set-car! p y)
+			    (set-car! (cdr p) x)))
+		     (set-cdr! (cdr p) '())
+		     p))
+	  ((= n 1) (let ((p seq))
+		     (set! seq (cdr seq))
+		     (set-cdr! p '())
+		     p))
+	  (else '())))
+  (define (key-wrap! lst)
+    (cond ((null? lst))
+	  (else (set-car! lst (cons (key (car lst)) (car lst)))
+		(key-wrap! (cdr lst)))))
+  (define (key-unwrap! lst)
+    (cond ((null? lst))
+	  (else (set-car! lst (cdar lst))
+		(key-unwrap! (cdr lst)))))
+  (cond (key
+	 (key-wrap! seq)
+	 (set! seq (step (length seq)))
+	 (key-unwrap! seq)
+	 seq)
+	(else
+	 (step (length seq)))))
+
+(define (rank-1-array->list array)
+  (define dimensions (array-dimensions array))
+  (do ((idx (+ -1 (car dimensions)) (+ -1 idx))
+       (lst '() (cons (array-ref array idx) lst)))
+      ((< idx 0) lst)))
+
+;;; (sort! sequence less?)
+;;; sorts the list, array, or string sequence destructively.  It uses
+;;; a version of merge-sort invented, to the best of my knowledge, by
+;;; David H. D. Warren, and first used in the DEC-10 Prolog system.
+;;; R. A. O'Keefe adapted it to work destructively in Scheme.
+;;; A. Jaffer modified to always return the original list.
+;@
+(define (sort! seq less? . opt-key)
+  (define key (if (null? opt-key) #f (car opt-key)))
+  (cond ((array? seq)
+	 (let ((dims (array-dimensions seq)))
+	   (do ((sorted (sort:sort-list! (rank-1-array->list seq) less? key)
+			(cdr sorted))
+		(i 0 (+ i 1)))
+	       ((null? sorted) seq)
+	     (array-set! seq (car sorted) i))))
+	(else			      ; otherwise, assume it is a list
+	 (let ((ret (sort:sort-list! seq less? key)))
+	   (if (not (eq? ret seq))
+	       (do ((crt ret (cdr crt)))
+		   ((eq? (cdr crt) seq)
+		    (set-cdr! crt ret)
+		    (let ((scar (car seq)) (scdr (cdr seq)))
+		      (set-car! seq (car ret)) (set-cdr! seq (cdr ret))
+		      (set-car! ret scar) (set-cdr! ret scdr)))))
+	   seq))))
+
+;;; (sort sequence less?)
+;;; sorts a array, string, or list non-destructively.  It does this
+;;; by sorting a copy of the sequence.  My understanding is that the
+;;; Standard says that the result of append is always "newly
+;;; allocated" except for sharing structure with "the last argument",
+;;; so (append x '()) ought to be a standard way of copying a list x.
+;@
+(define (sort seq less? . opt-key)
+  (define key (if (null? opt-key) #f (car opt-key)))
+  (cond ((array? seq)
+	 (let ((dims (array-dimensions seq)))
+	   (define newra (apply make-array seq dims))
+	   (do ((sorted (sort:sort-list! (rank-1-array->list seq) less? key)
+			(cdr sorted))
+		(i 0 (+ i 1)))
+	       ((null? sorted) newra)
+	     (array-set! newra (car sorted) i))))
+	(else (sort:sort-list! (append seq '()) less? key))))
+
+)
diff -Naur srfi-95-old/srfi-95.setup srfi-95-new/srfi-95.setup
--- srfi-95-old/srfi-95.setup	1969-12-31 16:00:00.000000000 -0800
+++ srfi-95-new/srfi-95.setup	2010-01-15 07:14:01.906944836 -0800
@@ -0,0 +1,9 @@
+;;; -*- Hen -*-
+
+(include "setup-helper")
+
+(verify-extension-name "srfi-95")
+
+(setup-shared-extension-module
+ 'srfi-95
+ (extension-version 1.2))
diff -Naur srfi-95-old/tests/run.scm srfi-95-new/tests/run.scm
--- srfi-95-old/tests/run.scm	1969-12-31 16:00:00.000000000 -0800
+++ srfi-95-new/tests/run.scm	2010-01-15 07:15:15.341943083 -0800
@@ -0,0 +1,37 @@
+(use srfi-95 test)
+
+(test-group
+ "srfi-95"
+
+ (test-assert
+  "sorted?"
+  (sorted? '(1 2 3) <))
+
+ (test
+  "sorted? with unsorted"
+  #f
+  (sorted? '(1 2 3) >))
+
+ (test-assert
+  "sorted? with key"
+  (sorted? '(#\a #\b #\c) < char->integer))
+
+ (test
+  "merge"
+  '(1 2 3 4 5 6)
+  (merge '(1 2 3) '(4 5 6) <))
+
+ (test
+  "merge!"
+  '(1 2 3 4 5 6)
+  (merge! '(1 2 3) '(4 5 6) <))
+
+ (test
+  "sort"
+  '(1 2 3)
+  (sort '(3 2 1) <))
+
+ (test
+  "sort!"
+  '(1 2 3)
+  (sort! '(3 2 1) <)))
diff -Naur srfi-95-old/TODO srfi-95-new/TODO
--- srfi-95-old/TODO	1969-12-31 16:00:00.000000000 -0800
+++ srfi-95-new/TODO	2010-01-15 07:14:01.904963845 -0800
@@ -0,0 +1,5 @@
+# -*- mode: org; -*-
+* TODO identity
+  do we really need to import data-structures just for identity?
+* TODO mulapply
+  do we really need to include mulapply.scm?