Quick sorting of dune files (incomplete)

sort_dune.scm

#!/usr/bin/env -S csi -s
; This is a quick and dirty Chicken 5 script
; to help auto format dune config files
; It is incomplete since I did not want to take
; time to handle all stanza cases but it should be a decent
; base for a more complete script.
;
; Distributed under CC-0/Public domain with no guaranty.


(import scheme
        chicken.base
        chicken.sort
        chicken.pretty-print)

(define (read-all)
  (let loop ((acc '()))
    (let ((sexp (read)))
      (if (eof-object? sexp)
          (reverse acc)
          (loop (cons sexp acc))))))

(define (get-name sexp)
  (case (car sexp)
    ((executable library alias)
     (cadr (assoc 'name (cdr sexp))))
    (else
      (error "don't know how to order" (car sexp)))))

(define ordered-stanza
  '(alias
     install
     package
     library
     foreign_library
     executables
     executable
     documentation))

(define (index-of a lst)
  (let loop ((i 0) (rest lst))
    (if (null? rest)
        #f
        (if (eq? a (car rest))
            i
            (loop (+ 1 i) (cdr rest))))))

(define (symbol-comp s1 s2)
  (let ((n1 (symbol->string s1))
        (n2 (symbol->string s2)))
    (cond ((< n1 n2) 'less)
          ((> n1 n2) 'more)
          (#t 'equal))))

(define (stanza-order s1 s2)
  (let ((i1 (index-of s1 ordered-stanza))
        (i2 (index-of s2 ordered-stanza)))
    (cond ((and i1 (not i2) 'less)) ; i2 not in ordered-stanza
          ((and i2 (not i1) 'more)) ; i1 not in ordered-stanza
          ((and (not i1) (not i2)) ; both not in ordered-stanza
           (symbol-comp s1 s2))
          ; both in ordered-stanza
          ((= i1 i2) 'equal)
          ((< i1 i2) 'less)
          (#t 'more))))

(define (sexp-less? s1 s2)
  (case (stanza-order (car s1) (car s2))
    ((less) #t)
    ((more) #f)
    ((equal)
     (let ((n1 (symbol->string (get-name s1)))
           (n2 (symbol->string (get-name s2))))
       (string-ci<? n1 n2)))))

(define (for-each* f seq)
  (let loop ((rest seq))
    (cond
      ((null? rest) '())
      ((null? (cdr rest)) (f (car rest) #t) (loop (cdr rest)))
      (#t (f (car rest) #f) (loop (cdr rest))))))

(define (format-input)
  (for-each* (lambda (sexp last-one)
               (pp sexp)
               (unless last-one (newline)))
             (sort (read-all) sexp-less?)))

(format-input)