Re: Sorted indexes and (string<?) in Jade

[Toby Speight <Toby.Speight@xxxxxxxxxxxxxx>]

Toby> Toby Speight <URL:mailto:Toby.Speight@xxxxxxxxxxxxxx>

0> In article <uk935xwou.fsf@xxxxxxxxxxxxxxxxxxx>, Toby wrote:

Toby> I now have a convertor from the tables supplied with Unicode
Toby> TR-10 into a DSSSL alist, written as a Makefile

... which produces something like


(define sorttable
  '(
   (#\U-0000 (#\* #x0000 #x0000 #x0000 #x0000)) ; NULL
   (#\U-0001 (#\* #x0000 #x0000 #x0000 #x0001)) ; START OF HEADING
   (#\U-0002 (#\* #x0000 #x0000 #x0000 #x0002)) ; START OF TEXT
   ;;...
   (#\U-00C6 (#\. #x06de #x0020 #x0008 #x00c6)) ; LATIN CAPITAL LETTER AE
   ;;...
   (#\U-00BE (#\. #x06d2 #x0020 #x0018 #x0033)
             (#\. #x0305 #x0020 #x0018 #x2044)
             (#\. #x06d3 #x0020 #x0018 #x0034))
                                 ; VULGAR FRACTION THREE QUARTERS; COMPATSEQ
   ;;...
   ))

And here is the code to use it (not at all optimised for either space
or speed):

(define (string-collator str)
  (let loop ((str-chars (string->list str))
             (coll '()))
    (if (zero? (length str-chars))
        coll
      (loop (cdr str-chars)
            (append coll (char-collator (car str-chars)))))))

(define (char-collator char)
  (cdr
   (or (assoc char sorttable)
       (error (string-append (string char) " has no collation entry")))))

;; logically, return c1-c2.  i.e. +ve if c1 sorts before c2
(define (collator-compare c1 c2 #!optional (level 0))
  ;; NB level is zero-based
  (let ((res (collator-compare-internal c1 c2 level)))
    (if (zero? res)
        (if (= level 3)
            0
          (collator-compare c1 c2 (+ level 1)))
      res)))

(define (collator-compare-internal c1 c2 level)
  ;; NB level is zero-based
  (cond ((null? c1) (if (null? c2) 0 -1))
        ((null? c2) 1)
        (else
         (let ((n1 (collator-get (car c1) level))
               (n2 (collator-get (car c2) level)))
           (cond ((= n1 n2)
                  (collator-compare-internal (cdr c1) (cdr c2) level))
                 ((zero? n1)
                  (collator-compare-internal (cdr c1) c2 level))
                 ((zero? n2)
                  (collator-compare-internal c1 (cdr c2) level))
                 (else (- n1 n2)))))))

;; true if spaces count in sorting - override if wanted
(define %spaces-significant% #f)

(define (collator-get c level)
  (if (and (not %spaces-significant%)
           (< level 3)
           (char=? (car c) #\*))
      0
    (list-ref c (+ 1 level))))

(define (char<? char-1 char-2)
  (negative? (collator-compare (char-collator char-1)
                               (char-collator char-2))))

(define (char>=? char-1 char-2)
  (not (char<? char-1 char-2)))

(define (char>? char-1 char-2)
  (positive? (collator-compare (char-collator char-1)
                               (char-collator char-2))))

(define (char<=? char-1 char-2)
  (not (char>? char-1 char-2)))

(define (string<? string-1 string-2)
  (negative? (collator-compare (string-collator string-1)
                               (string-collator string-2))))

(define (string>=? string-1 string-2)
  (not (string<? string-1 string-2)))

(define (string>? string-1 string-2)
  (positive? (collator-compare (string-collator string-1)
                               (string-collator string-2))))

(define (string<=? string-1 string-2)
  (not (string>? string-1 string-2)))


;;; positive? and negative? are in DSSSL but not Jade

(define (negative? x)
  (< x 0))

(define (positive? x)
  (> x 0))


Obviously, doing it in the expression language is far from ideal, but
at least it's a viable workaround.

-- 


 DSSSList info and archive:  http://www.mulberrytech.com/dsssl/dssslist