www

commit 9462296449fe4c7d3bae54a30c1a67fe97726270
parent 82096377bb20ee275046d74d8fdaa1f78e630073
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Thu, 12 Jan 2017 19:32:07 +0100

Use aful/unhygienic instead of afl in the test file, fixed bug which prevented internal definitions directly within the lambda for map.

Diffstat:
M
.travis.yml
 | 
2
+-
M
main.rkt
 | 
2
+-
M
test/test-map.rkt
 | 
29
+++++++++++++++++++++++++----

3 files changed, 27 insertions(+), 6 deletions(-)
diff --git a/.travis.yml b/.travis.yml
@@ -50,7 +50,7 @@ before_script:
 # `raco pkg install --deps search-auto` to install any required
 # packages without it getting stuck on a confirmation prompt.
 script:
- - raco test -x -p typed-map
+ - raco test -p typed-map
  - raco setup --check-pkg-deps --pkgs typed-map
  - raco pkg install --deps search-auto doc-coverage
  - if test "$RACKET_VERSION" != "6.2" -a "$RACKET_VERSION" != "6.3"; then raco doc-coverage typed-map; fi
diff --git a/main.rkt b/main.rkt
@@ -27,7 +27,7 @@
     [self (identifier? #'self) #'orig-map]
     [(_ (λ (argᵢ ...) body ...) lᵢ ...)
      (andmap identifier? (syntax->list #'(argᵢ ...)))
-     #'(foldr (λ (argᵢ ... acc) (cons (begin body ...) acc)) null lᵢ ...)]
+     #'(foldr (λ (argᵢ ... acc) (cons (let () body ...) acc)) null lᵢ ...)]
     [(_ f lᵢ ...)
      (with-syntax ([(argᵢ ...) (generate-temporaries #'(lᵢ ...))])
        #'(foldr (λ (argᵢ ... acc) (cons (f argᵢ ...) acc)) null lᵢ ...))]))
diff --git a/test/test-map.rkt b/test/test-map.rkt
@@ -1,4 +1,4 @@
-#lang afl typed/racket
+#lang aful/unhygienic typed/racket
 
 (require typed-map
          typed/rackunit)
@@ -13,6 +13,9 @@
   (map car '((1 2) (3 4)))
   (map #λ(+ % 1) '(1 2 3))
 
+  ;; Test internal definitions inside the body
+  (map (λ (x) (define y x) (+ y 1)) '(1 2 3))
+
   ;; used as a function (identifier macro), looses the inference abilities
   (map map (list add1 sub1) '((1 2 3) (4 5 6)))
   (map map
@@ -33,6 +36,8 @@
 (ann (map car '((1 2) (3 4))) (Listof Positive-Byte))
 (ann (map #λ(+ % 1) '(1 2 3)) (Listof Positive-Index))
 
+(ann (map (λ (x) (define y x) (+ y 1)) '(1 2 3)) (Listof Positive-Index))
+
 (ann (λ #:∀ (A) ([l : (Listof A)])
        (map (λ (x) x) l))
      (∀ (A) (→ (Listof A) (Listof A))))
@@ -46,6 +51,9 @@
 (check-equal? (map car '((1 2) (3 4))) '(1 3))
 (check-equal? (map #λ(+ % 1) '(1 2 3)) '(2 3 4))
 
+(check-equal? (map (λ (x) (define y x) (+ y 1)) '(1 2 3))
+              '(2 3 4))
+
 (check-equal? (map map (list add1 sub1) '((1 2 3) (4 5 6)))
               '((2 3 4) (3 4 5)))
 (check-equal? (map map
@@ -63,9 +71,15 @@
 
 (check-equal? (foldr (λ (x acc) (cons (add1 x) acc)) '() '(1 2 3))
               (map add1 '(1 2 3)))
+(check-equal? (foldr #λ(cons (add1 %1) %2) '() '(1 2 3))
+              (map add1 '(1 2 3)))
 (check-equal? (foldr (λ (x acc) (cons (add1 x) acc)) '() '(1 2 3))
               '(2 3 4))
 
+;; Test internal definitions inside the body
+(check-equal? (foldr (λ (x acc) (define y x) (cons (add1 y) acc)) '() '(1 2 3))
+              '(2 3 4))
+
 (let ()
   (ann (foldr (λ (x acc) (cons (add1 x) acc)) '() '()) Null)
   (void))
@@ -74,7 +88,15 @@
 
 (check-equal? (foldl (λ (x acc) (cons (add1 x) acc)) '() '(1 2 3))
               '(4 3 2))
-;; Does not work because the type changes.
+(check-equal? (foldl #λ(cons (add1 %1) %2) '() '(1 2 3))
+              '(4 3 2))
+
+;; Test internal definitions inside the body
+(check-equal? (foldl (λ (x acc) (define y x) (cons (add1 y) acc)) '() '(1 2 3))
+              '(2 3 4))
+
+;; Does not work because the inferred type changes between the first and the
+;; second iteration
 #;(check-equal? (foldl (λ (x acc) (cons acc (add1 x))) '() '(1 2 3))
                 '(4 (3 (2))))
 (foldl (λ (x [acc : (Rec R (U Null (Pairof R Positive-Index)))])
@@ -84,4 +106,4 @@
 
 (let ()
   (ann (foldl (λ (x acc) (cons (add1 x) acc)) '() '()) Null)
-  (void))
-\ No newline at end of file
+  (void))