mycompose.rkt

#lang racket

(provide mycompose1
         mycompose)

(define-syntax mycompose1
  (syntax-rules ()
    ((_) values)
    ((_ f1 f2 ...)
     (lambda arglist (mycompose1$ arglist f1 f2 ...)))))

(define-syntax mycompose1$
  (syntax-rules ()
    ((_ arglist f) (apply f arglist))
    ((_ arglist f1 f2 ...)
     (f1 (mycompose1$ arglist f2 ...)))))


(define-syntax mycompose
  (syntax-rules ()
    ((_) values)
    ((_ f1 f2 ...)
     (lambda arglist (mycompose$ arglist f1 f2 ...)))))

(define-syntax mycompose$
  (syntax-rules ()
    ((_ arglist f) (apply f arglist))
    ((_ arglist f1 f2 ...)
     (call-with-values (thunk (mycompose$ arglist f2 ...))
       f1))))

test-mycompose.rkt

#lang racket

(require "mycompose.rkt")
(require rackunit)


(test-begin

 (test-case
  "test mycompose1"
  (check-eq? (mycompose1)
             (compose1)
             values)

  (check-equal? ((mycompose1 add1) 1)
                ((compose1 add1) 1))

  (let ((f (lambda (x y) (+ x y))))
    (check-equal? ((mycompose1 f) 1 2)
                  ((compose1 f) 1 2)))

  (let ((f (lambda () 1)))
    (check-equal? ((mycompose1 f))
                  ((compose1 f))))

  (check-equal? ((mycompose1 car cdr cdr) '(1 2 3 4 5))
                ((compose1 car cdr cdr)  '(1 2 3 4 5))
                (caddr '(1 2 3 4 5))))
 
 (test-case
  "test mycompose"

  (define (list->values lis) (apply values lis))

  (check-equal? ((mycompose + list->values range) 11)
                ((compose + list->values range) 11))

  (check-equal? ((mycompose + list->values range) 11)
                ((compose + list->values range) 11))

  (check-eq? (mycompose)
             (compose)
             values)

  (check-equal? ((mycompose add1) 1)
                ((compose add1) 1))

  (let ((f (lambda (x y) (+ x y))))
    (check-equal? ((mycompose f) 1 2)
                  ((compose f) 1 2)))

  (let ((f (lambda () 1)))
    (check-equal? ((mycompose f))
                  ((compose f))))
  
  (check-equal? ((mycompose car cdr cdr) '(1 2 3 4 5))
                ((compose car cdr cdr)  '(1 2 3 4 5))
                (caddr '(1 2 3 4 5)))))