Changeset 7884 in project


Ignore:
Timestamp:
01/23/08 22:26:16 (12 years ago)
Author:
Kon Lovett
Message:

Added 'select' macro. Not the best impl though.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/syntax-case/syntax-case-chicken-macros.scm

    r7232 r7884  
    303303        (letrec-values "INTERNAL1" bindings () (let () body1 ...)) ) ] ) ) )
    304304
    305 (define-syntax switch
     305(define-syntax select
     306  (lambda (x)
     307    (syntax-case x (else)
     308      ((_ v (else e1 e2 ...))
     309       (syntax (begin e1 e2 ...)))
     310      ((_ v ((k1 ...) e1 e2 ...))
     311       (syntax (let ((x v))
     312                 (if (or (eqv? x k1) ...) (begin e1 e2 ...)) ) ) )
     313      ((_ v ((k1 ...) e1 e2 ...) c1 c2 ...)
     314       (syntax (let ((x v))
     315                 (if (or (eqv? x k1) ...)
     316                     (begin e1 e2 ...)
     317                     (select x c1 c2 ...))))))) )
     318
     319#; ; Working on it
     320(define-syntax select
     321  (lambda (x)
     322    (syntax-case x (else)
     323      [(_ v (else e1 ...))
     324       (syntax (begin e1 ...))]
     325      [(SK v ((k1 ...) e1 ...) c1 ...)
     326       (with-syntax ([VAL (datum->syntax-object (syntax SK) 'x)])
     327         (syntax (let ([VAL v])
     328                   (letrec-syntax ([expbod
     329                                     (syntax-rules (else)
     330                                       [(_ (else e1 ...))
     331                                        (begin e1 ...) ]
     332                                       [(_ ((k1 ...) e1 ...))
     333                                        (if (or (eqv? VAL k1) ...)
     334                                            (begin e1 ...)) ]
     335                                       [(_ ((k1 ...) e1 ...) c1 ...)
     336                                        (if (or (eqv? VAL k1) ...)
     337                                            (begin e1 ...)
     338                                            (expbod c1 ...)) ] ) ] )
     339                     (expbod ((k1 ...) e1 ...) c1 ...)))) ) ] ) ) )
     340
     341(define-syntax switch                   ; DEPRECATED
    306342  (lambda (x)
    307343    (syntax-case x (else)
Note: See TracChangeset for help on using the changeset viewer.