match.scm 2.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364
  1. ;;; -*- mode: scheme; coding: utf-8; -*-
  2. ;;;
  3. ;;; Copyright (C) 2010, 2011, 2012, 2020 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. ;; Support for record matching.
  26. ;; For backwards compatibility with previously-compiled files, keep the
  27. ;; old definition of "error" around.
  28. (define (error _ . args)
  29. (apply throw 'match-error "match" args))
  30. ;; FIXME: In 3.1.x, use this new definition:
  31. ;; (define-syntax-rule (error where msg datum)
  32. ;; (throw 'match-error "match" msg datum))
  33. (define-syntax slot-ref
  34. (syntax-rules ()
  35. ((_ rtd rec n)
  36. (struct-ref rec n))))
  37. (define-syntax slot-set!
  38. (syntax-rules ()
  39. ((_ rtd rec n value)
  40. (struct-set! rec n value))))
  41. (define-syntax is-a?
  42. (syntax-rules ()
  43. ((_ rec rtd)
  44. (and (struct? rec)
  45. (eq? (struct-vtable rec) rtd)))))
  46. ;; Compared to Andrew K. Wright's `match', this one lacks `match-define',
  47. ;; `match:error-control', `match:set-error-control', `match:error',
  48. ;; `match:set-error', and all structure-related procedures. Also,
  49. ;; `match' doesn't support clauses of the form `(pat => exp)'.
  50. ;; Unmodified public domain code by Alex Shinn retrieved from
  51. ;; the Chibi-Scheme repository, commit 1206:acd808700e91.
  52. ;;
  53. ;; Note: Make sure to update `match.test.upstream' when updating this
  54. ;; file.
  55. (include-from-path "ice-9/match.upstream.scm")