;;;; 232.stk         -- SRFI 232 Flexible curried procedures.
;;;;                    Adapted for STklos
;;;;
;;;; Copyright © 2023 Jeronimo Pellegrini <j_p@aleph0.info>
;;;;
;;;;
;;;; This program 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 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program 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 this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Jeronimo Pellegrini [j_p@aleph0.info]
;;;;    Creation date: 01-Sep-2023 18:05
;;;;
;;;; This program uses the reference implementation of the SRFI by
;;;; Wolfgang Corcoran-Mathe, which is copyrighted as:
;;;;
;;;
;;; (C) 2022 Wolfgang Corcoran-Mathe
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation files
;;; (the "Software"), to deal in the Software without restriction,
;;; including without limitation the rights to use, copy, modify, merge,
;;; publish, distribute, sublicense, and/or sell copies of the Software,
;;; and to permit persons to whom the Software is furnished to do so,
;;; subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice (including the
;;; next paragraph) shall be included in all copies or substantial
;;; portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;;; SOFTWARE.


(define-module (srfi 232)
  (export curried
          curried-1
          one-or-more
          rest-args
          define-curried
          more-args)
   (import (scheme base)
           (scheme case-lambda))

(define-syntax curried
  (syntax-rules ()
    ((curried formals exp ...)
     (curried-1 formals (begin exp ...)))))

(define-syntax curried-1
  (syntax-rules ()
    ((curried-1 () exp) exp)
    ((curried-1 (arg0 arg1 ...) exp)
     (one-or-more (arg0 arg1 ...) exp))
    ((curried-1 (arg0 arg1 ... . rest) exp)
     (rest-args (arg0 arg1 ... . rest) exp))
    ((curried-1 args exp) (lambda args exp))))

(define-syntax one-or-more
  (syntax-rules ()
    ((one-or-more (arg0 arg1 ...) exp)
     (letrec
      ((f (case-lambda
            (() f)       ; app. to no args -> original function
            ((arg0 arg1 ...) exp)
            ((arg0 arg1 ... . rest)
             (apply (f arg0 arg1 ...) rest))
            (args (more-args f args)))))
       f))))

(define-syntax rest-args
  (syntax-rules ()
    ((rest-args (arg0 arg1 ... . rest) exp)
     (letrec ((f (case-lambda
                   (() f)
                   ((arg0 arg1 ... . rest) exp)
                   (args (more-args f args)))))
       f))))

(define (more-args f current)
  (lambda args (apply f (append current args))))

(define-syntax define-curried
  (syntax-rules ()
    ((define-curried (var . formals) exp ...)
     (define var
       (curried formals exp ...)))))
)

(provide "srfi/232")
