module/ice-9/curried-definitions.scm

   1 ;;; Copyright (C) 2010, 2013  Free Software Foundation, Inc.
   2 ;;;
   3 ;;;; This library is free software; you can redistribute it and/or
   4 ;;;; modify it under the terms of the GNU Lesser General Public
   5 ;;;; License as published by the Free Software Foundation; either
   6 ;;;; version 3 of the License, or (at your option) any later version.
   7 ;;;;
   8 ;;;; This library is distributed in the hope that it will be useful,
   9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;;;; Lesser General Public License for more details.
  12 ;;;;
  13 ;;;; You should have received a copy of the GNU Lesser General Public
  14 ;;;; License along with this library; if not, write to the Free Software
  15 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16
  17 (define-module (ice-9 curried-definitions)
  18   #:replace ((cdefine . define)
  19              (cdefine* . define*)
  20              define-public
  21              define*-public))
  22
  23 (define-syntax cdefine
  24   (syntax-rules ()
  25     ((_ (head . rest) body body* ...)
  26      (cdefine head
  27        (lambda rest body body* ...)))
  28     ((_ name val)
  29      (define name val))))
  30
  31 (define-syntax cdefine*
  32   (syntax-rules ()
  33     ((_ (head . rest) body body* ...)
  34      (cdefine* head
  35        (lambda* rest body body* ...)))
  36     ((_ name val)
  37      (define* name val))))
  38
  39 (define-syntax define-public
  40   (syntax-rules ()
  41     ((_ (head . rest) body body* ...)
  42      (define-public head
  43        (lambda rest body body* ...)))
  44     ((_ name val)
  45      (begin
  46        (define name val)
  47        (export name)))))
  48
  49 (define-syntax define*-public
  50   (syntax-rules ()
  51     ((_ (head . rest) body body* ...)
  52      (define*-public head
  53        (lambda* rest body body* ...)))
  54     ((_ name val)
  55      (begin
  56        (define* name val)
  57        (export name)))))