www

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

test-constructor3.rkt (2604B)

      1 #lang typed/racket
      2 
      3 (require phc-adt phc-toolkit type-expander typed/rackunit)
      4 (adt-init)
      5 
      6 ;; define-constructor
      7 (define-constructor tag0 :)
      8 (define-constructor tag1 : Number)
      9 (define-constructor tag2 : Number String)
     10 (define-constructor tag3 : Number String 'c)
     11 
     12 ;; Type expander
     13 (check-equal?: (constructor-values (ann (constructor tag0) tag0))
     14                '())
     15 (check-equal?: (constructor-values (ann (constructor tag1 1) tag1))
     16                '(1))
     17 (check-equal?: (constructor-values (ann (constructor tag2 1 "b") tag2))
     18                '(1 "b"))
     19 (check-equal?: (constructor-values
     20                 (ann (constructor tag3 1 "b" (ann 'c 'c)) tag3))
     21                '(1 "b" c))
     22 
     23 ;; Call
     24 (check-equal?: (constructor-values (ann (tag0) (constructor tag0)))
     25                '())
     26 (check-equal?: (constructor-values (ann (tag1 1) (constructor tag1 Number)))
     27                '(1))
     28 (check-equal?: (constructor-values
     29                 (ann (tag2 1 "b") (constructor tag2 Number String)))
     30                '(1 "b"))
     31 (check-equal?: (constructor-values
     32                 (ann (tag3 1 "b" 'c) (constructor tag3 Number String 'c)))
     33                '(1 "b" c))
     34 
     35 ;; Id
     36 (check-not-exn (λ () (ann tag0 (→ (constructor tag0)))))
     37 (check-not-exn (λ () (ann tag1 (→ Number (constructor tag1 Number)))))
     38 (check-not-exn
     39  (λ () (ann tag2 (→ Number String (constructor tag2 Number String)))))
     40 (check-not-exn
     41  (λ () (ann tag3 (→ Number String 'c (constructor tag3 Number String 'c)))))
     42 
     43 ;; Match expander
     44 (check-equal?: (ann (match (constructor tag0) [(tag0) #t]) #t)
     45                #t)
     46 (check-equal?: (ann (match (constructor tag1 1) [(tag1 x) (list x)])
     47                     (List Number))
     48                '(1))
     49 (check-equal?: (ann (match (constructor tag2 1 "b") [(tag2 x y) (list y x)])
     50                     (List String Number))
     51                '("b" 1))
     52 (check-equal?: (ann (match (constructor tag3 1 "b" (ann 'c 'c))
     53                       [(tag3 x y z) (list z y x)])
     54                     (List 'c String Number))
     55                '(c "b" 1))
     56 
     57 ;; Match expander which single pattern
     58 (check-equal?: (ann (match (constructor tag0) [(tag0 #:rest whole) whole]) Null)
     59                '())
     60 (check-equal?: (ann (match (constructor tag1 1) [(tag1 x) x])
     61                     Number)
     62                '1)
     63 (check-equal?: (ann (match (constructor tag2 1 "b") [(tag2 x y) (list x y)])
     64                     (List Number String))
     65                '(1 "b"))
     66 (check-equal?: (ann (match (constructor tag3 1 "b" (ann 'c 'c))
     67                       [(tag3 x y z) (list x y z)])
     68                     (List Number String 'c))
     69                '(1 "b" c))