scm: Add compose.

* module/mes/scm.mes (compose): New function.
* tests/scm.test ("compose"): New test.

diff --git a/module/mes/scm.mes b/module/mes/scm.mes
index 56906640af5502934b5561148552501ad6c6de71..e04e982c03e2476d72f64f2ca69f9b6b0524ccf2 100644 (file)
--- a/module/mes/scm.mes
+++ b/module/mes/scm.mes
@@ -183,6 +183,11 @@
 (define (delq 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)))))
+
 \f
 ;; Vector
 (define (vector . rest) (list->vector rest))

diff --git a/tests/scm.test b/tests/scm.test
index 2f444255cb8baa2d25e80538c159b4bdd8345729..904c4b1005f8f93587c8af5b7e2924c819c88826 100755 (executable)
--- a/tests/scm.test
+++ b/tests/scm.test
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; 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.
 ;;;
@@ -136,4 +136,6 @@ exit $?
 (pass-if "char-alphabetic?" (seq? (char-alphabetic? #\a) #t))
 (pass-if "char-alphabetic? 2" (seq? (char-alphabetic? #\[) #f))
 
+(pass-if-equal "compose" 1 ((compose car cdr car) '((0 1 2))))
+
 (result 'report)