From d295ee5668299de4bc54594dce5ac20f70461ef3 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 24 Dec 2016 08:34:19 +0100
Subject: [PATCH] Import srfi-26 from Guile.

* module/srfi/srfi-26.scm: Import.
* module/srfi/srfi-26.mes: Include it.
* AUTHORS: Mention it.
---
 AUTHORS                 |  3 +++
 module/srfi/srfi-26.mes | 28 +++++++++++++++++++++++
 module/srfi/srfi-26.scm | 49 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 80 insertions(+)
 create mode 100644 module/srfi/srfi-26.mes
 create mode 100644 module/srfi/srfi-26.scm

diff --git a/AUTHORS b/AUTHORS
index 625511e5..f020fe53 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -35,5 +35,8 @@ module/mes/pmatch.scm
 Srfi-1 bits from Guile
 module/srfi/srfi-1.scm
 
+Srfi-26 from Guile
+module/srfi/srfi-26.scm
+
 Sxml bits from Guile
 module/sxml/xpath.scm
\ No newline at end of file
diff --git a/module/srfi/srfi-26.mes b/module/srfi/srfi-26.mes
new file mode 100644
index 00000000..a22c2822
--- /dev/null
+++ b/module/srfi/srfi-26.mes
@@ -0,0 +1,28 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; srfi-26.mes - cut, cute
+
+(mes-use-module (mes scm))
+(mes-use-module (mes guile))
+(mes-use-module (srfi srfi-1))
+(include-from-path "srfi/srfi-26.scm")
diff --git a/module/srfi/srfi-26.scm b/module/srfi/srfi-26.scm
new file mode 100644
index 00000000..410d2e2f
--- /dev/null
+++ b/module/srfi/srfi-26.scm
@@ -0,0 +1,49 @@
+;;; srfi-26.scm --- specializing parameters without currying.
+
+;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 2.1 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (srfi srfi-26)
+  :export (cut cute))
+
+(cond-expand-provide (current-module) '(srfi-26))
+
+(define-macro (cut slot . slots)
+  (let loop ((slots	(cons slot slots))
+	     (params	'())
+	     (args	'()))
+    (if (null? slots)
+	`(lambda ,(reverse! params) ,(reverse! args))
+      (let ((s	  (car slots))
+	    (rest (cdr slots)))
+	(case s
+	  ((<>)
+	   (let ((var (gensym)))
+	     (loop rest (cons var params) (cons var args))))
+	  ((<...>)
+	   (if (pair? rest)
+	       (error "<...> not on the end of cut expression"))
+	   (let ((var (gensym)))
+	     `(lambda ,(append! (reverse! params) var)
+		(apply ,@(reverse! (cons var args))))))
+	  (else
+	   (loop rest params (cons s args))))))))
+
+(define-macro (cute . slots)
+  (let ((temp (map (lambda (s) (and (not (memq s '(<> <...>))) (gensym)))
+		   slots)))
+    `(let ,(delq! #f (map (lambda (t s) (and t (list t s))) temp slots))
+       (cut ,@(map (lambda (t s) (or t s)) temp slots)))))