Create a gist now

Instantly share code, notes, and snippets.

@mnzk /mycompose.rkt
Last active Aug 29, 2015

What would you like to do?
#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))))
#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)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment