home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / srfi / srfi-9.scm < prev   
Encoding:
Text File  |  2008-12-17  |  2.7 KB  |  92 lines
  1. ;;; srfi-9.scm --- define-record-type
  2.  
  3. ;;     Copyright (C) 2001, 2002, 2006 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 2.1 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.  
  19. ;;; Commentary:
  20.  
  21. ;; This module exports the syntactic form `define-record-type', which
  22. ;; is the means for creating record types defined in SRFI-9.
  23. ;;
  24. ;; The syntax of a record type definition is:
  25. ;;
  26. ;;  <record type definition>
  27. ;;    -> (define-record-type <type name>
  28. ;;         (<constructor name> <field tag> ...)
  29. ;;         <predicate name>
  30. ;;         <field spec> ...)
  31. ;;
  32. ;;  <field spec> -> (<field tag> <accessor name>)
  33. ;;               -> (<field tag> <accessor name> <modifier name>)
  34. ;;
  35. ;;  <field tag> -> <identifier>
  36. ;;  <... name>  -> <identifier>
  37. ;;
  38. ;; Usage example:
  39. ;;
  40. ;; guile> (use-modules (srfi srfi-9))
  41. ;; guile> (define-record-type :foo (make-foo x) foo?
  42. ;;                            (x get-x) (y get-y set-y!))
  43. ;; guile> (define f (make-foo 1))
  44. ;; guile> f
  45. ;; #<:foo x: 1 y: #f>
  46. ;; guile> (get-x f)
  47. ;; 1
  48. ;; guile> (set-y! f 2)
  49. ;; 2
  50. ;; guile> (get-y f)
  51. ;; 2
  52. ;; guile> f
  53. ;; #<:foo x: 1 y: 2>
  54. ;; guile> (foo? f)
  55. ;; #t
  56. ;; guile> (foo? 1)
  57. ;; #f
  58.  
  59. ;;; Code:
  60.  
  61. (define-module (srfi srfi-9)
  62.   :export-syntax (define-record-type))
  63.  
  64. (cond-expand-provide (current-module) '(srfi-9))
  65.  
  66. (define-macro (define-record-type type-name constructor/field-tag
  67.         predicate-name . field-specs)
  68.   `(begin
  69.      (define ,type-name
  70.        (make-record-type ',type-name ',(map car field-specs)))
  71.      (define ,(car constructor/field-tag)
  72.        (record-constructor ,type-name ',(cdr constructor/field-tag)))
  73.      (define ,predicate-name
  74.        (record-predicate ,type-name))
  75.      ,@(map
  76.     (lambda (spec)
  77.       (cond
  78.        ((= (length spec) 2)
  79.         `(define ,(cadr spec)
  80.            (record-accessor ,type-name ',(car spec))))
  81.        ((= (length spec) 3)
  82.         `(begin
  83.            (define ,(cadr spec)
  84.          (record-accessor ,type-name ',(car spec)))
  85.            (define ,(caddr spec)
  86.          (record-modifier ,type-name ',(car spec)))))
  87.        (else
  88.         (error "invalid field spec " spec))))
  89.     field-specs)))
  90.  
  91. ;;; srfi-9.scm ends here
  92.