artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

scm: Add compose.

Browse source 
* module/mes/scm.mes (compose): New function.
* tests/scm.test ("compose"): New test.
This commit is contained in:
Jan Nieuwenhuizen 2017-03-27 00:35:36 +02:00
parent 22880ac831
commit 58dfe0b7bd
2 changed files with 8 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
module/mes/scm.mes
View file

@ -183,6 +183,11 @@
(define (delq x lst) (define (delq x lst)
(filter (lambda (e) (not (eq? e x))) lst)) (filter (lambda (e) (not (eq? e x))) lst))
(define (compose proc . rest)
(if (null? rest) proc
(lambda args
(proc (apply (apply compose rest) args)))))
;; Vector ;; Vector
(define (vector . rest) (list->vector rest)) (define (vector . rest) (list->vector rest))

4
tests/scm.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of Mes. ;;; This file is part of Mes.
;;; ;;;
@ -136,4 +136,6 @@ exit $?
(pass-if "char-alphabetic?" (seq? (char-alphabetic? #\a) #t)) (pass-if "char-alphabetic?" (seq? (char-alphabetic? #\a) #t))
(pass-if "char-alphabetic? 2" (seq? (char-alphabetic? #\[) #f)) (pass-if "char-alphabetic? 2" (seq? (char-alphabetic? #\[) #f))
(pass-if-equal "compose" 1 ((compose car cdr car) '((0 1 2))))
(result 'report) (result 'report)