Scheme comm(1) implementation

comm.rkt

(require srfi/1)
(define (comm list1 list2 (lt? <))
  (define (reverse-values . lists)
    (apply values (map reverse lists)))
  (let loop ((list1 list1)  ;; Assumed to be sorted
             (list2 list2)  ;; Assumed to be sorted
             (only1 '())
             (only2 '())
             (both '()))
    (cond ((null? list1)
           (reverse-values only1 (append-reverse list2 only2) both))
          ((null? list2)
           (reverse-values (append-reverse list1 only1) only2 both))
          (else
           (let ((elem1 (car list1))
                 (elem2 (car list2)))
             (cond ((lt? elem1 elem2)
                    (loop (cdr list1) list2 (cons elem1 only1) only2 both))
                   ((lt? elem2 elem1)
                    (loop list1 (cdr list2) only1 (cons elem2 only2) both))
                   (else
                    (loop (cdr list1) (cdr list2) only1 only2 (cons elem1 both)))))))))

comm.sweet

#lang planet asumu/sweet racket
require srfi/1

define comm(list1 list2 lt?(<))
  define reverse-values
    lambda lists
      apply values map(reverse lists)
  let loop
    group
      list1 list1  ;; Assumed to be sorted
      list2 list2  ;; Assumed to be sorted
      only1 '()
      only2 '()
      both '()
    cond
      null?(list1)
        reverse-values only1 {list2 append-reverse only2} both
      null?(list2)
        reverse-values {list1 append-reverse only1} only2 both
      else
        let
          group
            elem1 car(list1)
            elem2 car(list2)
          cond
            {elem1 lt? elem2}
              loop cdr(list1) list2 {elem1 cons only1} only2 both
            {elem2 lt? elem1}
              loop list1 cdr(list2) only1 {elem2 cons only2} both
            else
              loop cdr(list1) cdr(list2) only1 only2 {elem1 cons both}