diff --git a/graph-lib/graph/__DEBUG_graph6.rkt b/graph-lib/graph/__DEBUG_graph6.rkt index 73606a80..1ac9dec0 100644 --- a/graph-lib/graph/__DEBUG_graph6.rkt +++ b/graph-lib/graph/__DEBUG_graph6.rkt @@ -3,7 +3,6 @@ (module test-~>-bound typed/racket (require "graph-6-rich-returns.lp2.rkt" "../lib/low.rkt" - ;"graph.lp2.rkt" "get.lp2.rkt" "../type-expander/type-expander.lp2.rkt") @@ -46,8 +45,10 @@ (module test-~>-unbound typed/racket (require "graph-6-rich-returns.lp2.rkt" + (only-in "../lib/low.rkt" + check-equal?: + …) "get.lp2.rkt" - typed/rackunit "../type-expander/type-expander.lp2.rkt") (define-type blob String) @@ -66,10 +67,10 @@ : (Listof Street) (map Street snames)]) - (check-equal? (let ([l (grr3 '(("a" "b" "c") ("d")))]) - (list (get (car l) streets … sname) - (get (cadr l) streets … sname))) - '(("a" "b" "c") ("d"))) + (check-equal?: (let ([l (grr3 '(("a" "b" "c") ("d")))]) + (list (get (car l) streets … sname) + (get (cadr l) streets … sname))) + '(("a" "b" "c") ("d"))) ;; Check that there are no collisions: ;; Same as above with just the graph name changed @@ -88,4 +89,4 @@ (module test typed/racket (require (submod ".." test-~>-bound)) - (require (submod ".." test-~>-unbound))) + (require (submod ".." test-~>-unbound))) \ No newline at end of file diff --git a/graph-lib/graph/adt-test.rkt b/graph-lib/graph/adt-test.rkt index 1d01f344..55ff5143 100644 --- a/graph-lib/graph/adt-test.rkt +++ b/graph-lib/graph/adt-test.rkt @@ -5,6 +5,8 @@ (require "adt.lp2.rkt") (require "../lib/low.rkt") (require "../type-expander/type-expander.lp2.rkt") + + (define-tagged st2 [b String] [a Number]) ((tagged t a b c) 1 'b "c") ((tagged t a [b] c) 1 'b "c") diff --git a/graph-lib/graph/graph-fallback-types.rkt b/graph-lib/graph/graph-fallback-types.rkt new file mode 100644 index 00000000..2cf0c8b3 --- /dev/null +++ b/graph-lib/graph/graph-fallback-types.rkt @@ -0,0 +1,58 @@ +#lang s-exp "../lib.rkt" + +;; Tests with incomplete / outer-incomplete type-expander. + +(define-type-expander (outer-incomplete stx) + (syntax-case stx () + [(_ n) + #;(raise-syntax-error + 'incomplete + (format "Type doesn't have an incomplete counterpart: ~a" + (syntax->datum #'n)) + #'n) + ;; Just for testing: + #''test])) + +(define-type C Boolean) + +(define-type C/incomplete (Pairof 'C Boolean)) + +(define-type-expander (incomplete stx) + (syntax-case stx () + [(_ n) + (cond [(free-identifier=? #'n #'C) #'C/incomplete] + [else #'(outer-incomplete n)])])) + +(let () + (define-type-expander (outer-incomplete stx) + (syntax-case stx () [(_ n) #'(incomplete n)])) + (let () + (define-type A Number) + (define-type B String) + + (define-type A/incomplete (Pairof 'A Number)) + (define-type B/incomplete (Pairof 'B String)) + + (define-type-expander (incomplete stx) + (syntax-case stx () + [(_ n) + (cond [(free-identifier=? #'n #'A) #'A/incomplete] + [(free-identifier=? #'n #'B) #'B/incomplete] + [else + #'(outer-incomplete n)])])) + + (define-type TA A) + (define-type TAI (incomplete A)) + (ann '(A . 1) TAI) + + (define-type TC C) + (define-type TCI (incomplete C)) + (ann #t TC) + (ann '(C . #t) TCI) + + (let () + (define-type A Boolean) + (define-type TA A) + (define-type TAI (incomplete A)) + (ann 'test TAI) + (void)))) \ No newline at end of file diff --git a/graph-lib/graph/graph.lp2.rkt b/graph-lib/graph/graph.lp2.rkt index 715a765c..22b65f76 100644 --- a/graph-lib/graph/graph.lp2.rkt +++ b/graph-lib/graph/graph.lp2.rkt @@ -843,9 +843,7 @@ We will be able to use this type expander in function types, for example: ;(begin-for-syntax ;) - (provide define-graph - define-graph-second-step ; DEBUG - ) + (provide define-graph) )] diff --git a/graph-lib/graph/remember.rkt b/graph-lib/graph/remember.rkt index 9b409189..5e4f7710 100644 --- a/graph-lib/graph/remember.rkt +++ b/graph-lib/graph/remember.rkt @@ -183,3 +183,11 @@ (structure sym) (structure ctr water) (structure ctr water) +(constructor . ma) +(constructor . mb) +(constructor . st2) +(structure f1a f2a) +(structure f1b) +(structure f1a f2a) +(structure f1b) +(structure f1a f2a) diff --git a/graph-lib/graph/tagged-test.rkt b/graph-lib/graph/tagged-test.rkt index 565c62cd..3b942572 100644 --- a/graph-lib/graph/tagged-test.rkt +++ b/graph-lib/graph/tagged-test.rkt @@ -16,4 +16,7 @@ [z 'z] [y Fixnum])) [(tagged foo z x y) (list z y x)]) - '(z 3 "o"))) \ No newline at end of file + '(z 3 "o")) + + (define-type ma (tagged ma (fav String) (faa ma) (fab mb))) + (define-type mb (tagged mb (fbv String) (fba ma)))) \ No newline at end of file diff --git a/graph-lib/lib.rkt b/graph-lib/lib.rkt index bcc4b2f9..f4fcafc5 100644 --- a/graph-lib/lib.rkt +++ b/graph-lib/lib.rkt @@ -11,7 +11,8 @@ "type-expander/multi-id.lp2.rkt" "type-expander/type-expander.lp2.rkt" "graph/adt.lp2.rkt" - "graph/graph.lp2.rkt" + ;"graph/graph.lp2.rkt" + "graph/graph-6-rich-returns.lp2.rkt" "graph/get.lp2.rkt" "graph/map.rkt" #|"graph/rewrite-type.lp2.rkt"|#) @@ -20,3 +21,6 @@ "type-expander/type-expander.lp2.rkt")) (provide (all-from-out "graph/dotlang.rkt")) + +(require (for-syntax racket/base)) +(provide (for-syntax (all-from-out racket/base))) \ No newline at end of file diff --git a/graph-lib/lib/low/syntax-parse.rkt b/graph-lib/lib/low/syntax-parse.rkt index 814d52e8..1344e726 100644 --- a/graph-lib/lib/low/syntax-parse.rkt +++ b/graph-lib/lib/low/syntax-parse.rkt @@ -9,7 +9,7 @@ (define-syntax-parameter stx (lambda (call-stx) (raise-syntax-error - (syntax-e call-stx) + 'stx "Can only be used in define-syntax/parse or λ/syntax-parse" call-stx)))) diff --git a/graph-lib/main.rkt b/graph-lib/main.rkt index ecf9291c..d499740d 100644 --- a/graph-lib/main.rkt +++ b/graph-lib/main.rkt @@ -1,168 +1,4 @@ #lang s-exp "lib.rkt" -#| -(require (submod "graph/test-map-get.rkt" test)) -(require (submod "graph/dotlang.rkt" test)) - -(require "type-expander/type-expander.lp2.rkt") -(require "type-expander/multi-id.lp2.rkt") -(require "graph/adt.lp2.rkt") -|# - -#| -(define-type from (List (Pairof Number Boolean) (Listof Number))) -(define-type to (List (Pairof String Boolean) (Listof String))) - -(: convert (case→ (→ from to) - (→ (Pairof (Listof Number) Null) - (Pairof (Listof String) Null)) - (→ (Pairof Number Boolean) (Pairof String Boolean)) - (→ (Listof Number) (Listof String)) - (→ Number String) - (→ Boolean Boolean))) -(define (convert v) - (cond - [(pair? v) (cons (convert (car v)) (convert (cdr v)))] - [(null? v) v] - [(number? v) (format "~a" v)] - [(boolean? v) v])) -|# - - - - - - - -;; Tests with incomplete / outer-incomplete type-expander. - -(define-type-expander (outer-incomplete stx) - (syntax-case stx () - [(_ n) - #;(raise-syntax-error - 'incomplete - (format "Type doesn't have an incomplete counterpart: ~a" - (syntax->datum #'n)) - #'n) - ;; Just for testing: - #''test])) - -(define-type C Boolean) - -(define-type C/incomplete (Pairof 'C Boolean)) - -(define-type-expander (incomplete stx) - (syntax-case stx () - [(_ n) - (cond [(free-identifier=? #'n #'C) #'C/incomplete] - [else #'(outer-incomplete n)])])) - -(let () - (define-type-expander (outer-incomplete stx) - (syntax-case stx () [(_ n) #'(incomplete n)])) - (let () - (define-type A Number) - (define-type B String) - - (define-type A/incomplete (Pairof 'A Number)) - (define-type B/incomplete (Pairof 'B String)) - - (define-type-expander (incomplete stx) - (syntax-case stx () - [(_ n) - (cond [(free-identifier=? #'n #'A) #'A/incomplete] - [(free-identifier=? #'n #'B) #'B/incomplete] - [else - #'(outer-incomplete n)])])) - - (define-type TA A) - (define-type TAI (incomplete A)) - (ann '(A . 1) TAI) - - (define-type TC C) - (define-type TCI (incomplete C)) - (ann #t TC) - (ann '(C . #t) TCI) - - (let () - (define-type A Boolean) - (define-type TA A) - (define-type TAI (incomplete A)) - (ann 'test TAI) - (void)))) - -(require (prefix-in tr: typed/racket)) - -;(define-type ma (tagged ma (fav String) (faa ma) (fab mb))) -;(define-type mb (tagged mb (fbv String) (fba ma))) - -;(define-type ma (List (U ma Number) (U ma Number)) #:omit-define-syntaxes) -;(define-multi-id ma -; #:match-expander (λ (stx) #'(list a b)) -; #:call (λ (stx) #'(list 1 (list 2 3)))) - -;(match (ann (ma) ma) -; [(ma) #t]) - - -#| -(module m typed/racket - (provide ma) - (require "type-expander/type-expander.lp2.rkt") - (require "graph/adt.lp2.rkt") - - ;(let () - ;(define-tagged ma (fav String)) - ;(define-tagged ma (fav String) (faa ma) (fab mb)) - (define-tagged ma (fav String) (faa ma) (fab Number)) - ;(define-tagged mb (fbv String) (fba ma)) - (define-type ma/incomplete ma) - ;(define-type mb/incomplete mb) - (void);) - ) - -(require 'm) -|# - -#| -(require "graph/graph.rkt") - -(define ma "boom") - -(graph g - [ma (fav String) - (faa ma) - (fab mb)] - [mb (fbv String) - (fba ma)]) - -(define mb "boom") -|# - -#| -(require typed/rackunit) - -;(require "graph/structure.lp2.rkt") -;(get ((make-struct-constructor a b c d) 1 "b" 'value-c 4) c) - -(require "type-expander/type-expander.lp2.rkt") -(: w0 `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d)) -(define w0 '(2 "abc" #,(x . z) #(1 "b" x) d)) - -(require (for-syntax racket/list)) -(define-type-expander (Repeat stx) - (syntax-case stx () - [(_ t n) #`(List #,@(map (λ (x) #'t) - (range (syntax->datum #'n))))])) - -(: x (→ (Repeat Number 5))) -(define (x) (list 1 2 3 4 5)) -(check-equal? (x) '(1 2 3 4 5)) - -(require "graph/structure.lp2.rkt") -(define-structure st2 [b String] [a Number]) - -(module* test typed/racket - (require (submod ".."))) - -|# +;; Nothing yet. +(void) \ No newline at end of file diff --git a/graph-lib/test/2016-04-04--node-names-are-private.rkt b/graph-lib/test/2016-04-04--node-names-are-private.rkt new file mode 100644 index 00000000..b4e09d56 --- /dev/null +++ b/graph-lib/test/2016-04-04--node-names-are-private.rkt @@ -0,0 +1,19 @@ +#lang s-exp "../lib.rkt" + +;; Should not cause name collisions +(define a "boom") +(define m-a "boom") + +(define-graph g + ([a (f1a : String) (f2a : (~> m-b))] + [b (f1b : String)]) + [(m-a [v : String]) + : a + (a v (m-b (string-append "b=" v)))] + [(m-b [v : String]) + : b + (b v)]) + +;; Should not cause name collisions +;(define b "boom") +(define m-b "boom") diff --git a/graph-lib/test/assumptions/2016-04-04--define-multi-id-leaves-type-intact.rkt b/graph-lib/test/assumptions/2016-04-04--define-multi-id-leaves-type-intact.rkt new file mode 100644 index 00000000..310690e7 --- /dev/null +++ b/graph-lib/test/assumptions/2016-04-04--define-multi-id-leaves-type-intact.rkt @@ -0,0 +1,12 @@ +#lang s-exp "../../lib.rkt" +(require (for-syntax racket/base)) + +(define-type ma (List (U ma Number) (U ma Number)) #:omit-define-syntaxes) +(define-multi-id ma + #:match-expander (λ (stx) #'(list a b)) + #:call (λ (stx) #'(list 1 (list 2 3)))) + +(check-equal?: + (match (ann (ma) ma) + [(ma) #t]) + #t) \ No newline at end of file diff --git a/graph-lib/test/regression/2016-04-04--require-racket-base-in-lang.rkt b/graph-lib/test/regression/2016-04-04--require-racket-base-in-lang.rkt new file mode 100644 index 00000000..7724f42a --- /dev/null +++ b/graph-lib/test/regression/2016-04-04--require-racket-base-in-lang.rkt @@ -0,0 +1,8 @@ +#lang s-exp "../../lib.rkt" + +(module test "../../lib.rkt" + (define-syntax (t stx) + ;; `+` and other identifiers from racket/base should be available here. + #`#,(+ 1 2)) + + (check-equal?: (t) 3)) \ No newline at end of file diff --git a/graph-lib/type-expander/type-expander-test.rkt b/graph-lib/type-expander/type-expander-test.rkt new file mode 100644 index 00000000..fd8bdb3a --- /dev/null +++ b/graph-lib/type-expander/type-expander-test.rkt @@ -0,0 +1,411 @@ +#lang typed/racket + +(module test typed/racket + (require "type-expander.lp2.rkt" + ;(submod "type-expander.lp2.rkt" test) + typed/rackunit + "../lib/low.rkt" + (for-syntax (submod "type-expander.lp2.rkt" expander) + racket/list + (submod "../lib/low.rkt" untyped))) + + ; Tests for expand-type + (begin + ;; Test harness: + (begin + (require (for-syntax typed/rackunit + syntax/parse)) + + (define-syntax (test-expander stx) + (syntax-parse stx + [(_ type expanded-type) + (check-equal? (syntax->datum (expand-type #'type)) + (syntax->datum #'expanded-type)) + #'(values)]))) + + ; Simple identity expander test, with a different case when used just as an + ; identifier. + + (begin + (define-type-expander (id stx) + (syntax-case stx () + [(_ t) #'t] + [x #'(∀ (A) (→ A A))])) + + (test-expander (id Number) Number) + (test-expander id (∀ (A) (→ A A)))) + + (begin + (define-type-expander (double stx) + (syntax-case stx () + [(_ t) #'(id (Pairof (id t) t))])) + + (test-expander (∀ (A) (→ A (id (double (id A))))) + (∀ (A) (→ A (Pairof A A)))) + + (test-expander (→ Any Boolean : (double (id A))) + (→ Any Boolean : (Pairof A A)))) + + ;; Curry expander arguments: + (begin + (define-type-expander (CPairof stx) + (syntax-case stx () + [(_ a) #'(curry Pairof a)] + [(_ a b) #'(Pairof a b)])) + + (test-expander (CPairof Number String) + (Pairof Number String)) + + (test-expander ((CPairof Number) String) + (Pairof Number String)) + + (check-equal?: (ann (ann '(1 . "b") (CPairof Number String)) + (Pairof Number String)) + '(1 . "b")) + + (check-equal?: (ann (ann '(1 . "c") ((CPairof Number) String)) + (Pairof Number String)) + '(1 . "c"))) + + ;; Shadowing with ∀ variables: + (begin + (test-expander (∀ (id) (→ id)) + (∀ (id) (→ id))) + (test-expander (∀ (id2) (→ id)) + (∀ (id2) (→ (∀ (A) (→ A A)))))) + + (begin + (define-type-expander (Repeat stx) + (syntax-case stx () + [(_ t n) #`(List #,@(map (λ (x) #'t) + (range (syntax->datum #'n))))])) + + (test-expander (Repeat Number 5) + (List Number Number Number Number Number))) + + (begin + (: count-five-more (→ Number (Repeat Number 5))) + (define (count-five-more x) + (list (+ x 1) (+ x 2) (+ x 3) (+ x 4) (+ x 5))) + + (check-equal?: (count-five-more 3) + '(4 5 6 7 8)) + (check-equal?: (ann (count-five-more 15) (Repeat Number 5)) + '(16 17 18 19 20))) + + ;; Shadowing with Rec variables: + + (begin + (: repeat-shadow (→ Number (Rec Repeat (U Null (List Number Repeat))))) + (define (repeat-shadow n) + (if (= n 0) + '() + (list n (repeat-shadow (sub1 n))))) + (check-equal?: (repeat-shadow 5) + '(5 (4 (3 (2 (1 ())))))) + (test-expander (→ Number (Rec Repeat (U Null (List Number Repeat)))) + (→ Number (Rec Repeat (U Null (List Number Repeat)))))) + + ;; Shadowing with Let: + + (begin + (let () + (define-type-expander (exp stx) + #'(List 1 2 3)) + + (define-type e String) + (: x (List e (Let [e exp] e))) + (define x (list "e1" (list 1 2 3))) + (check-equal?: x '("e1" (1 2 3))) + (test-expander (List e (Let [e exp] e)) + (List e (List 1 2 3))) + + (: y (List e)) + (define y (list "e2")) + (check-equal?: y '("e2")) + (test-expander (List e) + (List e)) + (void)))) + + ;; Test ":" + (begin + (: c0 `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d)) + (define c0 '(2 "abc" #,(x . z) #(1 "b" x) d)) + + (let () + (define-type-expander (Repeat stx) + (syntax-case stx () + [(_ t n) #`(List #,@(map (λ (x) #'t) + (range (syntax->datum #'n))))])) + + (: x (→ (Repeat Number 5))) + (define (x) (list 1 2 3 4 5)) + (check-equal? (x) '(1 2 3 4 5)))) + + ;; Test define-type + (let () + (define-type-expander (Repeat stx) + (syntax-case stx () + [(_ t n) #`(List #,@(map (λ (x) #'t) + (range (syntax->datum #'n))))])) + + (define-type R5 (Repeat Number 5)) + (check-equal?: (ann '(1 2 3 4 5) R5) '(1 2 3 4 5))) + + ;; Test define + (begin + (define d0 + : `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d) + '(2 "abc" #,(x . z) #(1 "b" x) d)) + (check-equal?: (ann d0 (List 2 + "abc" + (List 'unsyntax + (Pairof (U 'x 'y) (U 'y 'z))) + (Vector 1 "b" 'x) 'd)) + '(2 "abc" (unsyntax (x . z)) #(1 "b" x) d)) + + (: d1 (→ Number (→ Number Number))) + (define ((d1 [x : Number]) [y : Number]) : Number (+ x y)) + (check-equal?: (ann ((d1 2) 3) Number) 5) + + (: d2 (→ Number (→ Number Number))) + (define ((d2 [x : Number]) [y : Number]) (+ x y)) + (check-equal?: (ann ((d2 3) 4) Number) 7) + + (define #:∀ (T) ((d3 [x : T]) [y : T]) : (Pairof T T) (cons x y)) + (check-equal?: (ann ((d3 'x) 'y) (Pairof Symbol Symbol)) '(x . y))) + + ;; Test lambda + (begin + (check-equal?: ((ann (lambda ([x : Number]) : Number (* x 2)) + (→ Number Number)) + 3) + 6) + (check-equal?: ((ann (λ ([x : Number]) : Number (* x 2)) + (→ Number Number)) + 3) + 6) + (check-equal?: ((λ x x) 1 2 3) '(1 2 3)) + (check-equal?: ((λ #:∀ (A) [x : A ...*] : (Listof A) x) 1 2 3) '(1 2 3))) + + ;; Test struct + (begin + (struct s0 ()) + (struct s1 ([x : Number])) + (struct s2 ([x : Number] [y : Number])) + (struct s3 ([x : Number] [y : Number]) #:transparent) + (struct s4 () #:transparent) + (struct (A B) s5 ([x : A] [y : B]) #:transparent) + (struct (A B) s6 () #:transparent) + (struct s7 s2 ([z : String]) #:transparent) + (struct (A) s8 s3 ([z : A]) #:transparent) + (struct (A B C) s9 s5 ([z : C]) #:transparent) + (struct (A B C) s10 s2 ([z : C]) #:transparent) + (struct (A B C) s11 s5 ([z : C])) + + (check (λ (a b) (not (equal? a b))) (s0) (s0)) + (check-equal?: (s1-x (s1 123)) 123) + (check-equal?: (s2-x (s2 2 3)) 2) + (check-equal?: (s2-y (s2 2 3)) 3) + (check-equal?: (s3-x (s3 4 5)) 4) + (check-equal?: (s3-y (s3 4 5)) 5) + (check-equal?: (s4) (s4)) + (check-equal?: (s5-x (s5 6 7)) 6) + (check-equal?: (s5-y (s5 6 7)) 7) + (check-equal?: (s5 6 7) (s5 6 7)) + (check-equal?: ((inst s5 Number String) 6 "g") (s5 6 "g")) + (check-equal?: (s6) (s6)) + (check-equal?: ((inst s6 Number String)) (s6)) + + ;(check-equal?: (s7-x (s7 -1 -2 "c") -1)) + ;(check-equal?: (s7-y (s7 -1 -2 "c") -2)) + (check-equal?: (s7-z (s7 -1 -2 "c")) "c") + (check-equal?: (s2-x (s7 -1 -2 "c")) -1) + (check-equal?: (s2-y (s7 -1 -2 "c")) -2) + (check-not-equal?: (s7 -1 -2 "c") (s7 -1 -2 "c")) + (check-not-exn (λ () (ann (s7 -1 -2 "c") s2))) + (check-true (s2? (s7 -1 -2 "c"))) + + ;(check-equal?: (s8-x (s8 -1 -2 "c") -1)) + ;(check-equal?: (s8-y (s8 -1 -2 "c") -2)) + (check-equal?: (s8-z (s8 -1 -2 "c")) "c") + (check-equal?: (s3-x (s8 -1 -2 "c")) -1) + (check-equal?: (s3-y (s8 -1 -2 "c")) -2) + (check-equal?: (s8 -1 -2 "c") (s8 -1 -2 "c")) + (check-equal?: ((inst s8 String) -1 -2 "c") (s8 -1 -2 "c")) + (check-not-exn (λ () (ann ((inst s8 String) -1 -2 "c") s3))) + (check-true (s3? ((inst s8 String) -1 -2 "c"))) + + ;(check-equal?: (s9-x (s9 8 9 10)) 8) + ;(check-equal?: (s9-y (s9 8 9 10)) 9) + (check-equal?: (s9-z (s9 8 9 10)) 10) + (check-equal?: (s5-x (s9 8 9 10)) 8) + (check-equal?: (s5-y (s9 8 9 10)) 9) + (check-equal?: (s9 8 9 10) (s9 8 9 10)) + ;; Bug (to report) + ;(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") + ; (Struct s5)))) + (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") + (s5 Number Symbol)))) + (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") + (s5 Any Any)))) + (check-true (s5? ((inst s9 Number Symbol String) -1 'i "j"))) + (check-not-equal?: (s10 11 12 13) (s10 11 12 13)) + (check-not-equal?: (s11 14 15 16) (s11 14 15 16))) + + ;; Test define-struct/exec + (begin + (define TODO '(bug in version 20160114-9498bdd + racket-6.4.0.1-i386-linux-precise.sh)) + #| + (define-struct/exec se0 () + ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))]) + [(λ (self v) (cons self v)) : (→ se0 Any (Pairof se0 Any))]) + (define-struct/exec se1 ([x : Number]) + ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))]) + [(λ (self v) (cons self v)) : (→ se1 Any (Pairof se1 Any))]) + (define-struct/exec se2 ([x : Number] [y : Number]) + [(λ (self v) (cons self v)) : (→ se2 Any (Pairof se2 Any))]) + (define-struct/exec (se3 se2) ([z : String]) + [(λ (self v w) (list self v w)) + ;: (∀ (A B) (→ se3 A B (List se2 A B)))]) + : (→ se3 Any Any (List se2 Any Any))]) + (define-struct/exec (se4 se2) ([z : String]) + [(λ (self v w) (list self v w)) + ;: (∀ (A B) (→ se4 A B (List se2 A B)))]) + : (→ se4 Any (→ Number Number) (List se2 Any (→ Number Number)))]) + + (check (λ (a b) (not (equal? a b))) (se0) (se0)) + (check-equal?: (cdr ((se0) 'a)) 'a) + (check-not-exn (λ () (ann (car ((se0) 'a)) se0))) + (check-true (se0? (car ((se0) 'a)))) + + (check (λ (a b) (not (equal? a b))) (se1 123) (se1 123)) + (check-equal?: (se1-x (se1 123)) 123) + (check-equal?: (se1-x (car ((se1 123) 'b))) 123) + (check-equal?: (cdr ((se1 123) 'b)) 'b) + (check-not-exn (λ () (ann (car ((se1 123) 'b)) se1))) + (check-true (se1? (car ((se1 123) 'b)))) + + (check (λ (a b) (not (equal? a b))) (se2 2 3) (se2 2 3)) + (check-equal?: (se2-x (se2 2 3)) 2) + (check-equal?: (se2-y (se2 2 3)) 3) + (check-equal?: (se2-x (car ((se2 2 3) 'c))) 2) + (check-equal?: (se2-y (car ((se2 2 3) 'c))) 3) + (check-equal?: (cdr ((se2 2 3) 'c)) 'c) + (check-not-exn (λ () (ann (car ((se2 2 3) 'c)) se2))) + (check-true (se2? (car ((se2 2 3) 'c)))) + + (check (λ (a b) (not (equal? a b))) (se3 4 5 "f") (se3 4 5 "f")) + (check-equal?: (se2-x (se3 4 5 "f")) 4) + (check-equal?: (se2-y (se3 4 5 "f")) 5) + (check-equal?: (se3-z (se3 4 5 "f")) "f") + (check-equal?: (se2-x (car ((se3 4 5 "f") 'd 'e))) 4) + (check-equal?: (se2-y (car ((se3 4 5 "f") 'd 'e))) 5) + (check-equal?: (let ([ret : Any (car ((se3 4 5 "f") 'd 'e))]) + (if (se3? ret) + (se3-z ret) + "wrong type!")) + "f") + (check-equal?: (cadr ((se3 4 5 "f") 'd 'e)) 'd) + (check-equal?: (caddr ((se3 4 5 "f") 'd 'e)) 'e) + (check-equal?: ((caddr ((se4 4 5 "f") 'd (λ ([x : Number]) (* x 2)))) 12) + 24) + (check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se2))) + (check-true (se2? (car ((se3 4 5 "f") 'd 'e)))) + (check-true (se3? (car ((se3 4 5 "f") 'd 'e)))) + |#) + + ;; Test ann + (let () + (define-type-expander (Repeat stx) + (syntax-case stx () + [(_ t n) #`(List #,@(map (λ (x) #'t) + (range (syntax->datum #'n))))])) + (check-equal?: (ann (ann '(1 2 3) + (Repeat Number 3)) + (List Number Number Number)) + '(1 2 3))) + + ;; Test inst + (let () + (define-type-expander (Repeat stx) + (syntax-case stx () + [(_ t n) #`(List #,@(map (λ (x) #'t) + (range (syntax->datum #'n))))])) + + (: f (∀ (A B C D) (→ (Pairof A B) (Pairof C D) (List A C B D)))) + (define (f x y) (list (car x) (car y) (cdr x) (cdr y))) + + (check-equal?: ((inst f + (Repeat Number 3) + (Repeat String 2) + (Repeat 'x 1) + (Repeat undefined-type 0)) + '((1 2 3) . ("a" "b")) + '((x) . ())) + '((1 2 3) (x) ("a" "b") ()))) + + ;; Test let + (begin + (check-equal?: (let loop-id ([x 1]) + (if (equal? x 2) + x + (loop-id 2))) + : Any + 2) + (check-equal?: (let () 'x) 'x) + (check-equal?: (ann (let #:∀ (T) ([a : T 3] + [b : (Pairof T T) '(5 . 7)]) + (cons a b)) + (Pairof Number (Pairof Number Number))) + '(3 5 . 7))) + + ;; Test let* + (let () + (define-type-expander (Repeat stx) + (syntax-case stx () + [(_ t n) #`(List #,@(map (λ (x) #'t) + (range (syntax->datum #'n))))])) + + (check-equal?: (let* ([x* : (Repeat Number 3) '(1 2 3)] + [y* : (Repeat Number 3) x*]) + y*) + '(1 2 3))) + + ;; Test let-values + (let () + (define-type-expander (Repeat stx) + (syntax-case stx () + [(_ t n) #`(List #,@(map (λ (x) #'t) + (range (syntax->datum #'n))))])) + + (check-equal?: (ann (let-values + ([([x : (Repeat Number 3)]) + (list 1 2 3)]) + (cdr x)) + (List Number Number)) + '(2 3)) + + (check-equal?: (ann (let-values + ([([x : (Repeat Number 3)] [y : Number]) + (values (list 1 2 3) 4)]) + (cons y x)) + (Pairof Number (List Number Number Number))) + '(4 . (1 2 3))) + + (check-equal?: (ann (let-values + ([(x y) + (values (list 1 2 3) 4)]) + (cons y x)) + (Pairof Number (List Number Number Number))) + '(4 . (1 2 3)))) + + ;; Test make-predicate> + (let () + (define-type-expander (Repeat stx) + (syntax-case stx () + [(_ t n) #`(List #,@(map (λ (x) #'t) + (range (syntax->datum #'n))))])) + (check-equal?: ((make-predicate (Repeat Number 3)) '(1 2 3)) #t) + (check-equal?: ((make-predicate (Repeat Number 3)) '(1 "b" 3)) #f))) \ No newline at end of file diff --git a/graph-lib/type-expander/type-expander.lp2.rkt b/graph-lib/type-expander/type-expander.lp2.rkt index 56a2a6c9..91c5fd87 100644 --- a/graph-lib/type-expander/type-expander.lp2.rkt +++ b/graph-lib/type-expander/type-expander.lp2.rkt @@ -190,125 +190,6 @@ else. #`(define-syntax name (type-expander #,(syntax/loc stx (λ (arg) . body)))))] -@subsection{Tests for @racket[expand-type]} - -@CHUNK[ - (require (for-syntax typed/rackunit - syntax/parse)) - - (define-syntax (test-expander stx) - (syntax-parse stx - [(_ type expanded-type) - (check-equal? (syntax->datum (expand-type #'type)) - (syntax->datum #'expanded-type)) - #'(values)]))] - -Simple identity expander test, with a different case when used just as an -identifier. - -@CHUNK[ - (define-type-expander (id stx) - (syntax-case stx () - [(_ t) #'t] - [x #'(∀ (A) (→ A A))])) - - (test-expander (id Number) Number) - (test-expander id (∀ (A) (→ A A)))] - -@CHUNK[ - (define-type-expander (double stx) - (syntax-case stx () - [(_ t) #'(id (Pairof (id t) t))])) - - (test-expander (∀ (A) (→ A (id (double (id A))))) - (∀ (A) (→ A (Pairof A A)))) - - (test-expander (→ Any Boolean : (double (id A))) - (→ Any Boolean : (Pairof A A)))] - -Curry expander arguments: - -@CHUNK[ - (define-type-expander (CPairof stx) - (syntax-case stx () - [(_ a) #'(curry Pairof a)] - [(_ a b) #'(Pairof a b)])) - - (test-expander (CPairof Number String) - (Pairof Number String)) - - (test-expander ((CPairof Number) String) - (Pairof Number String)) - - (check-equal?: (ann (ann '(1 . "b") (CPairof Number String)) - (Pairof Number String)) - '(1 . "b")) - - (check-equal?: (ann (ann '(1 . "c") ((CPairof Number) String)) - (Pairof Number String)) - '(1 . "c"))] - -Shadowing with @tc[∀] variables: - -@CHUNK[ - (test-expander (∀ (id) (→ id)) - (∀ (id) (→ id))) - (test-expander (∀ (id2) (→ id)) - (∀ (id2) (→ (∀ (A) (→ A A)))))] - -@CHUNK[ - (define-type-expander (Repeat stx) - (syntax-case stx () - [(_ t n) #`(List #,@(map (λ (x) #'t) - (range (syntax->datum #'n))))])) - - (test-expander (Repeat Number 5) - (List Number Number Number Number Number))] - -@CHUNK[ - (: count-five-more (→ Number (Repeat Number 5))) - (define (count-five-more x) - (list (+ x 1) (+ x 2) (+ x 3) (+ x 4) (+ x 5))) - - (check-equal?: (count-five-more 3) - '(4 5 6 7 8)) - (check-equal?: (ann (count-five-more 15) (Repeat Number 5)) - '(16 17 18 19 20))] - -Shadowing with @tc[Rec] variables: - -@CHUNK[ - (: repeat-shadow (→ Number (Rec Repeat (U Null (List Number Repeat))))) - (define (repeat-shadow n) - (if (= n 0) - '() - (list n (repeat-shadow (sub1 n))))) - (check-equal?: (repeat-shadow 5) - '(5 (4 (3 (2 (1 ())))))) - (test-expander (→ Number (Rec Repeat (U Null (List Number Repeat)))) - (→ Number (Rec Repeat (U Null (List Number Repeat)))))] - -Shadowing with @tc[Let]: - -@chunk[ - (let () - (define-type-expander (exp stx) - #'(List 1 2 3)) - - (define-type e String) - (: x (List e (Let [e exp] e))) - (define x (list "e1" (list 1 2 3))) - (check-equal?: x '("e1" (1 2 3))) - (test-expander (List e (Let [e exp] e)) - (List e (List 1 2 3))) - - (: y (List e)) - (define y (list "e2")) - (check-equal?: y '("e2")) - (test-expander (List e) - (List e)) - (void))] - @section{Example type-expanders: quasiquote and quasisyntax} @CHUNK[ @@ -410,10 +291,6 @@ after expanding the type argument. (define-syntax/parse (new-: x:id t:expr) #`(: x #,(expand-type #'t)))] -@CHUNK[ - (: c0 `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d)) - (define c0 '(2 "abc" #,(x . z) #(1 "b" x) d))] - @subsection[#:tag "type-expander|syntax-classes"]{syntax classes} The syntax classes from @tc[typed-racket/base-env/annotate-classes] match @@ -542,16 +419,6 @@ them. (tmpl-expand-type (?? (TVar ...) ()) type) . rest))]))] -@chunk[ - (let () - (define-type-expander (Repeat stx) - (syntax-case stx () - [(_ t n) #`(List #,@(map (λ (x) #'t) - (range (syntax->datum #'n))))])) - - (define-type R5 (Repeat Number 5)) - (check-equal?: (ann '(1 2 3 4 5) R5) '(1 2 3 4 5)))] - @subsection{@racket[define]} @chunk[ @@ -567,28 +434,6 @@ them. (?? (?@ : (tmpl-expand-type tvars.vars type))) e ...))]))] -@CHUNK[ - (define d0 - : `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d) - '(2 "abc" #,(x . z) #(1 "b" x) d)) - (check-equal?: (ann d0 (List 2 - "abc" - (List 'unsyntax - (Pairof (U 'x 'y) (U 'y 'z))) - (Vector 1 "b" 'x) 'd)) - '(2 "abc" (unsyntax (x . z)) #(1 "b" x) d)) - - (: d1 (→ Number (→ Number Number))) - (define ((d1 [x : Number]) [y : Number]) : Number (+ x y)) - (check-equal?: (ann ((d1 2) 3) Number) 5) - - (: d2 (→ Number (→ Number Number))) - (define ((d2 [x : Number]) [y : Number]) (+ x y)) - (check-equal?: (ann ((d2 3) 4) Number) 7) - - (define #:∀ (T) ((d3 [x : T]) [y : T]) : (Pairof T T) (cons x y)) - (check-equal?: (ann ((d3 'x) 'y) (Pairof Symbol Symbol)) '(x . y))] - @subsection{@racket[lambda]} @CHUNK[ @@ -602,18 +447,6 @@ them. (?? (?@ : (tmpl-expand-type tvars.vars ret-type))) e ...))]))] -@CHUNK[ - (check-equal?: ((ann (lambda ([x : Number]) : Number (* x 2)) - (→ Number Number)) - 3) - 6) - (check-equal?: ((ann (λ ([x : Number]) : Number (* x 2)) - (→ Number Number)) - 3) - 6) - (check-equal?: ((λ x x) 1 2 3) '(1 2 3)) - (check-equal?: ((λ #:∀ (A) [x : A ...*] : (Listof A) x) 1 2 3) '(1 2 3))] - @subsection{@racket[struct]} @chunk[ @@ -628,70 +461,6 @@ them. ([field : (tmpl-expand-type tvars.vars type)] ...) . rest))]))] -@chunk[ - (struct s0 ()) - (struct s1 ([x : Number])) - (struct s2 ([x : Number] [y : Number])) - (struct s3 ([x : Number] [y : Number]) #:transparent) - (struct s4 () #:transparent) - (struct (A B) s5 ([x : A] [y : B]) #:transparent) - (struct (A B) s6 () #:transparent) - (struct s7 s2 ([z : String]) #:transparent) - (struct (A) s8 s3 ([z : A]) #:transparent) - (struct (A B C) s9 s5 ([z : C]) #:transparent) - (struct (A B C) s10 s2 ([z : C]) #:transparent) - (struct (A B C) s11 s5 ([z : C])) - - (check (λ (a b) (not (equal? a b))) (s0) (s0)) - (check-equal?: (s1-x (s1 123)) 123) - (check-equal?: (s2-x (s2 2 3)) 2) - (check-equal?: (s2-y (s2 2 3)) 3) - (check-equal?: (s3-x (s3 4 5)) 4) - (check-equal?: (s3-y (s3 4 5)) 5) - (check-equal?: (s4) (s4)) - (check-equal?: (s5-x (s5 6 7)) 6) - (check-equal?: (s5-y (s5 6 7)) 7) - (check-equal?: (s5 6 7) (s5 6 7)) - (check-equal?: ((inst s5 Number String) 6 "g") (s5 6 "g")) - (check-equal?: (s6) (s6)) - (check-equal?: ((inst s6 Number String)) (s6)) - - ;(check-equal?: (s7-x (s7 -1 -2 "c") -1)) - ;(check-equal?: (s7-y (s7 -1 -2 "c") -2)) - (check-equal?: (s7-z (s7 -1 -2 "c")) "c") - (check-equal?: (s2-x (s7 -1 -2 "c")) -1) - (check-equal?: (s2-y (s7 -1 -2 "c")) -2) - (check-not-equal?: (s7 -1 -2 "c") (s7 -1 -2 "c")) - (check-not-exn (λ () (ann (s7 -1 -2 "c") s2))) - (check-true (s2? (s7 -1 -2 "c"))) - - ;(check-equal?: (s8-x (s8 -1 -2 "c") -1)) - ;(check-equal?: (s8-y (s8 -1 -2 "c") -2)) - (check-equal?: (s8-z (s8 -1 -2 "c")) "c") - (check-equal?: (s3-x (s8 -1 -2 "c")) -1) - (check-equal?: (s3-y (s8 -1 -2 "c")) -2) - (check-equal?: (s8 -1 -2 "c") (s8 -1 -2 "c")) - (check-equal?: ((inst s8 String) -1 -2 "c") (s8 -1 -2 "c")) - (check-not-exn (λ () (ann ((inst s8 String) -1 -2 "c") s3))) - (check-true (s3? ((inst s8 String) -1 -2 "c"))) - - ;(check-equal?: (s9-x (s9 8 9 10)) 8) - ;(check-equal?: (s9-y (s9 8 9 10)) 9) - (check-equal?: (s9-z (s9 8 9 10)) 10) - (check-equal?: (s5-x (s9 8 9 10)) 8) - (check-equal?: (s5-y (s9 8 9 10)) 9) - (check-equal?: (s9 8 9 10) (s9 8 9 10)) - ;; Bug (to report) - ;(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") - ; (Struct s5)))) - (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") - (s5 Number Symbol)))) - (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") - (s5 Any Any)))) - (check-true (s5? ((inst s9 Number Symbol String) -1 'i "j"))) - (check-not-equal?: (s10 11 12 13) (s10 11 12 13)) - (check-not-equal?: (s11 14 15 16) (s11 14 15 16))] - @subsection{@racket[define-struct/exec]} @chunk[ @@ -704,85 +473,12 @@ them. ([field (?? (?@ : (tmpl-expand-type () type)))] ...) [proc : (tmpl-expand-type () proc-type)]))]))] -@chunk[ - (define TODO '(bug in version 20160114-9498bdd - racket-6.4.0.1-i386-linux-precise.sh)) - #| - (define-struct/exec se0 () - ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))]) - [(λ (self v) (cons self v)) : (→ se0 Any (Pairof se0 Any))]) - (define-struct/exec se1 ([x : Number]) - ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))]) - [(λ (self v) (cons self v)) : (→ se1 Any (Pairof se1 Any))]) - (define-struct/exec se2 ([x : Number] [y : Number]) - [(λ (self v) (cons self v)) : (→ se2 Any (Pairof se2 Any))]) - (define-struct/exec (se3 se2) ([z : String]) - [(λ (self v w) (list self v w)) - ;: (∀ (A B) (→ se3 A B (List se2 A B)))]) - : (→ se3 Any Any (List se2 Any Any))]) - (define-struct/exec (se4 se2) ([z : String]) - [(λ (self v w) (list self v w)) - ;: (∀ (A B) (→ se4 A B (List se2 A B)))]) - : (→ se4 Any (→ Number Number) (List se2 Any (→ Number Number)))]) - - (check (λ (a b) (not (equal? a b))) (se0) (se0)) - (check-equal?: (cdr ((se0) 'a)) 'a) - (check-not-exn (λ () (ann (car ((se0) 'a)) se0))) - (check-true (se0? (car ((se0) 'a)))) - - (check (λ (a b) (not (equal? a b))) (se1 123) (se1 123)) - (check-equal?: (se1-x (se1 123)) 123) - (check-equal?: (se1-x (car ((se1 123) 'b))) 123) - (check-equal?: (cdr ((se1 123) 'b)) 'b) - (check-not-exn (λ () (ann (car ((se1 123) 'b)) se1))) - (check-true (se1? (car ((se1 123) 'b)))) - - (check (λ (a b) (not (equal? a b))) (se2 2 3) (se2 2 3)) - (check-equal?: (se2-x (se2 2 3)) 2) - (check-equal?: (se2-y (se2 2 3)) 3) - (check-equal?: (se2-x (car ((se2 2 3) 'c))) 2) - (check-equal?: (se2-y (car ((se2 2 3) 'c))) 3) - (check-equal?: (cdr ((se2 2 3) 'c)) 'c) - (check-not-exn (λ () (ann (car ((se2 2 3) 'c)) se2))) - (check-true (se2? (car ((se2 2 3) 'c)))) - - (check (λ (a b) (not (equal? a b))) (se3 4 5 "f") (se3 4 5 "f")) - (check-equal?: (se2-x (se3 4 5 "f")) 4) - (check-equal?: (se2-y (se3 4 5 "f")) 5) - (check-equal?: (se3-z (se3 4 5 "f")) "f") - (check-equal?: (se2-x (car ((se3 4 5 "f") 'd 'e))) 4) - (check-equal?: (se2-y (car ((se3 4 5 "f") 'd 'e))) 5) - (check-equal?: (let ([ret : Any (car ((se3 4 5 "f") 'd 'e))]) - (if (se3? ret) - (se3-z ret) - "wrong type!")) - "f") - (check-equal?: (cadr ((se3 4 5 "f") 'd 'e)) 'd) - (check-equal?: (caddr ((se3 4 5 "f") 'd 'e)) 'e) - (check-equal?: ((caddr ((se4 4 5 "f") 'd (λ ([x : Number]) (* x 2)))) 12) - 24) - (check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se2))) - (check-true (se2? (car ((se3 4 5 "f") 'd 'e)))) - (check-true (se3? (car ((se3 4 5 "f") 'd 'e)))) - |#] - @subsection{@racket[ann]} @chunk[ (define-syntax/parse (new-ann value:expr (~optional :colon) type:expr) (template (ann value (tmpl-expand-type () type))))] -@chunk[ - (let () - (define-type-expander (Repeat stx) - (syntax-case stx () - [(_ t n) #`(List #,@(map (λ (x) #'t) - (range (syntax->datum #'n))))])) - (check-equal?: (ann (ann '(1 2 3) - (Repeat Number 3)) - (List Number Number Number)) - '(1 2 3)))] - @subsection{@racket[inst]} @chunk[ @@ -793,25 +489,6 @@ them. (?? (?@ (tmpl-expand-type () last) (... ...) b)))))] -@chunk[ - (let () - (define-type-expander (Repeat stx) - (syntax-case stx () - [(_ t n) #`(List #,@(map (λ (x) #'t) - (range (syntax->datum #'n))))])) - - (: f (∀ (A B C D) (→ (Pairof A B) (Pairof C D) (List A C B D)))) - (define (f x y) (list (car x) (car y) (cdr x) (cdr y))) - - (check-equal?: ((inst f - (Repeat Number 3) - (Repeat String 2) - (Repeat 'x 1) - (Repeat undefined-type 0)) - '((1 2 3) . ("a" "b")) - '((x) . ())) - '((1 2 3) (x) ("a" "b") ())))] - @subsection{@racket[let]} @chunk[ @@ -829,20 +506,6 @@ them. ([(?@ . name.expanded) e] ...) . rest)))] -@chunk[ - (check-equal?: (let loop-id ([x 1]) - (if (equal? x 2) - x - (loop-id 2))) - : Any - 2) - (check-equal?: (let () 'x) 'x) - (check-equal?: (ann (let #:∀ (T) ([a : T 3] - [b : (Pairof T T) '(5 . 7)]) - (cons a b)) - (Pairof Number (Pairof Number Number))) - '(3 5 . 7))] - @subsection{@racket[let*]} @chunk[ @@ -855,18 +518,6 @@ them. (let* ([(?@ . name.expanded) e] ...) . rest)))] -@chunk[ - (let () - (define-type-expander (Repeat stx) - (syntax-case stx () - [(_ t n) #`(List #,@(map (λ (x) #'t) - (range (syntax->datum #'n))))])) - - (check-equal?: (let* ([x* : (Repeat Number 3) '(1 2 3)] - [y* : (Repeat Number 3) x*]) - y*) - '(1 2 3)))] - @subsection{@racket[let-values]} @chunk[ @@ -879,49 +530,12 @@ them. (let-values ([(name.expanded ...) e] ...) . rest)))] -@chunk[ - (let () - (define-type-expander (Repeat stx) - (syntax-case stx () - [(_ t n) #`(List #,@(map (λ (x) #'t) - (range (syntax->datum #'n))))])) - - (check-equal?: (ann (let-values - ([([x : (Repeat Number 3)]) - (list 1 2 3)]) - (cdr x)) - (List Number Number)) - '(2 3)) - - (check-equal?: (ann (let-values - ([([x : (Repeat Number 3)] [y : Number]) - (values (list 1 2 3) 4)]) - (cons y x)) - (Pairof Number (List Number Number Number))) - '(4 . (1 2 3))) - - (check-equal?: (ann (let-values - ([(x y) - (values (list 1 2 3) 4)]) - (cons y x)) - (Pairof Number (List Number Number Number))) - '(4 . (1 2 3))))] - @subsection{@racket[make-predicate]} @chunk[ (define-syntax/parse (new-make-predicate type:expr) (template (make-predicate (tmpl-expand-type () type))))] -@chunk[ - (let () - (define-type-expander (Repeat stx) - (syntax-case stx () - [(_ t n) #`(List #,@(map (λ (x) #'t) - (range (syntax->datum #'n))))])) - (check-equal?: ((make-predicate (Repeat Number 3)) '(1 2 3)) #t) - (check-equal?: ((make-predicate (Repeat Number 3)) '(1 "b" 3)) #f))] - @subsection[#:tag "type-expander|other-forms"]{Other @racket[typed/racket] forms} @@ -1159,35 +773,6 @@ We can finally define the overloaded forms, as well as the extra )] -And, last but not least, we will add a @tc[test] module. - -@chunk[ - (module* test typed/racket - ;; (require (submod ".." main)) must be on its own (or at least in - ;; first position), see this bug: - ;; https://github.com/racket/typed-racket/issues/292 - (require (submod ".." main)) - (require typed/rackunit - "../lib/low.rkt" - (for-syntax (submod ".." expander) - racket/list - (submod "../lib/low.rkt" untyped))) - - - - - - - - - - - - - - - )] - We can now assemble the modules in this order: @chunk[<*> @@ -1197,6 +782,4 @@ We can now assemble the modules in this order: (require 'main) - (provide (all-from-out 'main)) - - )] + (provide (all-from-out 'main)))]