suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

map: works, tried adding multiple arguments, but it's more work than it's worth, and it should work fine with the regular map in most cases.

Browse Source
This commit is contained in:
Georges Dupéron 2016-01-14 22:58:39 +01:00
parent 7b0d40e700
commit 24618b5683
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
graph/graph/map.rkt
View File

@ -102,9 +102,9 @@
#:arg-funs () #:funs (identity))] #:arg-funs () #:funs (identity))]
[((~literal compose) f …) [((~literal compose) f …)
(syntax-parse (:map* #'(f …) #'(&l …) #'out) (syntax-parse (:map* #'(f …) #'(&l …) #'out)
[(~and (_ … first:map-info) (last:map-info . _) (:map-info …)) [(~and (_ … rightmost:map-info) (leftmost:map-info . _) (:map-info …))
#'(info #:in first.in-type #'(info #:in rightmost.in-type
#:out last.out-type #:out leftmost.out-type
#:∀ (∀-type … …) #:∀ (∀-type … …)
#:arg-funs ([arg-fun param-fun fun-in fun-out] … …) #:arg-funs ([arg-fun param-fun fun-in fun-out] … …)
#:funs (fun … …))])] #:funs (fun … …))])]
@ -131,10 +131,14 @@
#'(info #:in f/in #:out out #:∀ (f/in) #'(info #:in f/in #:out out #:∀ (f/in)
#:arg-funs ([f &f #:auto-in f/in out]) #:funs (&f))])) #:arg-funs ([f &f #:auto-in f/in out]) #:funs (&f))]))
(define-syntax apply-compose (define-syntax (apply-compose stx)
(syntax-rules () (syntax-parse stx
[(_ [] [a …]) (values a …)] [(_ [] [a …])
[(_ [f0 . f] [a …]) (apply-compose f [(f0 a …)])])) #'(values a …)]
[(_ [f … (f-last x … (~literal _) y …)] [a …])
#'(apply-compose [f …] [(f-last x … a … y …)])]
[(_ [f … f-last] [a …])
#'(apply-compose [f …] [(f-last a …)])]))
(define-for-syntax (internal-map: stx-f stx-&l… stx-out) (define-for-syntax (internal-map: stx-f stx-&l… stx-out)
(define/with-syntax f stx-f) (define/with-syntax f stx-f)
@ -191,7 +195,7 @@
(map: (∘ (curry map add1) (λ ([x : Number]) (list x))) '(1 2 3)) (map: (∘ (curry map add1) (λ ([x : Number]) (list x))) '(1 2 3))
#|(module* test typed/racket (module* test typed/racket
(require (submod "..") (require (submod "..")
"../lib/low.rkt") "../lib/low.rkt")
@ -219,9 +223,10 @@
(check-equal?: (map: (compose add1 car) '((1 b x) (2 c) (3 d))) (check-equal?: (map: (compose add1 car) '((1 b x) (2 c) (3 d)))
: (Listof Number) : (Listof Number)
'(2 3 4)) '(2 3 4))
#|
(check-equal?: (map: + '(1 2 3) '(4 5 6)) (check-equal?: (map: + '(1 2 3) '(4 5 6))
: (Listof Number) : (Listof Number)
'(5 7 9)))|# '(5 7 9))|#)