fork download 
  1. #lang racket/base
  2.  
  3. (require (only-in describe variant))
  4.  
  5. (define (type? object type-specifier)
  6.   (case (variant object)
  7.     ((simple) (or (eq? 'simple type-specifier)
  8.                   (cond ((number? object)
  9.                          (or (eq? 'number type-specifier)
  10.                              (if (real? object)
  11.                                  (or (eq? 'real type-specifier)
  12.                                      (if (exact? object)
  13.                                          (or (eq? 'exact type-specifier)
  14.                                              (and (integer? object)
  15.                                                   (eq? 'integer type-specifier)))
  16.                                          (and (inexact? object)
  17.                                               (eq? 'inexact type-specifier))))
  18.                                  (and (complex? object)
  19.                                       (eq? 'complex type-specifier)))))
  20.                         ((null? object)
  21.                          (eq? 'null type-specifier))
  22.                         ((char? object)
  23.                          (eq? 'character type-specifier))
  24.                         (else (and (boolean? object)
  25.                                    (eq? 'boolean type-specifier))))))
  26.     ((pair) (or (eq? 'pair type-specifier)
  27.                 (and (list? object)
  28.                      (eq? 'list type-specifier))))
  29.     ((type-specifier) #t)
  30.     (else #f)))
  31.  
  32. (define-syntax typecase
  33.   (syntax-rules (else)
  34.     ((_ test-key
  35.         (else e1 ...))
  36.      (begin e1 ...))
  37.     ((_ test-key
  38.         (type form ...))
  39.      (when (type? test-key 'type)
  40.        form ...))
  41.     ((_ test-key
  42.         (type form ...) e1 ...)
  43.      (if (type? test-key 'type)
  44.          (begin form ...)
  45.          (typecase test-key
  46.                    e1 ...)))))
Runtime error #stdin #stdout #stderr 0.48s 70844KB
comments (?)
stdin 
Standard input is empty
stdout 
Standard output is empty
stderr 
standard-module-name-resolver: collection not found
  for module path: describe
  collection: "describe"
  in collection directories:
   /home/kRNEhI/.racket/7.0/collects
   /usr/share/racket/collects
   ... [161 additional linked and package directories]
  context...:
   show-collection-err
   standard-module-name-resolver
   syntax-local-module-exports
   /usr/share/racket/collects/racket/require-transform.rkt:266:2: expand-import
   /usr/share/racket/collects/racket/private/reqprov.rkt:439:5
   /usr/share/racket/collects/racket/require-transform.rkt:266:2: expand-import
   /usr/share/racket/collects/racket/private/reqprov.rkt:266:21: try-next
   /usr/share/racket/collects/racket/private/reqprov.rkt:243:2: require
   apply-transformer-in-context
   apply-transformer52
   dispatch-transformer41
   do-local-expand50
   /usr/share/racket/collects/syntax/wrap-modbeg.rkt:46:4: do-wrapping-module-begin
   apply-transformer-in-context
   apply-transformer52
   dispatch-transformer41
   ...
https://ideone.com/pUo95b
language:
Racket (racket 7.0)
created:
2 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!