www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

lib.rkt (2981B)

      1 #lang racket/base
      2 (require "sc.rkt"
      3          syntax/parse/private/keywords
      4          (for-syntax syntax/parse/private/residual-ct)
      5          (for-syntax racket/base))
      6 
      7 (provide identifier
      8          boolean
      9          str
     10          character
     11          keyword
     12          number
     13          integer
     14          exact-integer
     15          exact-nonnegative-integer
     16          exact-positive-integer
     17 
     18          id
     19          nat
     20          char
     21 
     22          expr
     23          static)
     24 
     25 
     26 (define (expr-stx? x)
     27   (not (keyword-stx? x)))
     28 
     29 (define ((stxof pred?) x) (and (syntax? x) (pred? (syntax-e x))))
     30 (define keyword-stx? (stxof keyword?))
     31 (define boolean-stx? (stxof boolean?))
     32 (define string-stx? (stxof string?))
     33 (define bytes-stx? (stxof bytes?))
     34 (define char-stx? (stxof char?))
     35 (define number-stx? (stxof number?))
     36 (define integer-stx? (stxof integer?))
     37 (define exact-integer-stx? (stxof exact-integer?))
     38 (define exact-nonnegative-integer-stx? (stxof exact-nonnegative-integer?))
     39 (define exact-positive-integer-stx? (stxof exact-positive-integer?))
     40 
     41 
     42 ;; == Integrable syntax classes ==
     43 
     44 (define-integrable-syntax-class identifier (quote "identifier") identifier?)
     45 (define-integrable-syntax-class expr (quote "expression") expr-stx?)
     46 (define-integrable-syntax-class keyword (quote "keyword") keyword-stx?)
     47 (define-integrable-syntax-class boolean (quote "boolean") boolean-stx?)
     48 (define-integrable-syntax-class character (quote "character") char-stx?)
     49 (define-integrable-syntax-class number (quote "number") number-stx?)
     50 (define-integrable-syntax-class integer (quote "integer") integer-stx?)
     51 (define-integrable-syntax-class exact-integer (quote "exact-integer") exact-integer-stx?)
     52 (define-integrable-syntax-class exact-nonnegative-integer
     53   (quote "exact-nonnegative-integer")
     54   exact-nonnegative-integer-stx?)
     55 (define-integrable-syntax-class exact-positive-integer
     56   (quote "exact-positive-integer")
     57   exact-positive-integer-stx?)
     58 
     59 (define-integrable-syntax-class -string (quote "string") string-stx?)
     60 (define-integrable-syntax-class -bytes (quote "bytes") bytes-stx?)
     61 (begin-for-syntax
     62   (set-box! alt-stxclass-mapping
     63             (list (cons #'string (syntax-local-value #'-string))
     64                   (cons #'bytes  (syntax-local-value #'-bytes)))))
     65 
     66 ;; Aliases
     67 (define-syntax id (make-rename-transformer #'identifier))
     68 (define-syntax nat (make-rename-transformer #'exact-nonnegative-integer))
     69 (define-syntax char (make-rename-transformer #'character))
     70 (define-syntax str (make-rename-transformer #'-string))
     71 
     72 
     73 ;; == Normal syntax classes ==
     74 
     75 (define notfound (box 'notfound))
     76 
     77 (define-syntax-class (static pred [name #f])
     78   #:attributes (value)
     79   #:description name
     80   #:commit
     81   (pattern x:id
     82            #:fail-unless (syntax-transforming?)
     83                          "not within the dynamic extent of a macro transformation"
     84            #:attr value (syntax-local-value #'x (lambda () notfound))
     85            #:fail-when (eq? (attribute value) notfound) #f
     86            #:fail-unless (pred (attribute value)) #f))