37 lines
1.5 KiB
Racket
37 lines
1.5 KiB
Racket
#lang typed/racket
|
|
|
|
(require (for-syntax syntax/parse
|
|
"../lib/low-untyped.rkt")
|
|
"../type-expander/type-expander.lp2.rkt")
|
|
|
|
(provide curry-map)
|
|
|
|
(begin-for-syntax
|
|
(define-syntax-class curry-map-rec
|
|
#:attributes (inner bottom bottom? wrap)
|
|
(pattern ((~lit curry) (~lit map) inner:curry-map-rec)
|
|
#:attr wrap (λ (x w) (w ((attribute inner.wrap) x w)))
|
|
#:attr bottom #'inner.bottom
|
|
#:attr bottom? #f)
|
|
(pattern f
|
|
#:attr wrap (λ (x w) x)
|
|
#:attr bottom #'f
|
|
#:attr bottom? #t
|
|
#:attr inner #f)))
|
|
|
|
(define-syntax (curry-map stx)
|
|
(syntax-parse stx
|
|
[(_ TVar Result-Type Element-Type f:curry-map-rec)
|
|
(if (attribute f.bottom?)
|
|
;; We use (ann λ type) instead of (λ #:∀ …) because as of version
|
|
;; 6.3.0.8--2015-12-17(0d633fe/a), the latter doesn't work if put in a
|
|
;; let's binding clause: (let ([f (λ #:∀ …)]) f) fails to typecheck.
|
|
#'(ann (λ (l) ((inst map Result-Type Element-Type) f l))
|
|
(∀ (TVar) (→ (Listof Element-Type)
|
|
(Listof Result-Type))))
|
|
#`(curry-map TVar
|
|
#,((attribute f.wrap) #'Result-Type
|
|
(λ (t) #`(Listof #,t)))
|
|
#,((attribute f.wrap) #'Element-Type
|
|
(λ (t) #`(Listof #,t)))
|
|
(curry-map TVar Result-Type Element-Type f.inner)))])) |