Moved tests to separate files (part 1).

graph-lib/graph/adt-test.rkt

@@ -0,0 +1,18 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require (submod "graph.lp2.rkt" test))
+  (require "adt.lp2.rkt")
+  (require "../lib/low.rkt")
+  (require "../type-expander/type-expander.lp2.rkt")
+  
+  ((tagged t a b c) 1 'b "c")
+  ((tagged t a [b] c) 1 'b "c")
+  ((tagged t [a] [b] [c]) 1 'b "c")
+  ((tagged t [a : Number] [b : Symbol] [c : String]) 1 'b "c")
+  (tagged t [a : Number 1] [b : Symbol 'b] [c : String "c"])
+  (tagged t [a 1] [b 'b] [c "c"])
+  
+  (tagged t [a 1] [b 'b] [c "c"])
+  
+  (define-tagged tabc [a 1] [b 'b] [c "c"]))

graph-lib/graph/get-test.rkt

@@ -0,0 +1,23 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require (submod "graph.lp2.rkt" test))
+  (require "get.lp2.rkt")
+  (require "adt.lp2.rkt")
+  (require "../lib/low.rkt")
+  (require "../type-expander/type-expander.lp2.rkt")
+  
+  (check-equal?: (get '((1 2) (3)) … …)
+                 '((1 2) (3)))
+  
+  (uniform-get g people)
+  (get g people)
+  (get g streets cadr houses car owner name)
+  ((λget people) g)
+  (check-equal?: ((λget owner name) (get g streets cadr houses car))
+                 "Jack")
+  (check-equal?: (get g streets … houses … owner name)
+                 '(("Amy" "Anabella") ("Jack")))
+  (check-equal?: ((λget streets … houses … owner name) g)
+                 '(("Amy" "Anabella") ("Jack")))
+  (check-true: (procedure? (let ([f (λget streets … houses … owner name)]) f))))

graph-lib/graph/graph-5-multi-ctors.lp2.rkt

@@ -140,9 +140,6 @@ TODO: At the call site, use a macro and annotate the function (given by its
 name) with the right type, so that the user doesn't see all the types in the
 (U …). 
 
-@chunk[<test-graph-multi-ctor>
-       (check-equal? 42 42)]
-
 @section{Conclusion}
 
 @chunk[<module-main>
@@ -168,18 +165,9 @@ name) with the right type, so that the user doesn't see all the types in the
          
          <graph-multi-ctor>)]
 
-@chunk[<module-test>
-       (module* test typed/racket
-         (require (submod "..")
-                  typed/rackunit)
-         
-         <test-graph-multi-ctor>)]
-
 @chunk[<*>
        (begin
          <module-main>
          
          (require 'main)
-         (provide (all-from-out 'main))
+         (provide (all-from-out 'main)))]
-         
-         <module-test>)]

graph-lib/graph/graph-6-rich-returns-test.rkt

@@ -0,0 +1,15 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require (for-syntax (submod "graph-6-rich-returns.lp2.rkt" test-syntax)
+                       syntax/strip-context))
+  
+  (define-syntax (insert-tests stx)
+    (replace-context stx tests))
+  
+  (require "graph-6-rich-returns.lp2.rkt"
+           "../type-expander/type-expander.lp2.rkt"
+           typed/rackunit)
+  
+  ;(insert-tests);; TODO: FIXME
+  )

graph-lib/graph/graph-6-rich-returns.lp2.rkt

@@ -571,12 +571,12 @@ encapsulating the result types of mappings.
          <graph-rich-return>)]
 
 @chunk[<module-test>
-       (module* test typed/racket
+       (module test-syntax racket
-         (require (submod "..")
+         (provide tests)
-                  typed/rackunit)
+         (define tests
-         
+           (quote-syntax
-         ;;<test-graph-rich-return>
+            (begin
-         )]
+              <test-graph-rich-return>))))]
 
 @chunk[<*>
        (begin

graph-lib/graph/graph-aliasing.lp2.rkt

@@ -11,7 +11,7 @@
 
 When declaring a graph, the names of its nodes and mappings
 as well as those of the graph it is based on may collide. We
-try here to provide reasonnable defaults indicating which
+try here to provide reasonable defaults indicating which
 name should refer to what at each point.
 
 @chunk[<example>

graph-lib/graph/graph.lp2.rkt

@@ -821,7 +821,7 @@ not match the one from @tc[typed/racket]
                   (only-in "adt.lp2.rkt" uniform-get)
                   "../type-expander/type-expander.lp2.rkt")
          
-         (provide g)
+         (provide g gr gr-simple)
          <use-example>
          <type-example>
          

graph-lib/graph/map-test.rkt

@@ -0,0 +1,263 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require "map.rkt"
+           (submod "map.rkt" private-tests))
+  (require (submod "graph.lp2.rkt" test)
+           "get.lp2.rkt"
+           "map.rkt"
+           "../lib/low.rkt"
+           "../type-expander/type-expander.lp2.rkt")
+  
+  (begin
+    (check-equal?: ((λdeep-map {A B} A B 3) add1 '([{1} {2 3}] [{4}]))
+                   : (Listof (Listof (Listof Number)))
+                   '([{2} {3 4}] [{5}])))
+  
+  ;; deep-map
+  (begin
+    (check-equal?: (deep-map {A B} A B 3 add1 '([{1} {2 3}] [{4}]))
+                   : (Listof (Listof (Listof Number)))
+                   '([{2} {3 4}] [{5}]))
+    
+    
+    (check-equal?: (deep-map {A B} A B 0 add1 '7)
+                   : Number
+                   8))
+  
+  ;; deep-map-auto
+  (begin
+    (check-equal?: (deep-map-auto 2 length '([{1} {2 3}] [{4}]))
+                   : (Listof (Listof Index))
+                   '([1 2] [1]))
+    
+    (check-equal?: (deep-map-auto 2 car '([{1} {2 3}] [{4}]))
+                   : (Listof (Listof Number))
+                   '([1 2] [4]))
+    
+    (check-equal?: (deep-map-auto 2 list '([1 2] [3]))
+                   : (Listof (Listof (Listof Number)))
+                   '([{1} {2}] [{3}]))
+    
+    #;(check-equal?: (deep-map-auto 3 add1 (deep-map-auto 2 list '([1 2] [3])))
+                     : (Listof (Listof (Listof Number)))
+                     '([{1} {2}] [{3}]))
+    
+    (check-equal?: (deep-map-auto 1 length
+                                  (deep-map-auto 2 car
+                                                 (deep-map-auto 2 list
+                                                                '([1 2] [3]))))
+                   : (Listof Index)
+                   '(2 1)))
+  
+  ;; compose-maps
+  (begin
+    (check-equal?: (compose-maps [(2 car!) (3 add1) (3 add1) (2 list)]
+                                 ['([1 2] [3])])
+                   : (Listof (Listof Number))
+                   '([3 4] [5])))
+  
+  ;; map:
+  (begin
+    (check-equal?: (map: car '((1 a) (2 b) (3 c)))
+                   : (Listof Number)
+                   '(1 2 3))
+    
+    (check-equal?: (map: (∘ (∘ add1)
+                            length
+                            (curry map car)
+                            (curry map list)
+                            (curry map (∘)))
+                         '([1 2] [3]))
+                   : (Listof Number)
+                   '(3 2)))
+  
+  ;; map:
+  (begin
+    (check-equal?: (map: add1 '(1 2 3))
+                   : (Listof Number)
+                   '(2 3 4))
+    (check-equal?: (map: (compose add1) '(1 2 3))
+                   : (Listof Number)
+                   '(2 3 4))
+    (check-equal?: (map: (∘ identity add1) '(1 2 3))
+                   : (Listof Number)
+                   '(2 3 4))
+    (check-equal?: (map: (∘ add1 identity) '(1 2 3))
+                   : (Listof Number)
+                   '(2 3 4))
+    (check-equal?: (map: (∘ number->string add1) '(1 2 9))
+                   : (Listof String)
+                   '("2" "3" "10"))
+    (check-equal?: (map: (∘ string-length number->string add1) '(1 2 9))
+                   : (Listof Number)
+                   '(1 1 2))
+    (check-equal?: (map: car '((1 2) (2) (9 10 11)))
+                   : (Listof Number)
+                   '(1 2 9))
+    (check-equal?: (map: (∘ add1 car) '((1 2) (2) (9 10 11)))
+                   : (Listof Number)
+                   '(2 3 10))
+    (check-equal?: (map: (∘ string-length number->string add1 car cdr)
+                         '((1 2) (2 3) (8 9 10)))
+                   : (Listof Number)
+                   '(1 1 2))
+    (check-equal?: (map: identity '(1 2 3))
+                   : (Listof Number)
+                   '(1 2 3))
+    (check-equal?: (map: values '(1 2 3))
+                   : (Listof Number)
+                   '(1 2 3))
+    (check-equal?: (map: (compose) '(1 2 3))
+                   : (Listof Number)
+                   '(1 2 3))
+    (check-equal?: (map: (compose identity) '(1 2 3))
+                   : (Listof Number)
+                   '(1 2 3))
+    (check-equal?: (map: (∘ identity values identity values) '(1 2 3))
+                   : (Listof Number)
+                   '(1 2 3))
+    (check-equal?: (map: (∘ length (curry map add1)) '((1 2) (3)))
+                   : (Listof Number)
+                   '(2 1))
+    (check-equal?: (map: (curry map add1) '((1 2) (3)))
+                   : (Listof (Listof Number))
+                   '((2 3) (4)))
+    
+    (define (numlist [x : Number]) (list x))
+    (check-equal?: (map: (∘ (curry map add1) numlist) '(1 2 3))
+                   : (Listof (Listof Number))
+                   '((2) (3) (4)))
+    
+    (check-equal?: (map: (∘ (curry map add1) (λ ([x : Number]) (list x)))
+                         '(1 2 3))
+                   : (Listof (Listof Number))
+                   '((2) (3) (4)))
+    
+    (begin
+      ;; Some of the tests below use (curry map: …) instead of (curry map …).
+      ;; The colon `map:` version does not work, because typed/racket wraps the
+      ;; `map:` identifier with a contract, so the identifier seen outside the
+      ;; module is not the same as the one used in the syntax-parse ~literal
+      ;; clause.
+      
+      (check-equal?: (map: (curry map add1) '((1 2 3) (4 5)))
+                     : (Listof (Listof Number))
+                     '((2 3 4) (5 6)))
+      #;(check-equal?: (map: (curry map: add1) '((1 2 3) (4 5)))
+                       : (Listof (Listof Number))
+                       '((2 3 4) (5 6)))
+      
+      (check-equal?: (map: (curry map (compose number->string add1))
+                           '((1 2 3) (4 5)))
+                     : (Listof (Listof String))
+                     '(("2" "3" "4") ("5" "6")))
+      #;(check-equal?: (map: (curry map: (compose number->string add1))
+                             '((1 2 3) (4 5)))
+                       : (Listof (Listof String))
+                       '(("2" "3" "4") ("5" "6")))
+      
+      (check-equal?: (map: add1 '(1 2 3))
+                     : (Listof Number)
+                     '(2 3 4))
+      
+      (check-equal?: (map: car '((1 a) (2 b) (3 c)))
+                     : (Listof Number)
+                     '(1 2 3))
+      
+      (check-equal?: (map: (curry map car) '([{1 a} {2 b}] [{3 c}]))
+                     : (Listof (Listof Number))
+                     '([1 2] [3]))
+      #;(check-equal?: (map: (curry map: car) '([{1 a} {2 b}] [{3 c}]))
+                       : (Listof (Listof Number))
+                       '([1 2] [3]))
+      
+      (check-equal?: (map: (curry map (curry map car))
+                           '([((1 a) (2 b)) ((3 c))] [((4))]))
+                     : (Listof (Listof (Listof Number)))
+                     '([(1 2) (3)] [(4)]))
+      #;(check-equal?: (map: (curry map (curry map: car))
+                             '([((1 a) (2 b)) ((3 c))] [((4))]))
+                       : (Listof (Listof (Listof Number)))
+                       '([(1 2) (3)] [(4)]))
+      #;(check-equal?: (map: (curry map: (curry map car))
+                             '([((1 a) (2 b)) ((3 c))] [((4))]))
+                       : (Listof (Listof (Listof Number)))
+                       '([(1 2) (3)] [(4)]))
+      #;(check-equal?: (map: (curry map: (curry map: car))
+                             '([((1 a) (2 b)) ((3 c))] [((4))]))
+                       : (Listof (Listof (Listof Number)))
+                       '([(1 2) (3)] [(4)])))
+    
+    (check-equal?: (map: car '((1 b x) (2 c) (3 d)))
+                   : (Listof Number)
+                   '(1 2 3))
+    (check-equal?: (map: cdr '((1 b x) (2 c) (3 d)))
+                   : (Listof (Listof Symbol))
+                   '((b x) (c) (d)))
+    (check-equal?: (map: car (map: cdr '((1 b x) (2 c) (3 d))))
+                   : (Listof Symbol)
+                   '(b c d))
+    (check-equal?: (map: (compose) '((1 b x) (2 c) (3 d)))
+                   : (Listof (Listof (U Number Symbol)))
+                   '((1 b x) (2 c) (3 d)))
+    (check-equal?: (map: (compose car) '((1 b x) (2 c) (3 d)))
+                   : (Listof Number)
+                   '(1 2 3))
+    (check-equal?: (map: (compose cdr) '((1 b x) (2 c) (3 d)))
+                   : (Listof (Listof Symbol))
+                   '((b x) (c) (d)))
+    (check-equal?: (map: (compose car cdr) '((1 b x) (2 c) (3 d)))
+                   : (Listof Symbol)
+                   '(b c d))
+    (check-equal?: (map: (compose add1 car) '((1 b x) (2 c) (3 d)))
+                   : (Listof Number)
+                   '(2 3 4))
+    #|
+  (check-equal?: (map: + '(1 2 3) '(4 5 6))
+                 : (Listof Number)
+                 '(5 7 9))|#)
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
+  (check-equal?:
+   (map: (curry map (gr #:? House))
+         (map: (λget houses) (get g streets)))
+   '((#t #t) (#t)))
+  
+  (check-equal?:
+   (map: (λget houses … owner name) (get g streets))
+   '(("Amy" "Anabella") ("Jack")))
+  
+  (check-equal?:
+   (map: (∘ (curry map (∘ (λget name) (λget owner)))
+            (λget houses))
+         (get g streets))
+   '(("Amy" "Anabella") ("Jack")))
+  
+  (check-equal?:
+   (map: (∘ (curry map (∘ string-length (λget name) (λget owner)))
+            (λget houses))
+         (get g streets))
+   '((3 8) (4)))
+  
+  (check-equal?:
+   (map: (curry map (gr #:? House))
+         (map: (compose (curry map identity)
+                        (λget houses …))
+               (get g streets)))
+   '((#t #t) (#t)))
+  
+  ;; Can be allowed by changing (→ (→ A B) A B) in a couple of places in map: to
+  ;; a case→, but it's more heavy on the typechecker, and it's an uncommon case.
+  ;(map: (compose (λget houses …) (λ #:∀ (A) ([x : A]) x)) (get g streets))
+  (check-equal?:
+   (map: (curry map (gr #:? Person))
+         (map: (compose (curry map (λget owner))
+                        (λget houses …))
+               (get g streets)))
+   '((#t #t) (#t)))
+  
+  (check-equal?:
+   (map: (λget houses … owner name) (get g streets))
+   '(("Amy" "Anabella") ("Jack"))))

graph-lib/graph/map.rkt

@@ -8,6 +8,16 @@
          "get.lp2.rkt"
          "../type-expander/type-expander.lp2.rkt")
 
+(provide car!
+         cdr!
+         map:
+         compose-maps)
+
+(module+ private-tests
+  (provide λdeep-map
+           deep-map
+           deep-map-auto))
+
 (module m typed/racket
   (provide car! cdr!)
   
@@ -21,9 +31,6 @@
   (define (cdr! x) (cdr x)))
 
 (require 'm)
-(provide (all-from-out 'm))
-
-(provide map: compose-maps)
 
 (define-syntax (dbg stx)
   (syntax-parse stx
@@ -74,26 +81,11 @@
                           (local-map f (cdr l)))))
               local-map))]))
 
-(module+ test
-  (check-equal?: ((λdeep-map {A B} A B 3) add1 '([{1} {2 3}] [{4}]))
-                 : (Listof (Listof (Listof Number)))
-                 '([{2} {3 4}] [{5}])))
-
 (define-syntax (deep-map stx)
   (syntax-parse stx
     [(_ {∀-type:id …} A:expr B:expr d:≥0 f:expr l:expr)
      (syntax/loc #'f ((λdeep-map {∀-type …} A B d) f l))]))
 
-(module+ test
-  (check-equal?: (deep-map {A B} A B 3 add1 '([{1} {2 3}] [{4}]))
-                 : (Listof (Listof (Listof Number)))
-                 '([{2} {3 4}] [{5}])))
-
-(module+ test
-  (check-equal?: (deep-map {A B} A B 0 add1 '7)
-                 : Number
-                 8))
-
 ;; We provide hints for the types of some common functions
 
 (define-type-expander (ArgOf stx)
@@ -127,34 +119,6 @@
 (define-syntax/parse (deep-map-auto d:≥0 f l)
   #'(deep-map {A B} (ArgOf f A B) (ResultOf f A B) d (substitute-function f) l))
 
-(module+ test
-  (check-equal?: (deep-map-auto 2 length '([{1} {2 3}] [{4}]))
-                 : (Listof (Listof Index))
-                 '([1 2] [1])))
-
-(module+ test
-  (check-equal?: (deep-map-auto 2 car '([{1} {2 3}] [{4}]))
-                 : (Listof (Listof Number))
-                 '([1 2] [4])))
-
-(module+ test
-  (check-equal?: (deep-map-auto 2 list '([1 2] [3]))
-                 : (Listof (Listof (Listof Number)))
-                 '([{1} {2}] [{3}])))
-
-#;(module+ test
-    (check-equal?: (deep-map-auto 3 add1 (deep-map-auto 2 list '([1 2] [3])))
-                   : (Listof (Listof (Listof Number)))
-                   '([{1} {2}] [{3}])))
-
-(module+ test
-  (check-equal?: (deep-map-auto 1 length
-                                (deep-map-auto 2 car
-                                               (deep-map-auto 2 list
-                                                              '([1 2] [3]))))
-                 : (Listof Index)
-                 '(2 1)))
-
 ;; Now we turn all map: calls into the form
 ;; (compose-maps [(d f) …] [l …])
 
@@ -167,12 +131,6 @@
     [(_ [(d:≥0 f:expr) (d-rest:≥0 f-rest:expr) …] [l:expr …])
      #'(deep-map-auto d f (compose-maps [(d-rest f-rest) …] [l …]))]))
 
-(module+ test
-  (check-equal?: (compose-maps [(2 car!) (3 add1) (3 add1) (2 list)]
-                               ['([1 2] [3])])
-                 : (Listof (Listof Number))
-                 '([3 4] [5])))
-
 (define-for-syntax (transform-map: depth stx)
   (syntax-parse stx
     [((~literal curry) (~literal map) f:expr)
@@ -189,165 +147,3 @@
 (define-syntax (map: stx)
   (syntax-parse stx
     [(_ f l) #`(compose-maps #,(transform-map: 1 #'f) [l])]))
-
-(module+ test
-  (check-equal?: (map: car '((1 a) (2 b) (3 c)))
-                 : (Listof Number)
-                 '(1 2 3)))
-
-(module+ test
-  (check-equal?: (map: (∘ (∘ add1)
-                          length
-                          (curry map car)
-                          (curry map list)
-                          (curry map (∘)))
-                       '([1 2] [3]))
-                 : (Listof Number)
-                 '(3 2)))
-
-(module+ test
-  ;(require (submod "..")
-  ;         "../lib/low.rkt")
-  
-  (check-equal?: (map: add1 '(1 2 3))
-                 : (Listof Number)
-                 '(2 3 4))
-  (check-equal?: (map: (compose add1) '(1 2 3))
-                 : (Listof Number)
-                 '(2 3 4))
-  (check-equal?: (map: (∘ identity add1) '(1 2 3))
-                 : (Listof Number)
-                 '(2 3 4))
-  (check-equal?: (map: (∘ add1 identity) '(1 2 3))
-                 : (Listof Number)
-                 '(2 3 4))
-  (check-equal?: (map: (∘ number->string add1) '(1 2 9))
-                 : (Listof String)
-                 '("2" "3" "10"))
-  (check-equal?: (map: (∘ string-length number->string add1) '(1 2 9))
-                 : (Listof Number)
-                 '(1 1 2))
-  (check-equal?: (map: car '((1 2) (2) (9 10 11)))
-                 : (Listof Number)
-                 '(1 2 9))
-  (check-equal?: (map: (∘ add1 car) '((1 2) (2) (9 10 11)))
-                 : (Listof Number)
-                 '(2 3 10))
-  (check-equal?: (map: (∘ string-length number->string add1 car cdr)
-                       '((1 2) (2 3) (8 9 10)))
-                 : (Listof Number)
-                 '(1 1 2))
-  (check-equal?: (map: identity '(1 2 3))
-                 : (Listof Number)
-                 '(1 2 3))
-  (check-equal?: (map: values '(1 2 3))
-                 : (Listof Number)
-                 '(1 2 3))
-  (check-equal?: (map: (compose) '(1 2 3))
-                 : (Listof Number)
-                 '(1 2 3))
-  (check-equal?: (map: (compose identity) '(1 2 3))
-                 : (Listof Number)
-                 '(1 2 3))
-  (check-equal?: (map: (∘ identity values identity values) '(1 2 3))
-                 : (Listof Number)
-                 '(1 2 3))
-  (check-equal?: (map: (∘ length (curry map add1)) '((1 2) (3)))
-                 : (Listof Number)
-                 '(2 1))
-  (check-equal?: (map: (curry map add1) '((1 2) (3)))
-                 : (Listof (Listof Number))
-                 '((2 3) (4)))
-  
-  (define (numlist [x : Number]) (list x))
-  (check-equal?: (map: (∘ (curry map add1) numlist) '(1 2 3))
-                 : (Listof (Listof Number))
-                 '((2) (3) (4)))
-  
-  (check-equal?: (map: (∘ (curry map add1) (λ ([x : Number]) (list x)))
-                       '(1 2 3))
-                 : (Listof (Listof Number))
-                 '((2) (3) (4)))
-  
-  (begin
-    ;; Some of the tests below use (curry map: …), and don't work, because
-    ;; typed/racket wraps the map: identifier with a contract, so the identifier
-    ;; seen outside the module is not the same as the one used in the
-    ;; syntax-parse ~literal clause.
-    
-    (check-equal?: (map: (curry map add1) '((1 2 3) (4 5)))
-                   : (Listof (Listof Number))
-                   '((2 3 4) (5 6)))
-    #;(check-equal?: (map: (curry map: add1) '((1 2 3) (4 5)))
-                     : (Listof (Listof Number))
-                     '((2 3 4) (5 6)))
-    
-    (check-equal?: (map: (curry map (compose number->string add1))
-                         '((1 2 3) (4 5)))
-                   : (Listof (Listof String))
-                   '(("2" "3" "4") ("5" "6")))
-    #;(check-equal?: (map: (curry map: (compose number->string add1))
-                           '((1 2 3) (4 5)))
-                     : (Listof (Listof String))
-                     '(("2" "3" "4") ("5" "6")))
-    
-    (check-equal?: (map: add1 '(1 2 3))
-                   : (Listof Number)
-                   '(2 3 4))
-    
-    (check-equal?: (map: car '((1 a) (2 b) (3 c)))
-                   : (Listof Number)
-                   '(1 2 3))
-    
-    (check-equal?: (map: (curry map car) '([{1 a} {2 b}] [{3 c}]))
-                   : (Listof (Listof Number))
-                   '([1 2] [3]))
-    #;(check-equal?: (map: (curry map: car) '([{1 a} {2 b}] [{3 c}]))
-                     : (Listof (Listof Number))
-                     '([1 2] [3]))
-    
-    (check-equal?: (map: (curry map (curry map car))
-                         '([((1 a) (2 b)) ((3 c))] [((4))]))
-                   : (Listof (Listof (Listof Number)))
-                   '([(1 2) (3)] [(4)]))
-    #;(check-equal?: (map: (curry map (curry map: car))
-                           '([((1 a) (2 b)) ((3 c))] [((4))]))
-                     : (Listof (Listof (Listof Number)))
-                     '([(1 2) (3)] [(4)]))
-    #;(check-equal?: (map: (curry map: (curry map car))
-                           '([((1 a) (2 b)) ((3 c))] [((4))]))
-                     : (Listof (Listof (Listof Number)))
-                     '([(1 2) (3)] [(4)]))
-    #;(check-equal?: (map: (curry map: (curry map: car))
-                           '([((1 a) (2 b)) ((3 c))] [((4))]))
-                     : (Listof (Listof (Listof Number)))
-                     '([(1 2) (3)] [(4)])))
-  
-  (check-equal?: (map: car '((1 b x) (2 c) (3 d)))
-                 : (Listof Number)
-                 '(1 2 3))
-  (check-equal?: (map: cdr '((1 b x) (2 c) (3 d)))
-                 : (Listof (Listof Symbol))
-                 '((b x) (c) (d)))
-  (check-equal?: (map: car (map: cdr '((1 b x) (2 c) (3 d))))
-                 : (Listof Symbol)
-                 '(b c d))
-  (check-equal?: (map: (compose) '((1 b x) (2 c) (3 d)))
-                 : (Listof (Listof (U Number Symbol)))
-                 '((1 b x) (2 c) (3 d)))
-  (check-equal?: (map: (compose car) '((1 b x) (2 c) (3 d)))
-                 : (Listof Number)
-                 '(1 2 3))
-  (check-equal?: (map: (compose cdr) '((1 b x) (2 c) (3 d)))
-                 : (Listof (Listof Symbol))
-                 '((b x) (c) (d)))
-  (check-equal?: (map: (compose car cdr) '((1 b x) (2 c) (3 d)))
-                 : (Listof Symbol)
-                 '(b c d))
-  (check-equal?: (map: (compose add1 car) '((1 b x) (2 c) (3 d)))
-                 : (Listof Number)
-                 '(2 3 4))
-  #|
-  (check-equal?: (map: + '(1 2 3) '(4 5 6))
-                 : (Listof Number)
-                 '(5 7 9))|#)

graph-lib/graph/map_old.rkt

@@ -8,7 +8,6 @@
                    racket/base
                    racket/syntax)
          "../lib/low.rkt"
-         "map1.rkt"
          "get.lp2.rkt"
          "../type-expander/type-expander.lp2.rkt")
 

graph-lib/graph/meta-struct-test.rkt

@@ -0,0 +1,44 @@
+#lang typed/racket
+
+(module test racket
+  (require (for-syntax "meta-struct.rkt")
+           rackunit)
+  
+  (define-syntax (test-subtype? stx)
+    (syntax-case stx ()
+      [(_ sub super)
+       #`#,(if (meta-struct-subtype? #'sub #'super)
+               #t
+               #f)]))
+  
+  (module m1 racket
+    (struct sa ())
+    (provide (struct-out sa)))
+  (module m2 racket
+    (require (submod ".." m1))
+    (struct sb sa ())
+    (provide (rename-out [sa sa2]))
+    (provide (struct-out sb)))
+  (require 'm1)
+  (require 'm2)
+  (struct sc sb ())
+  
+  (check-true (test-subtype? sa sa))
+  (check-true (test-subtype? sa2 sa))
+  (check-true (test-subtype? sb sa))
+  (check-true (test-subtype? sc sa))
+  
+  (check-true (test-subtype? sa sa2))
+  (check-true (test-subtype? sa2 sa2))
+  (check-true (test-subtype? sb sa2))
+  (check-true (test-subtype? sc sa2))
+  
+  (check-false (test-subtype? sa sb))
+  (check-false (test-subtype? sa2 sb))
+  (check-true (test-subtype? sb sb))
+  (check-true (test-subtype? sc sb))
+  
+  (check-false (test-subtype? sa sc))
+  (check-false (test-subtype? sa2 sc))
+  (check-false (test-subtype? sb sc))
+  (check-true (test-subtype? sc sc)))

graph-lib/graph/meta-struct.rkt

@@ -86,46 +86,3 @@
       (let ((up (meta-struct-super-type sub)))
         (and (meta-struct? up)
              (meta-struct-subtype? up super)))))
-
-(module* test racket
-  (require (for-syntax (submod ".."))
-           rackunit)
-  
-  (define-syntax (test-subtype? stx)
-    (syntax-case stx ()
-      [(_ sub super)
-       #`#,(if (meta-struct-subtype? #'sub #'super)
-               #t
-               #f)]))
-  
-  (module m1 racket
-    (struct sa ())
-    (provide (struct-out sa)))
-  (module m2 racket
-    (require (submod ".." m1))
-    (struct sb sa ())
-    (provide (rename-out [sa sa2]))
-    (provide (struct-out sb)))
-  (require 'm1)
-  (require 'm2)
-  (struct sc sb ())
-  
-  (check-true (test-subtype? sa sa))
-  (check-true (test-subtype? sa2 sa))
-  (check-true (test-subtype? sb sa))
-  (check-true (test-subtype? sc sa))
-  
-  (check-true (test-subtype? sa sa2))
-  (check-true (test-subtype? sa2 sa2))
-  (check-true (test-subtype? sb sa2))
-  (check-true (test-subtype? sc sa2))
-  
-  (check-false (test-subtype? sa sb))
-  (check-false (test-subtype? sa2 sb))
-  (check-true (test-subtype? sb sb))
-  (check-true (test-subtype? sc sb))
-  
-  (check-false (test-subtype? sa sc))
-  (check-false (test-subtype? sa2 sc))
-  (check-false (test-subtype? sb sc))
-  (check-true (test-subtype? sc sc)))

graph-lib/graph/queue-test.rkt

@@ -0,0 +1,41 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require "queue.lp2.rkt"
+           typed/rackunit)
+  
+  (let-values
+      ([(h t _)
+        ((inst fold-queue-sets-immutable-tags
+               Integer
+               Void
+               String
+               (List 'a Integer String))
+         (set 6 7)
+         (void)
+         (λ (e acc) (values (format "{~a}" e) acc))
+         (λ (e acc x get-tag)
+           (let*-values ([(t1 acc1 x1) (get-tag (if (even? e)
+                                                    (floor (/ e 2))
+                                                    (+ (* 3 e) 1))
+                                                acc
+                                                x)]
+                         [(t2 acc2 x2) (get-tag 85 acc1 x1)])
+             (values (list 'a e t1) acc2 x2))))])
+    (check-equal? (sort (hash-keys h) <)
+                  (sort '(7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
+                            6 3
+                            85 256 128 64 32)
+                        <))
+    (check-true (set=? (set-remove
+                        (set-remove
+                         (set-remove(list->set (hash-keys h)) 7)
+                         6)
+                        85)
+                       (list->set
+                        (map (λ ([x : (List 'a Integer String)])
+                               (let ([s (caddr x)])
+                                 (string->number
+                                  (substring s 1 (- (string-length s)
+                                                    1)))))
+                             (hash-values h)))))))

graph-lib/graph/queue.lp2.rkt

@@ -394,46 +394,5 @@ was a tag requested.
            <fold-queue-sets-tags>
            <fold-queue-sets-immutable-tags>)
          
-         (require typed/racket)
          (require 'main)
-         (provide (all-from-out 'main))
+         (provide (all-from-out 'main)))]
-         
-         (module* test typed/racket
-           (require (submod "..")
-                    typed/rackunit)
-           
-           (let-values
-               ([(h t _)
-                 ((inst fold-queue-sets-immutable-tags
-                        Integer
-                        Void
-                        String
-                        (List 'a Integer String))
-                  (set 6 7)
-                  (void)
-                  (λ (e acc) (values (format "{~a}" e) acc))
-                  (λ (e acc x get-tag)
-                    (let*-values ([(t1 acc1 x1) (get-tag (if (even? e)
-                                                             (floor (/ e 2))
-                                                             (+ (* 3 e) 1))
-                                                         acc
-                                                         x)]
-                                  [(t2 acc2 x2) (get-tag 85 acc1 x1)])
-                      (values (list 'a e t1) acc2 x2))))])
-             (check-equal? (sort (hash-keys h) <)
-                           (sort '(7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
-                                     6 3
-                                     85 256 128 64 32)
-                                 <))
-             (check-true (set=? (set-remove
-                                 (set-remove
-                                  (set-remove(list->set (hash-keys h)) 7)
-                                  6)
-                                 85)
-                                (list->set
-                                 (map (λ ([x : (List 'a Integer String)])
-                                        (let ([s (caddr x)])
-                                          (string->number
-                                           (substring s 1 (- (string-length s)
-                                                             1)))))
-                                      (hash-values h))))))))]

graph-lib/graph/remember.rkt

@@ -28,6 +28,8 @@
        (group-by (inst car Symbol Any) all-remembered-list)))
 
 (define-list-values all-remembered-list : (Listof (Pairof Symbol Any)))
+;; All the items below are quoted and aggregated into all-remembered-list.
+;; The lines below are automatically added by remember-lib.
 (structure a b c)
 (structure a b c d)
 (structure a b c y)

graph-lib/graph/rewrite-type-test.rkt

@@ -0,0 +1,127 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require (for-syntax (submod "rewrite-type.lp2.rkt" test-syntax)
+                       syntax/strip-context))
+  
+  (define-syntax (insert-tests stx)
+    (replace-context stx tests))
+  
+  (require (for-syntax "rewrite-type.lp2.rkt")
+           typed/rackunit
+           "../type-expander/multi-id.lp2.rkt"
+           "../type-expander/type-expander.lp2.rkt")
+  
+  (insert-tests)
+  
+  ;; make-fold
+  (define-syntax (make-fold stx)
+    (syntax-case stx ()
+      [(_ name type acc-type [from to pred? fun] ...)
+       #`(begin
+           (: name (→ type
+                      acc-type
+                      (Pairof #,(replace-in-type #'type #'([from to] ...))
+                              acc-type)))
+           (define (name [val : type] [acc : acc-type])
+             (let-values ([([res : #,(replace-in-type #'type
+                                                      #'([from to] ...))]
+                            [res-acc : acc-type])
+                           (#,(fold-instance #'type
+                                             #'acc-type
+                                             #'([from to pred? fun] ...))
+                            val
+                            acc)])
+               (cons res res-acc))))]))
+  
+  ;; fold-instance
+  (begin
+    (make-fold test-fold-1
+               (List String Number (List String String Symbol String))
+               Number
+               [String Number string? (λ ([x : String] [acc : Number])
+                                        (values (string-length x)
+                                                (+ acc (string-length x))))])
+    
+    (check-equal? (test-fold-1 '("a" 7 ("bb" "cccc" x "dddddddd")) 0)
+                  '((1 7 (2 4 x 8)) . 15)))
+  
+  (begin
+    (make-fold test-fold-list
+               (List String Number (Pairof String String) Symbol)
+               Number
+               [String Number string? (λ ([x : String] [acc : Number])
+                                        (values (string-length x)
+                                                (+ acc (string-length x))))])
+    
+    (check-equal? (test-fold-list '("a" 9 ("bb" . "cccc") x) 0)
+                  '((1 9 (2 . 4) x) . 7)))
+  
+  (begin
+    (make-fold test-fold-pairof
+               (Pairof String (Pairof Number String))
+               Number
+               [String Number string? (λ ([x : String] [acc : Number])
+                                        (values (string-length x)
+                                                (+ acc (string-length x))))])
+    
+    (check-equal? (test-fold-pairof '("a" 7 . "bb") 0)
+                  '((1 7 . 2) . 3)))
+  
+  (begin
+    (make-fold test-fold-listof
+               (List String Number (Listof String) Symbol String)
+               Number
+               [String Number string? (λ ([x : String] [acc : Number])
+                                        (values (string-length x)
+                                                (+ acc (string-length x))))])
+    
+    (check-equal? (test-fold-listof
+                   '("a" 7 ("bb" "cccc" "dddddddd") x "eeeeeeeeeeeeeeee")
+                   0)
+                  '((1 7 (2 4 8) x 16) . 31)))
+  
+  (begin
+    (make-fold test-fold-vector
+               (Vector String Number (Vectorof String) Symbol String)
+               Number
+               [String Number string? (λ ([x : String] [acc : Number])
+                                        (values (string-length x)
+                                                (+ acc (string-length x))))])
+    
+    (check-equal? (test-fold-vector
+                   '#("a" 7 #("bb" "cccc" "dddddddd") x "eeeeeeeeeeeeeeee")
+                   0)
+                  '(#(1 7 #(2 4 8) x 16) . 31)))
+  
+  (begin
+    (make-fold test-fold-vectorof
+               (Vectorof (U (List 'tag1 String String) (List 'tag2 Number)))
+               Number
+               [String Number string? (λ ([x : String] [acc : Number])
+                                        (values (string-length x)
+                                                (+ acc (string-length x))))])
+    
+    (check-equal? (test-fold-vectorof
+                   '#((tag1 "a" "bb") (tag2 7) (tag1 "cccc" "dddddddd"))
+                   0)
+                  '(#((tag1 1 2) (tag2 7) (tag1 4 8)) . 15)))
+  
+  
+  (begin
+    (make-fold test-fold-big
+               (List (Pairof (U (List 'tag1 (List (Vector Symbol)
+                                                  Number
+                                                  (Listof String)))
+                                (List 'tag2 (List (Vector Symbol)
+                                                  Number
+                                                  (Listof String))))
+                             String))
+               Number
+               [String Number string? (λ ([x : String] [acc : Number])
+                                        (values (string-length x)
+                                                (+ acc (string-length x))))])
+    
+    (check-equal?
+     (test-fold-big '(((tag2 (#(sym) 7 ("a" "bb" "cccc"))) . "dddddddd")) 0)
+     '((((tag2 (#(sym) 7 (1 2 4))) . 8)) . 15))))

graph-lib/graph/rewrite-type.lp2.rkt

@@ -285,119 +285,6 @@ have each substitution have a different accumulator by using @tc[list] or
 The order in which the elements of the structure are passed to the substitution
 functions is undefined.
 
-@subsection{Tests}
-
-@CHUNK[<test-fold-instance>
-       (make-fold test-fold-1
-                  (List String Number (List String String Symbol String))
-                  Number
-                  [String Number string? (λ ([x : String] [acc : Number])
-                                           (values (string-length x)
-                                                   (+ acc (string-length x))))])
-       
-       (check-equal? (test-fold-1 '("a" 7 ("bb" "cccc" x "dddddddd")) 0)
-                     '((1 7 (2 4 x 8)) . 15))]
-
-@CHUNK[<test-fold-instance>
-       (make-fold test-fold-list
-                  (List String Number (Pairof String String) Symbol)
-                  Number
-                  [String Number string? (λ ([x : String] [acc : Number])
-                                           (values (string-length x)
-                                                   (+ acc (string-length x))))])
-       
-       (check-equal? (test-fold-list '("a" 9 ("bb" . "cccc") x) 0)
-                     '((1 9 (2 . 4) x) . 7))]
-
-@CHUNK[<test-fold-instance>
-       (make-fold test-fold-pairof
-                  (Pairof String (Pairof Number String))
-                  Number
-                  [String Number string? (λ ([x : String] [acc : Number])
-                                           (values (string-length x)
-                                                   (+ acc (string-length x))))])
-       
-       (check-equal? (test-fold-pairof '("a" 7 . "bb") 0)
-                     '((1 7 . 2) . 3))]
-
-@CHUNK[<test-fold-instance>
-       (make-fold test-fold-listof
-                  (List String Number (Listof String) Symbol String)
-                  Number
-                  [String Number string? (λ ([x : String] [acc : Number])
-                                           (values (string-length x)
-                                                   (+ acc (string-length x))))])
-       
-       (check-equal? (test-fold-listof
-                      '("a" 7 ("bb" "cccc" "dddddddd") x "eeeeeeeeeeeeeeee")
-                      0)
-                     '((1 7 (2 4 8) x 16) . 31))]
-
-@CHUNK[<test-fold-instance>
-       (make-fold test-fold-vector
-                  (Vector String Number (Vectorof String) Symbol String)
-                  Number
-                  [String Number string? (λ ([x : String] [acc : Number])
-                                           (values (string-length x)
-                                                   (+ acc (string-length x))))])
-       
-       (check-equal? (test-fold-vector
-                      '#("a" 7 #("bb" "cccc" "dddddddd") x "eeeeeeeeeeeeeeee")
-                      0)
-                     '(#(1 7 #(2 4 8) x 16) . 31))]
-
-@CHUNK[<test-fold-instance>
-       (make-fold test-fold-vectorof
-                  (Vectorof (U (List 'tag1 String String) (List 'tag2 Number)))
-                  Number
-                  [String Number string? (λ ([x : String] [acc : Number])
-                                           (values (string-length x)
-                                                   (+ acc (string-length x))))])
-       
-       (check-equal? (test-fold-vectorof
-                      '#((tag1 "a" "bb") (tag2 7) (tag1 "cccc" "dddddddd"))
-                      0)
-                     '(#((tag1 1 2) (tag2 7) (tag1 4 8)) . 15))]
-
-
-@CHUNK[<test-fold-instance>
-       (make-fold test-fold-big
-                  (List (Pairof (U (List 'tag1 (List (Vector Symbol)
-                                                     Number
-                                                     (Listof String)))
-                                   (List 'tag2 (List (Vector Symbol)
-                                                     Number
-                                                     (Listof String))))
-                                String))
-                  Number
-                  [String Number string? (λ ([x : String] [acc : Number])
-                                           (values (string-length x)
-                                                   (+ acc (string-length x))))])
-       
-       (check-equal?
-        (test-fold-big '(((tag2 (#(sym) 7 ("a" "bb" "cccc"))) . "dddddddd")) 0)
-        '((((tag2 (#(sym) 7 (1 2 4))) . 8)) . 15))]
-
-@CHUNK[<test-make-fold>
-       (define-syntax (make-fold stx)
-         (syntax-case stx ()
-           [(_ name type acc-type [from to pred? fun] ...)
-            #`(begin
-                (: name (→ type
-                           acc-type
-                           (Pairof #,(replace-in-type #'type #'([from to] ...))
-                                   acc-type)))
-                (define (name [val : type] [acc : acc-type])
-                  (let-values ([([res : #,(replace-in-type #'type
-                                                           #'([from to] ...))]
-                                 [res-acc : acc-type])
-                                (#,(fold-instance #'type
-                                                  #'acc-type
-                                                  #'([from to pred? fun] ...))
-                                 val
-                                 acc)])
-                    (cons res res-acc))))]))]
-
 @subsection{The code}
 
 @CHUNK[<fold-instance>
@@ -700,15 +587,11 @@ These metafunctions just extract the arguments for @tc[replace-in-type] and
          (require 'main)
          (provide (all-from-out 'main))
          
-         (module* test typed/racket
+         (module test-syntax racket
-           (require (for-syntax (submod ".."))
+           (provide tests)
-                    typed/rackunit
+           (define tests
-                    "../type-expander/multi-id.lp2.rkt"
+             (quote-syntax
-                    "../type-expander/type-expander.lp2.rkt")
+              (begin
-           
+                <test-make-replace>
-           <test-make-replace>
+                <test-example>
-           <test-example>
+                <test-big>)))))]
-           <test-big>
-           
-           <test-make-fold>
-           <test-fold-instance>))]

graph-lib/graph/structure-test.rkt

@@ -0,0 +1,155 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require (for-syntax (submod "structure.lp2.rkt" test-syntax)
+                       syntax/strip-context))
+  
+  (define-syntax (insert-tests stx)
+    (replace-context stx tests))
+  
+  (require "structure.lp2.rkt"
+           "../lib/low.rkt"
+           "../type-expander/type-expander.lp2.rkt"
+           typed/rackunit)
+  
+  (insert-tests)
+  
+  ;; structure-get field
+  (begin
+    (check-equal?:
+     (structure-get ((make-structure-constructor a b c d) 1 "b" 'val-c 4) c)
+     : 'val-c
+     'val-c))
+  
+  ;; match-expander
+  (begin
+    (let ([test-match 
+           (λ ([val : Any])
+             (match val
+               [(structure a b c y) (list a b c y)]
+               [(structure d
+                           [a (? number?)]
+                           [c (? symbol?) 'value-c]
+                           [b bb (? string?)])
+                (list a bb c d)]
+               [else 'other]))])
+      (check-equal?: (test-match
+                      ((make-structure-constructor a b c d) 1
+                                                            "b"
+                                                            'value-c
+                                                            4))
+                     '(1 "b" value-c 4))
+      (check-equal?: (test-match
+                      ((make-structure-constructor a b c y) 1 2 3 4))
+                     '(1 2 3 4))
+      (check-equal?: (test-match 'bad) 'other)))
+  
+  ;; type-expander
+  (begin
+    (check-equal?
+     (structure-get (ann ((make-structure-constructor a b c) 1 "b" #t)
+                         (structure [a Number] [c Boolean] [b String]))
+                    b)
+     "b"))
+  
+  ;; structure
+  (begin
+    (let ()
+      (define-structure empty-st)
+      (define-structure stA [a Number])
+      ;; BUG 137 (check-equal?: (empty-st) ((structure #:make-instance)))
+      (check-not-equal?: (empty-st) (structure [a 1]))
+      (check-not-equal?: (structure #:make-instance) (structure [a 1]))
+      (check-not-equal?: (empty-st) (stA 1))
+      (check-not-equal?: (structure #:make-instance) (stA 1))
+      (void))
+    
+    ;; TODO: uncomment these tests:
+    #;(let ()
+        (define-structure st [a Number] [b String])
+        (define-structure stA [a Number])
+        (define-structure stABC [a Number] [b String] [c Number])
+        (define st1 (st 1 "b"))
+        (define st2 (st 2 "b"))
+        (define sta (stA 1))
+        (define st3 (stABC 1 "b" 3))
+        
+        (check-equal?-classes:
+         [#:name st1
+          st1
+          (structure [a 1] [b "b"])
+          (structure [a : Number 1] [b : String "b"])
+          ((structure [a : Number] [b : String]) 1 "b")
+          (structure [a : Any 1] [b : Any "b"])
+          ((structure [a : Any] [b : Any]) 1 "b")
+          ((structure [a] [b]) 1 "b")
+          ((structure a b) 1 "b")
+          ((structure [a] b) 1 "b")]
+         [(structure [a "1"] [b 'b])
+          (structure [a : String "1"] [b : Symbol 'b])
+          (structure [a : Any "1"] [b : Any 'b])]
+         [st2]
+         [sta]
+         [st3])))
+  
+  ;; define-structure
+  (begin
+    (define-structure empty-st)
+    (define-structure st [a Number] [b String])
+    (define-structure st2 [b String] [a Number] #:? custom-is-st2?)
+    (define-structure st3 [c String] [a Number] #:? custom-is-st3?))
+  
+  ;; Constructor:
+  ;; BUG 137 (check-equal?: (empty-st) : empty-st (empty-st))
+  (begin
+    (check-equal?: (structure-get (st 1 "b") b) : String "b")
+    (check-equal?: (structure-get (st2 "a" 2) b) : String "a"))
+  
+  ;; Constructor, as id:
+  (begin
+    (check-equal?: (structure-get (cadr (map st '(1 2 3) '("x" "y" "z"))) b)
+                   : String
+                   "y")
+    (check-equal?: (structure-get (cadr (map st2 '("d" "e" "f") '(1 2 3))) b)
+                   : String
+                   "e"))
+  
+  ;; type-expander
+  (begin
+    (check-equal?: (structure-get (ann (st2 "g" 123) st2) b) "g"))
+  
+  ;; match-expander
+  (begin
+    (check-equal?: (match (st2 "h" 7) [(st x y) (cons x y)])
+                   : (Pairof Number String)
+                   '(7 . "h")))
+  
+  ;; Equality
+  (begin
+    ;; BUG 137 (check-equal?: (ann (st 1 "i") st) (st 1 "i"))
+    ;; BUG 137 (check-equal?: (ann (st2 "j" 2) st2) (st2 "j" 2))
+    ;; BUG 137 (check-equal?: (ann (st 1 "k") st) (st2 "k" 1))
+    )
+  
+  ;; Predicate
+  (begin
+    (check-equal?: (st? (ann (st 1 "i") (U st st2))) #t)
+    (check-equal?: (custom-is-st2? (ann (st 1 "i") (U st st2))) #t)
+    (check-equal?: (custom-is-st3? (ann (st 1 "i") (U st st2))) #f)
+    (check-equal?: (st? (ann (st 1 "i") (U Number st st2))) #t)
+    (check-equal?: (st? (ann 1 (U Number st st2))) #f)
+    ;; Occurrence typing won't work well, if only because fields could be of
+    ;; a type for which TR doesn't know how to make-predicate.
+    #|(define (check-occurrence-typing [x : (U Number st st3)])
+       (if (st? x)
+       (match (ann x st) [(st the-a the-b) (cons the-b the-a)])
+       'other))
+       (check-equal?
+       (check-occurrence-typing (ann (st 1 "i") (U Number st st3)))
+       '("i" . 1))
+       (check-equal?
+       (check-occurrence-typing (ann (st2 "j" 2) (U Number st st3)))
+       'other)
+       (check-equal?
+       (check-occurrence-typing (ann 9 (U Number st st3)))
+       'other)|#))

graph-lib/graph/structure.lp2.rkt

@@ -64,42 +64,6 @@ handle the empty structure as a special case.
                'disappeared-use (stx-map syntax-local-introduce
                                          (template ((?? (?@ (C …)))))))])))]
 
-@chunk[<test-structure>
-       (let ()
-         (define-structure empty-st)
-         (define-structure stA [a Number])
-         ;; BUG 137 (check-equal?: (empty-st) ((structure #:make-instance)))
-         (check-not-equal?: (empty-st) (structure [a 1]))
-         (check-not-equal?: (structure #:make-instance) (structure [a 1]))
-         (check-not-equal?: (empty-st) (stA 1))
-         (check-not-equal?: (structure #:make-instance) (stA 1)))
-       #;(let ()
-           (define-structure st [a Number] [b String])
-           (define-structure stA [a Number])
-           (define-structure stABC [a Number] [b String] [c Number])
-           (define st1 (st 1 "b"))
-           (define st2 (st 2 "b"))
-           (define sta (stA 1))
-           (define st3 (stABC 1 "b" 3))
-           
-           (check-equal?-classes:
-            [#:name st1
-             st1
-             (structure [a 1] [b "b"])
-             (structure [a : Number 1] [b : String "b"])
-             ((structure [a : Number] [b : String]) 1 "b")
-             (structure [a : Any 1] [b : Any "b"])
-             ((structure [a : Any] [b : Any]) 1 "b")
-             ((structure [a] [b]) 1 "b")
-             ((structure a b) 1 "b")
-             ((structure [a] b) 1 "b")]
-            [(structure [a "1"] [b 'b])
-             (structure [a : String "1"] [b : Symbol 'b])
-             (structure [a : Any "1"] [b : Any 'b])]
-            [st2]
-            [sta]
-            [st3]))]
-
 @chunk[<define-structure>
        (define-syntax (define-structure stx)
          (syntax-parse stx
@@ -127,74 +91,6 @@ handle the empty structure as a special case.
                    [(structure [field _] …) #t]
                    [_ #f]))))]))]
 
-
-@chunk[<test-define-structure>
-       (define-structure empty-st)
-       (define-structure st [a Number] [b String])
-       (define-structure st2 [b String] [a Number] #:? custom-is-st2?)
-       (define-structure st3 [c String] [a Number] #:? custom-is-st3?)]
-
-Test constructor:
-
-@chunk[<test-define-structure>
-       ;; BUG 137 (check-equal?: (empty-st) : empty-st (empty-st))
-       (check-equal?: (structure-get (st 1 "b") b) : String "b")
-       (check-equal?: (structure-get (st2 "a" 2) b) : String "a")]
-
-Test constructor, as id:
-
-@chunk[<test-define-structure>
-       (check-equal?: (structure-get (cadr (map st '(1 2 3) '("x" "y" "z"))) b)
-                      : String
-                      "y")
-       (check-equal?: (structure-get (cadr (map st2 '("d" "e" "f") '(1 2 3))) b)
-                      : String
-                      "e")]
-
-Test the type-expander:
-
-@chunk[<test-define-structure>
-       (check-equal?: (structure-get (ann (st2 "g" 123) st2) b) "g")]
-
-Test the match-expander:
-
-@chunk[<test-define-structure>
-       (check-equal?: (match (st2 "h" 7) [(st x y) (cons x y)])
-                      : (Pairof Number String)
-                      '(7 . "h"))]
-
-Test equality:
-
-@chunk[<test-define-structure>
-       ;; BUG 137 (check-equal?: (ann (st 1 "i") st) (st 1 "i"))
-       ;; BUG 137 (check-equal?: (ann (st2 "j" 2) st2) (st2 "j" 2))
-       ;; BUG 137 (check-equal?: (ann (st 1 "k") st) (st2 "k" 1))
-       ]
-
-Test predicate:
-
-@chunk[<test-define-structure>
-       (check-equal?: (st? (ann (st 1 "i") (U st st2))) #t)
-       (check-equal?: (custom-is-st2? (ann (st 1 "i") (U st st2))) #t)
-       (check-equal?: (custom-is-st3? (ann (st 1 "i") (U st st2))) #f)
-       (check-equal?: (st? (ann (st 1 "i") (U Number st st2))) #t)
-       (check-equal?: (st? (ann 1 (U Number st st2))) #f)
-       ;; Occurrence typing won't work well, if only because fields could be of
-       ;; a type for which TR doesn't know how to make-predicate.
-       #|(define (check-occurrence-typing [x : (U Number st st3)])
-       (if (st? x)
-       (match (ann x st) [(st the-a the-b) (cons the-b the-a)])
-       'other))
-       (check-equal?
-       (check-occurrence-typing (ann (st 1 "i") (U Number st st3)))
-       '("i" . 1))
-       (check-equal?
-       (check-occurrence-typing (ann (st2 "j" 2) (U Number st st3)))
-       'other)
-       (check-equal?
-       (check-occurrence-typing (ann 9 (U Number st st3)))
-       'other)|#]
-
 @section{Pre-declaring structs}
 
 We wish to pre-declare all @tc[struct] types for various reasons:
@@ -430,12 +326,6 @@ The fields in @tc[fields→stx-name-alist] are already sorted.
        (list-ref (meta-struct-accessors (cdr s) #:srcloc stx)
                  (indexof (syntax->datum #'field) (reverse (car s))))]
 
-@chunk[<test-get-field>
-       (check-equal?:
-        (structure-get ((make-structure-constructor a b c d) 1 "b" 'val-c 4) c)
-        : 'val-c
-        'val-c)]
-
 @subsection{Predicate}
 
 @chunk[<structure?>
@@ -481,28 +371,6 @@ instead of needing an extra recompilation.
        #`(app #,(remember-all-errors #'list stx #'(field ...))
               (and pat ...) ...)]
 
-@chunk[<test-match-expander>
-       (let ([test-match 
-              (λ ([val : Any])
-                (match val
-                  [(structure a b c y) (list a b c y)]
-                  [(structure d
-                              [a (? number?)]
-                              [c (? symbol?) 'value-c]
-                              [b bb (? string?)])
-                   (list a bb c d)]
-                  [else 'other]))])
-         (check-equal?: (test-match
-                         ((make-structure-constructor a b c d) 1
-                                                               "b"
-                                                               'value-c
-                                                               4))
-                        '(1 "b" value-c 4))
-         (check-equal?: (test-match
-                         ((make-structure-constructor a b c y) 1 2 3 4))
-                        '(1 2 3 4))
-         (check-equal?: (test-match 'bad) 'other))]
-
 @subsection{Anonymous type}
 
 @subsection{Type-expander}
@@ -527,13 +395,6 @@ instead of needing an extra recompilation.
                       #`(#,(fields→stx-name #'(field ...)) sorted-type ...)))
                 (remember-all-errors #'U stx #'(field ...)))]))]
 
-@chunk[<test-type-expander>
-       (check-equal?
-        (structure-get (ann ((make-structure-constructor a b c) 1 "b" #t)
-                            (structure [a Number] [c Boolean] [b String]))
-                       b)
-        "b")]
-
 @section[#:tag "structure|remember"]{Closed-world assumption and global
  compilation}
 
@@ -606,18 +467,11 @@ its arguments across compilations, and adds them to the file
          (require 'main)
          (provide (all-from-out 'main))
          
-         (module* test typed/racket
+         (module test-syntax racket
-           (require (submod "..")
+           (provide tests)
-                    "../lib/low.rkt"
+           (define tests
-                    "../type-expander/type-expander.lp2.rkt"
+             #'(begin
-                    typed/rackunit)
+                 <test-make-structure-constructor>))))]
-           
-           <test-make-structure-constructor>
-           <test-get-field>
-           <test-match-expander>
-           <test-type-expander>
-           <test-structure>
-           <test-define-structure>))]
 
 @section{Optimizing access to fields}
 

graph-lib/graph/tagged-test.rkt

@@ -0,0 +1,19 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require "tagged.lp2.rkt"
+           "../lib/low.rkt"
+           "../type-expander/type-expander.lp2.rkt")
+  
+  (check-equal?: (match (ann (tagged t1 [x 1] [y "b"])
+                             (tagged t1 [x : Number] [y : String]))
+                   [(tagged t1 [x a] [y b]) (list 'ok b a)]
+                   [_ #f])
+                 '(ok "b" 1))
+  (check-equal?: (match (ann (tagged foo [x "o"] [y 3] [z 'z])
+                             (tagged foo
+                                     [x String]
+                                     [z 'z]
+                                     [y Fixnum]))
+                   [(tagged foo z x y) (list z y x)])
+                 '(z 3 "o")))

graph-lib/graph/tagged.lp2.rkt

@@ -114,24 +114,6 @@ for a structure.
                       ((structure? field …)
                        (force (constructor-values v)))))))]
 
-@section{Tests}
-
-@chunk[<test-tagged>
-       (check-equal?: (match (ann (tagged t1 [x 1] [y "b"])
-                                  (tagged t1 [x : Number] [y : String]))
-                        [(tagged t1 [x a] [y b]) (list 'ok b a)]
-                        [_ #f])
-                      '(ok "b" 1))]
-
-@chunk[<test-tagged>
-       (check-equal?: (match (ann (tagged foo [x "o"] [y 3] [z 'z])
-                                  (tagged foo
-                                          [x String]
-                                          [z 'z]
-                                          [y Fixnum]))
-                        [(tagged foo z x y) (list z y x)])
-                      '(z 3 "o"))]
-
 @section{Conclusion}
 
 @chunk[<*>
@@ -159,10 +141,4 @@ for a structure.
            <tagged?>)
          
          (require 'main)
-         (provide (all-from-out 'main))
+         (provide (all-from-out 'main)))]
-         
-         (module* test typed/racket
-           (require (submod "..")
-                    "../lib/low.rkt"
-                    "../type-expander/type-expander.lp2.rkt")
-           <test-tagged>))]

graph-lib/graph/test-map-get.rkt

@@ -1,44 +0,0 @@
-#lang typed/racket
-
-(module test typed/racket
-  (require (submod "graph.lp2.rkt" test))
-  (require "get.lp2.rkt")
-  (require "map.rkt")
-  (require "adt.lp2.rkt")
-  (require "../lib/low.rkt")
-  (require "../type-expander/type-expander.lp2.rkt")
-  
-  ((tagged t a b c) 1 'b "c")
-  ((tagged t a [b] c) 1 'b "c")
-  ((tagged t [a] [b] [c]) 1 'b "c")
-  ((tagged t [a : Number] [b : Symbol] [c : String]) 1 'b "c")
-  (tagged t [a : Number 1] [b : Symbol 'b] [c : String "c"])
-  (tagged t [a 1] [b 'b] [c "c"])
-  
-  (tagged t [a 1] [b 'b] [c "c"])
-  
-  (define-tagged tabc [a 1] [b 'b] [c "c"])
-  
-  (map: (λget houses) (get g streets))
-  (map: (λget houses … owner name) (get g streets))
-  (map: (∘ (curry map (∘ (λget name) (λget owner))) (λget houses))
-        (get g streets))
-  (map: (∘ (curry map (∘ string-length (λget name) (λget owner))) (λget houses))
-        (get g streets))
-  
-  (map: (compose (curry map identity) (λget houses …)) (get g streets))
-  ;; Can be allowed by changing (→ (→ A B) A B) in a couple of places in map: to
-  ;; a case→, but it's more heavy on the typechecker, and it's an uncommon case.
-  ;(map: (compose (λget houses …) (λ #:∀ (A) ([x : A]) x)) (get g streets))
-  (map: (compose (curry map (λget owner)) (λget houses …)) (get g streets))
-  
-  (get '((1 2) (3)) … …)
-  (uniform-get g people)
-  (get g people)
-  (get g streets cadr houses car owner name)
-  ((λget people) g)
-  ((λget owner name) (get g streets cadr houses car))
-  (get g streets … houses … owner name)
-  ((λget streets … houses … owner name) g)
-  (let ([f (λget streets … houses … owner name)]) f)
-  (map: (λget houses … owner name) (get g streets)))

graph-lib/graph/uniform-get.lp2.rkt

@@ -69,10 +69,4 @@ retrieves the desired field from the structure.
            <uniform-get>)
          
          (require 'main)
-         (provide (all-from-out 'main))
+         (provide (all-from-out 'main)))]
-         
-         (module* test typed/racket
-           (require (submod "..")
-                    "../lib/low.rkt"
-                    "../type-expander/type-expander.lp2.rkt")
-           ))]

graph-lib/graph/variant-test.rkt

@@ -0,0 +1,24 @@
+#lang typed/racket
+
+(module test typed/racket
+  (require "variant2.lp2.rkt"
+           "constructor.lp2.rkt"
+           "../lib/low.rkt"
+           "../type-expander/type-expander.lp2.rkt")
+  
+  (define-variant v1 [x Number String] [y String Number] [z Number String])
+  (check-equal?: (ann (constructor x 1 "a")
+                      (U [constructor w Number String]
+                         [constructor x Number String]
+                         [constructor y String Number]))
+                 (constructor x 1 "a"))
+  (check-equal?: (constructor x 1 "a")
+                 (constructor x 1 "a"))
+  (check-equal?: (ann (constructor x 1 "a") v1)
+                 (constructor x 1 "a"))
+  (check-equal?: (ann (constructor x 1 "a") v1)
+                 (ann (constructor x 1 "a") v1))
+  (check-not-equal?: (ann (constructor x 2 "b") v1)
+                     (ann (constructor y "b" 2) v1))
+  (check-not-equal?: (ann (constructor x 3 "c") v1)
+                     (ann (constructor z 3 "c") v1)))

graph-lib/graph/variant2.lp2.rkt

@@ -101,26 +101,6 @@ function.
                                               t))
                       #'(tag …)))|#)]
 
-@section{Tests}
-
-@chunk[<test-define-variant>
-       (define-variant v1 [x Number String] [y String Number] [z Number String])
-       (check-equal?: (ann (constructor x 1 "a")
-                           (U [constructor w Number String]
-                              [constructor x Number String]
-                              [constructor y String Number]))
-                      (constructor x 1 "a"))
-       (check-equal?: (constructor x 1 "a")
-                      (constructor x 1 "a"))
-       (check-equal?: (ann (constructor x 1 "a") v1)
-                      (constructor x 1 "a"))
-       (check-equal?: (ann (constructor x 1 "a") v1)
-                      (ann (constructor x 1 "a") v1))
-       (check-not-equal?: (ann (constructor x 2 "b") v1)
-                          (ann (constructor y "b" 2) v1))
-       (check-not-equal?: (ann (constructor x 3 "c") v1)
-                          (ann (constructor z 3 "c") v1))]
-
 @section{Conclusion}
 
 @chunk[<*>
@@ -147,12 +127,4 @@ function.
            <define-variant>)
          
          (require 'main)
-         (provide (all-from-out 'main))
+         (provide (all-from-out 'main)))]
-         
-         (module* test typed/racket
-           (require (submod "..")
-                    "constructor.lp2.rkt"
-                    "../lib/low.rkt"
-                    "../type-expander/type-expander.lp2.rkt")
-           
-           <test-define-variant>))]

graph-lib/lib/low/typed-rackunit.rkt

@@ -3,6 +3,7 @@
 (define-typed/untyped-modules #:no-test
   ;; TODO: these won't expand types in the ann.
   (provide check-equal?:
+           check-true:
            check-not-equal?:
            check-ann)
   
@@ -52,6 +53,26 @@
                          (untyped:check-true
                           (equal? (?? (ann actual type) actual)
                                   expected))))))
+
+  (define-syntax/parse
+    (check-true: actual
+                 (~optional message:expr))
+    (quasitemplate
+     (with-check-info* (list (make-check-actual (format "~s" actual))
+                             (make-check-expected (format "~s" #t))
+                             (make-check-name 'check-equal?:)
+                             (make-check-params
+                              (format "~s" `(,actual)))
+                             (make-check-location '(#,(syntax-source stx)
+                                                    #,(syntax-line stx)
+                                                    #,(syntax-column stx)
+                                                    #,(syntax-position stx)
+                                                    #,(syntax-span stx)))
+                             (make-check-expression '#,(syntax->datum stx)))
+                       (λ ()
+                         (untyped:check-true
+                          ;; TODO: do we really need the (not (not …)) here?
+                          (not (not actual)))))))
   
   (define-syntax/parse
     (check-not-equal?: actual