type-expander-test.rkt - www - Unnamed repository; edit this file 'description' to name the repository.

type-expander-test.rkt (26837B)
      1 #lang typed/racket
      2 
      3 (require type-expander
      4          typed/rackunit
      5          (for-syntax type-expander/expander
      6                      racket/list
      7                      version/utils
      8                      rackunit
      9                      syntax/parse))
     10 
     11 ; Tests for expand-type
     12 (begin
     13   ;; Test harness:
     14   (begin
     15     (define-syntax (test-expander stx)
     16       (syntax-parse stx
     17         [(_ type expanded-type)
     18          (let ([actual (syntax->datum (expand-type #'type))]
     19                [expected (syntax->datum #'expanded-type)])
     20            (unless (equal? actual expected)
     21              (raise-syntax-error
     22               'test-expander
     23               (format "test-expander failed: expected ~a, got ~a"
     24                       expected
     25                       actual)
     26               stx
     27               #'type))
     28            #`(check-equal? '#,actual
     29                            '#,expected))])))
     30     
     31   ; Simple identity expander test, with a different case when used as a
     32   ; simple identifier.
     33     
     34   (begin
     35     (define-type-expander (id stx)
     36       (syntax-case stx ()
     37         [(_ t) #'t]
     38         [x #'(∀ (A) (→ A A))]))
     39       
     40     (test-expander (id Number) Number)
     41     (test-expander id (∀ (A) (→ A A))))
     42     
     43   (begin
     44     (define-type-expander (double stx)
     45       (syntax-case stx ()
     46         [(_ t) #'(id (Pairof (id t) t))]))
     47       
     48     (test-expander (∀ (A) (→ A (id (double (id A)))))
     49                    (∀ (A) (→ A (Pairof A A))))
     50       
     51     (test-expander (→ Any Boolean : (double (id A)))
     52                    (→ Any Boolean : (Pairof A A))))
     53     
     54   ;; Curry expander arguments:
     55   (begin
     56     (define-type-expander (CPairof stx)
     57       (syntax-case stx ()
     58         [(_ a) #'(curry Pairof a)]
     59         [(_ a b) #'(Pairof a b)]))
     60       
     61     (test-expander (CPairof Number String)
     62                    (Pairof Number String))
     63       
     64     (test-expander ((CPairof Number) String)
     65                    (Pairof Number String))
     66       
     67     (check-equal? (ann (ann '(1 . "b") (CPairof Number String))
     68                        (Pairof Number String))
     69                   '(1 . "b"))
     70       
     71     (check-equal? (ann (ann '(1 . "c") ((CPairof Number) String))
     72                        (Pairof Number String))
     73                   '(1 . "c")))
     74 
     75   ;; Shadowing with ∀ variables:
     76   (begin
     77     (test-expander (∀ (id) (→ id))
     78                    (∀ (id) (→ id)))
     79     (test-expander (∀ (id2) (→ id))
     80                    (∀ (id2) (→ (∀ (A) (→ A A))))))
     81     
     82   (begin
     83     (define-type-expander (Repeat stx)
     84       (syntax-case stx ()
     85         [(_ t n) #`(List #,@(map (λ (x) #'t)
     86                                  (range (syntax->datum #'n))))]))
     87       
     88     (test-expander (Repeat Number 5)
     89                    (List Number Number Number Number Number)))
     90     
     91   (begin
     92     (: count-five-more (→ Number (Repeat Number 5)))
     93     (define (count-five-more x)
     94       (list (+ x 1) (+ x 2) (+ x 3) (+ x 4) (+ x 5)))
     95       
     96     (check-equal? (count-five-more 3)
     97                   '(4 5 6 7 8))
     98     (check-equal? (ann (count-five-more 15) (Repeat Number 5))
     99                   '(16 17 18 19 20)))
    100     
    101   ;; Shadowing with Rec variables:
    102     
    103   (begin
    104     (: repeat-shadow (→ Number (Rec Repeat (U Null (List Number Repeat)))))
    105     (define (repeat-shadow n)
    106       (if (= n 0)
    107           '()
    108           (list n (repeat-shadow (sub1 n)))))
    109     (check-equal? (repeat-shadow 5)
    110                   '(5 (4 (3 (2 (1 ()))))))
    111     (test-expander (→ Number (Rec Repeat (U Null (List Number Repeat))))
    112                    (→ Number (Rec Repeat (U Null (List Number Repeat))))))
    113     
    114   ;; Shadowing with Let:
    115     
    116   (begin
    117     (let ()
    118       (define-type-expander (exp stx)
    119         #'(List 1 2 3))
    120         
    121       (define-type e String)
    122       (: x (List e (Let ([e exp]) e)))
    123       (define x (list "e1" (list 1 2 3)))
    124       (check-equal? x '("e1" (1 2 3)))
    125       (test-expander (List e (Let ([e exp]) e))
    126                      (List e (List 1 2 3)))
    127         
    128       (: y (List e))
    129       (define y (list "e2"))
    130       (check-equal? y '("e2"))
    131       (test-expander (List e)
    132                      (List e))
    133       (void)))
    134 
    135   ;; Let, Λ and ∀
    136   (begin
    137     (let ()
    138       (define-type-expander Str1 (λ (_) #'String))
    139 
    140       (test-expander (Let ([Number Str1]) Number)
    141                      String)
    142       (test-expander (Let ([Number (Λ stx #'String)]) (Number))
    143                      String)
    144       (test-expander (Let ([Number (Λ stx #'Str1)]) (Number))
    145                      String)
    146       (test-expander (Let ([Number (Λ stx #'String)]) Number)
    147                      String)
    148 
    149       (test-expander ((∀ (A) (Pairof A A)) Number)
    150                      (Pairof Number Number))
    151       (test-expander (Let ([String (∀ (A) (Pairof A A))])
    152                        (String Number))
    153                      (Pairof Number Number))
    154 
    155       (test-expander (Let ([Poly-Repeat
    156                             (Λ (_ n)
    157                                #`(∀ (A)
    158                                     (List #,@(map (λ (_) #'A)
    159                                                   (range (syntax-e #'n))))))]
    160                            [Number String])
    161                        ((Poly-Repeat 5) Number))
    162                      (List String String String String String))
    163 
    164       (test-expander (Let ([Poly-Repeat
    165                             (Λ (_ n)
    166                                #`(∀ (A)
    167                                     (List #,@(map (λ (_) #'A)
    168                                                   ;; like above, but also works
    169                                                   ;; without the syntax-e here:
    170                                                   (range n)))))]
    171                            [Number String])
    172                        ((Poly-Repeat 5) Number))
    173                      (List String String String String String))
    174 
    175       (ann '(1 . "b") ((Let ([Foo String])
    176                          (∀ (ty)
    177                             (Pairof ty Foo)))
    178                        Integer))
    179 
    180       (test-expander ((∀ (A1)
    181                          (Let ()
    182                            (Let ()
    183                              (Let ()
    184                                (Let ()
    185                                  A1)))))
    186                       Number)
    187                      Number)
    188       
    189       (void)))
    190 
    191   ;; Let*, Letrec
    192   (let ()
    193     (test-expander
    194      (Letrec ([Poly-Repeat
    195                (Λ (_ n)
    196                   (if (= 0 n)
    197                       #'(∀ (A) Null)
    198                       #`(∀ (A)
    199                            (Pairof A
    200                                    ((Poly-Repeat #,(sub1 n)) A)))))]
    201               [Number String])
    202        ((Poly-Repeat 5) Number))
    203      (Pairof String
    204              (Pairof String
    205                      (Pairof String
    206                              (Pairof String
    207                                      (Pairof String Null))))))
    208 
    209     #;(test-expander (Let* ([String Number]
    210                             [Number String])
    211                        (List Number String))
    212                      (List Number Number))
    213     (void)))
    214 
    215 ;; Test ":"
    216 (begin
    217   (: c0 `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d))
    218   (define c0 '(2 "abc" #,(x . z) #(1 "b" x) d))
    219     
    220   (let ()
    221     (define-type-expander (Repeat stx)
    222       (syntax-case stx ()
    223         [(_ t n) #`(List #,@(map (λ (x) #'t)
    224                                  (range (syntax->datum #'n))))]))
    225       
    226     (: x (→ (Repeat Number 5)))
    227     (define (x) (list 1 2 3 4 5))
    228     (check-equal? (x) '(1 2 3 4 5))))
    229   
    230 ;; Test define-type
    231 (let ()
    232   (define-type-expander (Repeat stx)
    233     (syntax-case stx ()
    234       [(_ t n) #`(List #,@(map (λ (x) #'t)
    235                                (range (syntax->datum #'n))))]))
    236     
    237   (define-type R5 (Repeat Number 5))
    238   (check-equal? (ann '(1 2 3 4 5) R5) '(1 2 3 4 5)))
    239   
    240 ;; Test define
    241 (begin
    242   (define d0
    243     : `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d)
    244     '(2 "abc" #,(x . z) #(1 "b" x) d))
    245   (check-equal? (ann d0 (List 2
    246                               "abc"
    247                               (List 'unsyntax
    248                                     (Pairof (U 'x 'y) (U 'y 'z)))
    249                               (Vector 1 "b" 'x) 'd))
    250                 '(2 "abc" (unsyntax (x . z)) #(1 "b" x) d))
    251     
    252   (: d1 (→ Number (→ Number Number)))
    253   (define ((d1 [x : Number]) [y : Number]) : Number (+ x y))
    254   (check-equal? (ann ((d1 2) 3) Number) 5)
    255     
    256   (: d2 (→ Number (→ Number Number)))
    257   (define ((d2 [x : Number]) [y : Number]) (+ x y))
    258   (check-equal? (ann ((d2 3) 4) Number) 7)
    259     
    260   (define #:∀ (T) ((d3 [x : T]) [y : T]) : (Pairof T T) (cons x y))
    261   (check-equal? (ann ((d3 'x) 'y) (Pairof Symbol Symbol)) '(x . y)))
    262   
    263 ;; Test lambda
    264 (begin
    265   (check-equal? ((ann (lambda ([x : Number]) : Number (* x 2))
    266                       (→ Number Number))
    267                  3)
    268                 6)
    269   (check-equal? ((ann (λ ([x : Number]) : Number (* x 2))
    270                       (→ Number Number))
    271                  3)
    272                 6)
    273   (check-equal? ((λ x x) 1 2 3) '(1 2 3))
    274   (check-equal? ((λ #:∀ (A) [x : A ...*] : (Listof A) x) 1 2 3) '(1 2 3))
    275   (check-equal? ((λ [x : Number ...*] : (Listof Number) x) 1 2 3) '(1 2 3))
    276   (check-not-exn (λ ()
    277                    (ann (λ #:∀ (A) [x : A ...*] : (Listof A) x)
    278                         (∀ (A) (→ A * (Listof A))))))
    279   (check-not-exn (λ ()
    280                    (ann (λ #:∀ (A) [x : A *] : (Listof A) x)
    281                         (∀ (A) (→ A * (Listof A))))))
    282   (check-not-exn (λ ()
    283                    (ann (λ #:∀ (A ...) ([l : (List A ... A)]) : (List A ... A)
    284                           l)
    285                         (∀ (A ...) (→ (List A ... A) (List A ... A))))))
    286   (check-not-exn (λ ()
    287                    (ann (λ #:∀ (A ...) [l : (List A ... A) *]
    288                           : (Listof (List A ... A))
    289                           l)
    290                         (∀ (A ...) (→ (List A ... A) *
    291                                       (Listof (List A ... A)))))))
    292   (check-not-exn (λ ()
    293                    (ann (λ #:∀ (A ...) [l : (List A ... A) ...*]
    294                           : (Listof (List A ... A))
    295                           l)
    296                         (∀ (A ...) (→ (List A ... A) *
    297                                       (Listof (List A ... A))))))))
    298 
    299 ;; Test struct
    300 (begin
    301   (struct s0 ())
    302   (struct s1 ([x : Number]))
    303   (struct s2 ([x : Number] [y : Number]))
    304   (struct s3 ([x : Number] [y : Number]) #:transparent)
    305   (struct s4 () #:transparent)
    306   (struct (A B) s5 ([x : A] [y : B]) #:transparent)
    307   (struct (A B) s6 () #:transparent)
    308   (struct s7 s2 ([z : String]) #:transparent)
    309   (struct (A) s8 s3 ([z : A]) #:transparent)
    310   (struct (A B C) s9 s5 ([z : C]) #:transparent)
    311   (struct (A B C) s10 s2 ([z : C]) #:transparent)
    312   (struct (A B C) s11 s5 ([z : C]))
    313     
    314   (check (λ (a b) (not (equal? a b))) (s0) (s0))
    315   (check-equal? (s1-x (s1 123)) 123)
    316   (check-equal? (s2-x (s2 2 3)) 2)
    317   (check-equal? (s2-y (s2 2 3)) 3)
    318   (check-equal? (s3-x (s3 4 5)) 4)
    319   (check-equal? (s3-y (s3 4 5)) 5)
    320   (check-equal? (s4) (s4))
    321   (check-equal? (s5-x (s5 6 7)) 6)
    322   (check-equal? (s5-y (s5 6 7)) 7)
    323   (check-equal? (s5 6 7) (s5 6 7))
    324   (check-equal? ((inst s5 Number String) 6 "g") (s5 6 "g"))
    325   (check-equal? (s6) (s6))
    326   (check-equal? ((inst s6 Number String)) (s6))
    327     
    328   ;(check-equal? (s7-x (s7 -1 -2 "c") -1))
    329   ;(check-equal? (s7-y (s7 -1 -2 "c") -2))
    330   (check-equal? (s7-z (s7 -1 -2 "c")) "c")
    331   (check-equal? (s2-x (s7 -1 -2 "c")) -1)
    332   (check-equal? (s2-y (s7 -1 -2 "c")) -2)
    333   (check-not-equal? (s7 -1 -2 "c") (s7 -1 -2 "c"))
    334   (check-not-exn (λ () (ann (s7 -1 -2 "c") s2)))
    335   (check-true (s2? (s7 -1 -2 "c")))
    336     
    337   ;(check-equal? (s8-x (s8 -1 -2 "c") -1))
    338   ;(check-equal? (s8-y (s8 -1 -2 "c") -2))
    339   (check-equal? (s8-z (s8 -1 -2 "c")) "c")
    340   (check-equal? (s3-x (s8 -1 -2 "c")) -1)
    341   (check-equal? (s3-y (s8 -1 -2 "c")) -2)
    342   (check-equal? (s8 -1 -2 "c") (s8 -1 -2 "c"))
    343   (check-equal? ((inst s8 String) -1 -2 "c") (s8 -1 -2 "c"))
    344   (check-not-exn (λ () (ann ((inst s8 String) -1 -2 "c") s3)))
    345   (check-true (s3? ((inst s8 String) -1 -2 "c")))
    346     
    347   ;(check-equal? (s9-x (s9 8 9 10)) 8)
    348   ;(check-equal? (s9-y (s9 8 9 10)) 9)
    349   (check-equal? (s9-z (s9 8 9 10)) 10)
    350   (check-equal? (s5-x (s9 8 9 10)) 8)
    351   (check-equal? (s5-y (s9 8 9 10)) 9)
    352   (check-equal? (s9 8 9 10) (s9 8 9 10))
    353   ;; Bug https://github.com/racket/typed-racket/issues/451
    354   ;(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
    355   ;                          (Struct s5))))
    356   (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
    357                             (Struct (s5 Number Symbol)))))
    358   (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
    359                             (s5 Number Symbol))))
    360   (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
    361                             (s5 Any Any))))
    362   (check-true (s5? ((inst s9 Number Symbol String) -1 'i "j")))
    363   (check-not-equal? (s10 11 12 13) (s10 11 12 13))
    364   (check-not-equal? (s11 14 15 16) (s11 14 15 16)))
    365   
    366 ;; Test define-struct/exec
    367 (begin
    368   (define-struct/exec se0 ()
    369     ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))])
    370     [(λ (self v) (cons self v)) : (→ se0 Any (Pairof se0 Any))])
    371   (define-struct/exec se1 ([x : Number])
    372     ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))])
    373     [(λ (self v) (cons self v)) : (→ se1 Any (Pairof se1 Any))])
    374   (define-struct/exec se2 ([x : Number] [y : Number])
    375     [(λ (self v) (cons self v)) : (→ se2 Any (Pairof se2 Any))])
    376   (define-struct/exec (se3 se2) ([z : String])
    377     [(λ (self v w) (list self v w))
    378      ;: (∀ (A B) (→ se3 A B (List se2 A B)))])
    379      : (→ se3 Any Any (List se2 Any Any))])
    380   (define-struct/exec (se4 se2) ([z : String])
    381     [(λ (self v w) (list self v w))
    382      ;: (∀ (A B) (→ se4 A B (List se2 A B)))])
    383      : (→ se4 Any (→ Number Number) (List se2 Any (→ Number Number)))])
    384        
    385   (check (λ (a b) (not (equal? a b))) (se0) (se0))
    386   (check-equal? (cdr ((se0) 'a)) 'a)
    387   (check-not-exn (λ () (ann (car ((se0) 'a)) se0)))
    388   (check-true (se0? (car ((se0) 'a))))
    389        
    390   (check (λ (a b) (not (equal? a b))) (se1 123) (se1 123))
    391   (check-equal? (se1-x (se1 123)) 123)
    392   (check-equal? (se1-x (car ((se1 123) 'b))) 123)
    393   (check-equal? (cdr ((se1 123) 'b)) 'b)
    394   (check-not-exn (λ () (ann (car ((se1 123) 'b)) se1)))
    395   (check-true (se1? (car ((se1 123) 'b))))
    396        
    397   (check (λ (a b) (not (equal? a b))) (se2 2 3) (se2 2 3))
    398   (check-equal? (se2-x (se2 2 3)) 2)
    399   (check-equal? (se2-y (se2 2 3)) 3)
    400   (check-equal? (se2-x (car ((se2 2 3) 'c))) 2)
    401   (check-equal? (se2-y (car ((se2 2 3) 'c))) 3)
    402   (check-equal? (cdr ((se2 2 3) 'c)) 'c)
    403   (check-not-exn (λ () (ann (car ((se2 2 3) 'c)) se2)))
    404   (check-true (se2? (car ((se2 2 3) 'c))))
    405        
    406   (check (λ (a b) (not (equal? a b))) (se3 4 5 "f") (se3 4 5 "f"))
    407   (check-equal? (se2-x (se3 4 5 "f")) 4)
    408   (check-equal? (se2-y (se3 4 5 "f")) 5)
    409   (check-equal? (se3-z (se3 4 5 "f")) "f")
    410   (check-equal? (se2-x (car ((se3 4 5 "f") 'd 'e))) 4)
    411   (check-equal? (se2-y (car ((se3 4 5 "f") 'd 'e))) 5)
    412   (check-equal? (let ([ret : Any (car ((se3 4 5 "f") 'd 'e))])
    413                   (if (se3? ret)
    414                       (se3-z ret)
    415                       "wrong type!"))
    416                 "f")
    417   (check-equal? (cadr ((se3 4 5 "f") 'd 'e)) 'd)
    418   (check-equal? (caddr ((se3 4 5 "f") 'd 'e)) 'e)
    419   (check-equal? ((caddr ((se4 4 5 "f") 'd (λ ([x : Number]) (* x 2)))) 12)
    420                 24)
    421   (check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se2)))
    422   (check-true (se2? (car ((se3 4 5 "f") 'd 'e))))
    423   (check-true (se3? (car ((se3 4 5 "f") 'd 'e)))))
    424   
    425 ;; Test ann
    426 (let ()
    427   (define-type-expander (Repeat stx)
    428     (syntax-case stx ()
    429       [(_ t n) #`(List #,@(map (λ (x) #'t)
    430                                (range (syntax->datum #'n))))]))
    431   (check-equal? (ann (ann '(1 2 3)
    432                           (Repeat Number 3))
    433                      (List Number Number Number))
    434                 '(1 2 3)))
    435   
    436 ;; Test inst
    437 (let ()
    438   (define-type-expander (Repeat stx)
    439     (syntax-case stx ()
    440       [(_ t n) #`(List #,@(map (λ (x) #'t)
    441                                (range (syntax->datum #'n))))]))
    442     
    443   (: f (∀ (A B C D) (→ (Pairof A B) (Pairof C D) (List A C B D))))
    444   (define (f x y) (list (car x) (car y) (cdr x) (cdr y)))
    445     
    446   (check-equal? ((inst f
    447                        (Repeat Number 3)
    448                        (Repeat String 2)
    449                        (Repeat 'x 1)
    450                        (Repeat undefined-type 0))
    451                  '((1 2 3) . ("a" "b"))
    452                  '((x) . ()))
    453                 '((1 2 3) (x) ("a" "b") ())))
    454   
    455 ;; Test let
    456 (begin
    457   (check-equal? (ann (let loop-id ([x 1])
    458                        (if (equal? x 2)
    459                            x
    460                            (loop-id 2)))
    461                      Any)
    462                 2)
    463   (check-equal? (let () 'x) 'x)
    464   (check-equal? (ann (let #:∀ (T) ([a : T 3]
    465                                    [b : (Pairof T T) '(5 . 7)])
    466                        (cons a b))
    467                      (Pairof Number (Pairof Number Number)))
    468                 '(3 5 . 7)))
    469   
    470 ;; Test let*
    471 (let ()
    472   (define-type-expander (Repeat stx)
    473     (syntax-case stx ()
    474       [(_ t n) #`(List #,@(map (λ (x) #'t)
    475                                (range (syntax->datum #'n))))]))
    476     
    477   (check-equal? (let* ([x* : (Repeat Number 3) '(1 2 3)]
    478                        [y* : (Repeat Number 3) x*])
    479                   y*)
    480                 '(1 2 3)))
    481   
    482 ;; Test let-values
    483 (let ()
    484   (define-type-expander (Repeat stx)
    485     (syntax-case stx ()
    486       [(_ t n) #`(List #,@(map (λ (x) #'t)
    487                                (range (syntax->datum #'n))))]))
    488     
    489   (check-equal? (ann (let-values
    490                          ([([x : (Repeat Number 3)])
    491                            (list 1 2 3)])
    492                        (cdr x))
    493                      (List Number Number))
    494                 '(2 3))
    495     
    496   (check-equal? (ann (let-values
    497                          ([([x : (Repeat Number 3)] [y : Number])
    498                            (values (list 1 2 3) 4)])
    499                        (cons y x))
    500                      (Pairof Number (List Number Number Number)))
    501                 '(4 . (1 2 3)))
    502     
    503   (check-equal? (ann (let-values
    504                          ([(x y)
    505                            (values (list 1 2 3) 4)])
    506                        (cons y x))
    507                      (Pairof Number (List Number Number Number)))
    508                 '(4 . (1 2 3))))
    509   
    510 ;; Test make-predicate
    511 (let ()
    512   (define-type-expander (Repeat stx)
    513     (syntax-case stx ()
    514       [(_ t n) #`(List #,@(map (λ (x) #'t)
    515                                (range (syntax->datum #'n))))]))
    516   (check-equal? ((make-predicate (Repeat Number 3)) '(1 2 3)) #t)
    517   (check-equal? ((make-predicate (Repeat Number 3)) '(1 "b" 3)) #f))
    518 
    519 ;; row-inst
    520 (let-syntax ([when-row-inst-is-defined
    521               (λ (stx)
    522                 (syntax-case stx ()
    523                   [(_ body)
    524                    (if (or (identifier-binding #'row-inst)
    525                            (version<=? "6.7" (version)))
    526                        #'body
    527                        #'(void))]))])
    528   (when-row-inst-is-defined
    529    (let ()
    530      ;; Example taken from the docs
    531      (: id (All (r #:row)
    532                 (-> (Class #:row-var r) (Class #:row-var r))))
    533      (define (id cls) cls)
    534      (define result ((row-inst id (Row (field [x Integer])))
    535                      (class object% (super-new) (field [x : Integer 0]))))
    536      (ann result (Class (field (x Integer))))
    537      (void))))
    538 
    539 ;; Tests written while debugging
    540 (begin
    541   (let ()
    542     (define-type-expander flob
    543       (λ (stx) #'(All (abc) (List abc))))
    544 
    545     (ann '(a) ((flob) Symbol))
    546 
    547     (ann '(42) ((Let ([flob (Λ (_ arg)
    548                                #'((∀ (abc)
    549                                      (List abc)) arg))])
    550                   flob)
    551                 Integer))
    552 
    553     (ann '(1 2 3) ((∀ (abc)
    554                       (Listof abc))
    555                    Integer))
    556 
    557     (ann '(1 2 3) ((Let () 
    558                      (∀ (abc)
    559                         (Listof abc)))
    560                    Integer))
    561     (void))
    562 
    563   (let ()
    564     (test-expander
    565      ((Let () (∀ (A1) (Let () A1))) Number)
    566      Number))
    567 
    568   (let ()
    569     (ann '(1 2 3) (Listof Integer))
    570 
    571     (define-type (poly1 ty)
    572       (Listof ty))
    573 
    574     (ann '(1 2 3) (poly1 Integer))
    575 
    576     (define-type poly2
    577       (∀ (ty)
    578          (Listof ty)))
    579 
    580     ;; invalid starting from racket 9.0 (dubious semantics before that, a ∀ is technically not a type function and uses a different eliminator, was allowed for convenience I guess.
    581     ;;(ann '(1 2 3) (poly2 Integer))
    582 
    583     ;; type-expander manages to salvage this, but is invalid in racket 9.0. Should probably fail for consistency.
    584     (ann '(1 2 3) ((∀ (ty)
    585                       (Listof ty))
    586                    Integer))
    587 
    588     ;; type-expander manages to salvage this, but is invalid in racket 9.0. Should probably fail for consistency.
    589     (ann '(1 2 3) ((Let ()
    590                      (∀ (ty)
    591                         (Listof ty)))
    592                    Integer))
    593 
    594     (void))
    595 
    596   (define-for-syntax (test-use/def stx def expected-use expected-def)
    597     (let ([actual-use (syntax->datum
    598                        (apply-type-expander (datum->syntax stx 'Quux)
    599                                             (datum->syntax stx 'Quux)))]
    600           [actual-def (syntax->datum
    601                        (apply-type-expander def def))])
    602       (check-equal? actual-use expected-use)
    603       (check-equal? actual-def expected-def)))
    604 
    605   (let ()
    606     (define-type-expander (Foo stx) #'Integer)
    607     (define-type-expander (Bar stx) #'Integer)
    608     (define-type-expander (Quux stx) #'Integer)
    609 
    610     (define-type mytype1
    611       (Let ([Foo (Λ (_ T)
    612                     (test-use/def #'T #'Quux 'Integer 'Integer)
    613                     #'T)])
    614         (Foo Quux)))
    615 
    616     (define-type mytype23
    617       (Let ([Quux String])
    618         (Let ([Foo (Λ (_ T)
    619                       (test-use/def #'T #'Quux 'String 'String)
    620                       #'T)])
    621           (Foo (∀ (A)
    622                   (Let ([Bar (Λ (_ T)
    623                                 (test-use/def #'T #'Quux 'String 'String)
    624                                 #'T)])
    625                     (Bar (Listof A))))))))
    626 
    627     (define-type mytype45
    628       (Let ([Foo (Λ (_ T)
    629                     (test-use/def #'T #'Quux 'String 'Integer)
    630                     #'T)])
    631         (Let ([Quux String])
    632           (Foo (∀ (A)
    633                   (Let ([Bar (Λ (_ T)
    634                                 (test-use/def #'T #'Quux 'String 'String)
    635                                 #'T)])
    636                     (Bar (Listof A))))))))
    637 
    638     (define-type mytype67
    639       (Let ([Foo (Λ (_ T)
    640                     (test-use/def #'T #'Quux 'Integer 'Integer)
    641                     #'T)])
    642         (Foo (Let ([Quux String])
    643                (∀ (A)
    644                   (Let ([Bar (Λ (_ T)
    645                                 (test-use/def #'T #'Quux 'String 'String)
    646                                 #'T)])
    647                     (Bar (Listof A))))))))
    648 
    649     (define-type mytype89
    650       (Let ([Foo (Λ (_ T)
    651                     (test-use/def #'T #'Quux 'Integer 'Integer)
    652                     #'T)])
    653         (Foo (∀ (A)
    654                 (Let ([Quux String])
    655                   (Let ([Bar (Λ (_ T)
    656                                 (test-use/def #'T #'Quux 'String 'String)
    657                                 #'T)])
    658                     (Bar (Listof A))))))))
    659 
    660     (void))
    661 
    662   (let ()
    663     (test-expander ((Let ([F (Λ (_ T) #'T)]) F) String)
    664                    String)
    665     (test-expander ((Let ([F (Λ (_ T) #'(List T))]) F) String)
    666                    (List String)))
    667 
    668   ;; Please don't ever do that in practice :) !
    669   (let ()
    670     (test-expander (Let ([Loot Number])
    671                      ((Let ([Loot Let]) Loot) ([AAA Number])
    672                                               AAA))
    673                    Number)
    674     (test-expander (Let ([Loot Number])
    675                      ((Let ([Loot Let]) Loot) ([Let Loot])
    676                                               Let))
    677                    Number)
    678     (test-expander (Let ([Loot Number])
    679                      ((Let ([Loot Let]) Loot) ([Loot String])
    680                                               Loot))
    681                    String)))
    682 
    683 ;; more tests
    684 (begin
    685   (test-expander ((∀ (A) ((∀ (A) ((∀ (A) ((∀ (A) A) A)) A)) A)) Number)
    686                  Number)
    687   (test-expander (Let ([A Number])
    688                    (Let ([A A])
    689                      (Let ([A A])
    690                        (Let ([A A])
    691                          A))))
    692                  Number)
    693   (test-expander (Let* ([A Number]
    694                         [A A]
    695                         [A A]
    696                         [A A]
    697                         [A A])
    698                    A)
    699                  Number)
    700   (test-expander (Let* ([A Number]
    701                         [A (List A)]
    702                         [A (Pairof A A)]
    703                         [A (Vector A)]
    704                         [A (Set A)])
    705                    A)
    706                  (Set (Vector (Pairof (List Number) (List Number)))))
    707 
    708   ;; Adjusted from http://www.cs.utah.edu/~mflatt/scope-sets/
    709   ;;   #%28part._.Macro_.Definitions_in_a_.Recursive_.Scope%29
    710   (test-expander (Letrec ([Identity (Λ (_ misc-id)
    711                                        #'(∀ (X)
    712                                             (Let ([misc-id String])
    713                                               X)))])
    714                    ((Identity X) Number))
    715                  Number)
    716   (test-expander (Letrec ([Identity (Λ (_ misc-id)
    717                                        #'(∀ (misc-id)
    718                                             (Let ([X String])
    719                                               misc-id)))])
    720                    ((Identity X) Number))
    721                  Number)
    722   (test-expander (Letrec ([GetY (Λ (_ misc-id)
    723                                        (datum->syntax #'misc-id 'Y))])
    724                    (Let ([Y Number]) (GetY X)))
    725                  Number)
    726   (test-expander (Letrec ([GetY (Λ (_ misc-id)
    727                                        (datum->syntax #'misc-id 'Y))])
    728                    ((∀ (Y) (GetY X)) Number))
    729                  Number))
    730 
    731 ;; Tests for Syntax
    732 (let ()
    733   (test-expander #'a (Syntaxof 'a))
    734   (test-expander #'(a) (Syntaxof (List (Syntaxof 'a))))
    735   (test-expander #'(a . b) (Syntaxof (Pairof (Syntaxof 'a) (Syntaxof 'b))))
    736   (test-expander #'(a . (b))
    737                  (Syntaxof (Pairof (Syntaxof 'a)
    738                                    (Syntaxof (List (Syntaxof 'b))))))
    739   (test-expander #'(a b) (Syntaxof (List (Syntaxof 'a) (Syntaxof 'b))))
    740   (test-expander #'(a b . c)
    741                  (Syntaxof (List* (Syntaxof 'a) (Syntaxof 'b) (Syntaxof 'c))))
    742   (test-expander #'(a b . (c))
    743                  (Syntaxof (List* (Syntaxof 'a)
    744                                   (Syntaxof 'b)
    745                                   (Syntaxof (List (Syntaxof 'c)))))))
    746 
    747 ;; Small typo
    748 (let ()
    749   (test-expander ((No-Expand List) 'a 'b) (List 'a 'b)))
	www Unnamed repository; edit this file 'description' to name the repository.
	Log \| Files \| Refs \| Submodules \| README \| LICENSE