match.scm 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  1. ;;; -*- mode: scheme; coding: utf-8; -*-
  2. ;;;
  3. ;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
  4. ;;;
  5. ;;; This library is free software; you can redistribute it and/or
  6. ;;; modify it under the terms of the GNU Lesser General Public
  7. ;;; License as published by the Free Software Foundation; either
  8. ;;; version 3 of the License, or (at your option) any later version.
  9. ;;;
  10. ;;; This library is distributed in the hope that it will be useful,
  11. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  13. ;;; Lesser General Public License for more details.
  14. ;;;
  15. ;;; You should have received a copy of the GNU Lesser General Public
  16. ;;; License along with this library; if not, write to the Free Software
  17. ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18. (define-module (ice-9 match)
  19. #:export (match
  20. match-lambda
  21. match-lambda*
  22. match-let
  23. match-let*
  24. match-letrec))
  25. (define (error _ . args)
  26. ;; Error procedure for run-time "no matching pattern" errors.
  27. (apply throw 'match-error "match" args))
  28. ;; Support for record matching.
  29. (define-syntax slot-ref
  30. (syntax-rules ()
  31. ((_ rtd rec n)
  32. (struct-ref rec n))))
  33. (define-syntax slot-set!
  34. (syntax-rules ()
  35. ((_ rtd rec n value)
  36. (struct-set! rec n value))))
  37. (define-syntax is-a?
  38. (syntax-rules ()
  39. ((_ rec rtd)
  40. (and (struct? rec)
  41. (eq? (struct-vtable rec) rtd)))))
  42. ;; Compared to Andrew K. Wright's `match', this one lacks `match-define',
  43. ;; `match:error-control', `match:set-error-control', `match:error',
  44. ;; `match:set-error', and all structure-related procedures. Also,
  45. ;; `match' doesn't support clauses of the form `(pat => exp)'.
  46. ;; Unmodified public domain code by Alex Shinn retrieved from
  47. ;; the Chibi-Scheme repository, commit 1206:acd808700e91.
  48. ;;
  49. ;; Note: Make sure to update `match.test.upstream' when updating this
  50. ;; file.
  51. (include-from-path "ice-9/match.upstream.scm")