module/slib/structst.scm

   1 ;"structst.scm" test "struct.scm"
   2 ;Copyright (C) 1993 Aubrey Jaffer
   3 ;
   4 ;Permission to copy this software, to redistribute it, and to use it
   5 ;for any purpose is granted, subject to the following restrictions and
   6 ;understandings.
   7 ;
   8 ;1.  Any copy made of this software must include this copyright notice
   9 ;in full.
  10 ;
  11 ;2.  I have made no warrantee or representation that the operation of
  12 ;this software will be error-free, and I am under no obligation to
  13 ;provide any services, by way of maintenance, update, or otherwise.
  14 ;
  15 ;3.  In conjunction with products arising from the use of this
  16 ;material, there shall be no use of my name in any advertising,
  17 ;promotional, or sales literature without prior written consent in
  18 ;each case.
  19
  20 (require 'struct)
  21
  22 (define-record foo (a b c))
  23 (define-record goo (xx yy))
  24
  25 (define a-foo (make-foo 1 2 3))
  26 (define a-goo (make-goo 4 5))
  27
  28 (define (struct:test)
  29   (define (t1 x)
  30     (variant-case x
  31       (foo (a b c) (list a b c))
  32       (goo (xx yy) (list xx yy))
  33       (else (list 7 8))))
  34   (write (append (t1 a-foo) (t1 a-goo) (t1 9)))
  35   (newline))
  36
  37 (struct:test)