www

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

percent.rkt (2633B)

      1 #lang typed/racket
      2 (require "typed-untyped.rkt")
      3 (define-typed/untyped-modules #:no-test
      4   (provide % define% in let1)
      5 
      6   (require (for-syntax syntax/parse
      7                        "typed-untyped.rkt")
      8            "in.rkt")
      9   (begin-for-syntax
     10     (if-typed (require phc-toolkit/aliases)
     11               (require phc-toolkit/untyped/aliases)))
     12 
     13   (define-syntax-rule (let1 var val . body)
     14     (let-values ([(var) val]) . body))
     15   
     16   #|(define-syntax (% stx)
     17   (syntax-parse stx #:literals (= → :)
     18     [(_ (~seq (~or ((~and var (~not :)) ...)
     19                    (~seq (~and var (~not (~or = → :))) ...)) = expr)
     20         ...
     21         (~optional (~literal →)) . body)
     22      #'(let-values ([(var ...) expr] ...) . body)]))|#
     23   
     24   (begin-for-syntax
     25     (define-syntax-class %pat
     26       (pattern v:id
     27                #:with expanded #'v)
     28       (pattern ()
     29                #:with expanded #'(list))
     30       (pattern (x:%pat . rest:%pat)
     31                #:with expanded #'(cons x.expanded rest.expanded))
     32       (pattern #(x:%pat …)
     33                #:with expanded #'(vector x.expanded …)))
     34     (define-splicing-syntax-class %assignment
     35       #:attributes ([pat.expanded 1] [expr 0])
     36       #:literals (= in)
     37       (pattern (~seq (~and maybe-pat (~not (~or = in))) ...
     38                      (~datum =) expr:expr)
     39                #:with [pat:%pat ...] #'(maybe-pat ...))))
     40   
     41   (define-syntax (% stx)
     42     (syntax-parse stx #:literals (= in)
     43       [(_ :%assignment ... (~optional (~literal in)) . body)
     44        #'(match-let*-values ([(pat.expanded ...) expr] ...) . body)]))
     45   
     46   (begin-for-syntax
     47     (define-syntax-class typed-pat
     48       (pattern [x:%pat (~literal :) type:expr]
     49                #:with (tmp) (generate-temporaries #'(x))
     50                #:with var-type #`[tmp : type]
     51                #:with (expanded ...) #'([x.expanded tmp]))
     52       (pattern x:id
     53                #:with var-type #'x
     54                #:with (expanded ...) #'())
     55       (pattern x:%pat
     56                #:with (tmp) (generate-temporaries #'(x))
     57                #:with var-type #'tmp
     58                #:with (expanded ...) #'([x.expanded tmp]))))
     59   
     60   (define-syntax (define% stx)
     61     (syntax-parse stx
     62       [(_ (name param:typed-pat ...)
     63           (~and (~seq ret ...) (~optional (~seq (~literal :) ret-type)))
     64           . body)
     65        #'(define (name param.var-type ...)
     66            (match-let (param.expanded ... ...) ret ... . body))]))
     67   
     68   #|
     69   (begin-for-syntax
     70     (define-syntax-class λ%expr
     71       (pattern e:id #:where (symbol->string e))
     72       (pattern e)
     73       (pattern (e . rest:λ%expr))))
     74   
     75   (define-syntax (λ% stx)
     76     (syntax-parse stx
     77       [(_ expr )]))
     78   |#)