diff --git a/typed-racket-doc/typed-racket/scribblings/reference/types.scrbl b/typed-racket-doc/typed-racket/scribblings/reference/types.scrbl index 27ac5201d..3dc85dd8d 100644 --- a/typed-racket-doc/typed-racket/scribblings/reference/types.scrbl +++ b/typed-racket-doc/typed-racket/scribblings/reference/types.scrbl @@ -352,6 +352,8 @@ corresponding to @racket[trest], where @racket[bound] @deftypeconstr[(MListof t)]{Returns the type of a homogeneous @rtech{mutable list} of @racket[t].} @deftypeconstr[(MPairof t u)]{Returns the type of a @rtech{Mutable pair} of @racket[t] and @racket[u].} +@deftypeconstr[(TreeListof t)]{Returns the type of @rtech{treelist} of @racket[t]} + @deftype[MPairTop]{Is the type of a @rtech{mutable pair} with unknown element types and is the supertype of all mutable pair types. This type typically appears in programs via the combination of diff --git a/typed-racket-lib/typed-racket/base-env/base-env.rkt b/typed-racket-lib/typed-racket/base-env/base-env.rkt index f0a622c32..c626ada10 100644 --- a/typed-racket-lib/typed-racket/base-env/base-env.rkt +++ b/typed-racket-lib/typed-racket/base-env/base-env.rkt @@ -8,6 +8,7 @@ racket/unsafe/ops racket/unsafe/undefined racket/hash + racket/treelist (only-in racket/extflonum floating-point-bytes->extfl extfl->floating-point-bytes) ;(only-in rnrs/lists-6 fold-left) '#%paramz @@ -1294,6 +1295,56 @@ [unsafe-undefined -Unsafe-Undefined] +;; Section 4.21 (TreeLists) + +[treelist (-poly (a) (->* (list) a (-treelist a)))] +[treelist-empty? (-> (-treelist Univ) B)] +[treelist-length (-> (-treelist Univ) -Index)] +[treelist-member? + (-poly (a) + (cl->* ((-treelist a) a . -> . Univ) + ((-treelist a) a (-> a a Univ) . -> . B)))] +[treelist-first (-poly (a) (-> (-treelist a) a :T+ #f))] +[treelist-last (-poly (a) (-> (-treelist a) a :T+ #f))] +[treelist-rest (-poly (a) (-> (-treelist a) (-treelist a)))] +[treelist-add (-poly (a) (-> (-treelist a) a (-treelist a)))] +[treelist-cons (-poly (a) (-> (-treelist a) a (-treelist a)))] +[treelist-delete (-poly (a) (-> (-treelist a) -Index (-treelist a)))] +[make-treelist (-poly (a) (-> -Nat a (-treelist a)))] +[treelist-ref (-poly (a) (-> (-treelist a) -Index a :T+ #f))] +[treelist-insert (-poly (a) (-> (-treelist a) -Index a (-treelist a)))] +[treelist-set (-poly (a) (-> (-treelist a) -Index a (-treelist a)))] +[treelist-take (-poly (a) (-> (-treelist a) -Index (-treelist a)))] +[treelist-drop (-poly (a) (-> (-treelist a) -Index (-treelist a)))] +[treelist-take-right (-poly (a) (-> (-treelist a) -Index (-treelist a)))] +[treelist-drop-right (-poly (a) (-> (-treelist a) -Index (-treelist a)))] +[treelist-sublist (-poly (a) (-> (-treelist a) -Index -Index (-treelist a)))] +[treelist-reverse (-poly (a) (-> (-treelist a) (-treelist a)))] +[treelist->list (-poly (a) (-> (-treelist a) (-lst a)))] +[list->treelist (-poly (a) (-> (-lst a) (-treelist a)))] +[treelist->vector (-poly (a) (-> (-treelist a) (-vec a)))] +[vector->treelist (-poly (a) (-> (-vec a) (-treelist a)))] +[in-treelist (-poly (a) (-> (-treelist a) (-seq a)))] +[treelist? (unsafe-shallow:make-pred-ty (-treelist Univ))] +[treelist-append (-poly (a) (->* (list) (-treelist a) (-treelist a)))] +[treelist-map (-poly (a b) (-> (-treelist a) (-> a b) (-treelist b)))] +[treelist-for-each (-poly (a b) (-> (-treelist a) (-> a b) -Void))] +[treelist-filter (-poly (a) (-> (-> a Univ) (-treelist a) (-treelist a)))] +[treelist-find (-poly (a) (-> (-treelist a) (-> a Univ) a :T+ #f))] +[treelist-index-of + (-poly (a) + (cl->* ((-treelist a) a . -> . -Index) + ((-treelist a) a (-> a a Univ) . -> . -Index)))] +[treelist-flatten (Univ . -> . (-treelist Univ))] +[treelist-append* (-poly (a) (-> (-treelist (-treelist a)) (-treelist a)))] +[treelist-sort +(-poly + (a b) + (cl->* + (->key (-treelist a) (-> a a -Boolean) #:key (-opt (-> a a :T+ #f)) #f #:cache-keys? -Boolean #f (-treelist a)) + (->key (-treelist a) (-> b b -Boolean) #:key (-> a b :T+ #f) #t #:cache-keys? -Boolean #f (-treelist a))))] + + ;; Section 5.2 (Structure Types) [make-struct-type (->opt -Symbol diff --git a/typed-racket-lib/typed-racket/base-env/base-types.rkt b/typed-racket-lib/typed-racket/base-env/base-types.rkt index c3c9e0911..e24de456b 100644 --- a/typed-racket-lib/typed-racket/base-env/base-types.rkt +++ b/typed-racket-lib/typed-racket/base-env/base-types.rkt @@ -197,6 +197,7 @@ [Async-Channelof -async-channel] [Ephemeronof -Ephemeron] [Setof -set] +[TreeListof -treelist] [Evtof -evt] [Continuation-Mark-Set -Cont-Mark-Set] [False -False] diff --git a/typed-racket-lib/typed-racket/env/init-envs.rkt b/typed-racket-lib/typed-racket/env/init-envs.rkt index e5de247d6..c456cbf85 100644 --- a/typed-racket-lib/typed-racket/env/init-envs.rkt +++ b/typed-racket-lib/typed-racket/env/init-envs.rkt @@ -155,6 +155,8 @@ `(-CustodianBox ,(type->sexp ty))] [(Set: ty) `(make-Set ,(type->sexp ty))] + [(TreeList: ty) + `(make-TreeList ,(type->sexp ty))] [(Evt: ty) `(make-Evt ,(type->sexp ty))] [(Future: ty) diff --git a/typed-racket-lib/typed-racket/infer/infer-unit.rkt b/typed-racket-lib/typed-racket/infer/infer-unit.rkt index d683e26ab..66f6253d4 100644 --- a/typed-racket-lib/typed-racket/infer/infer-unit.rkt +++ b/typed-racket-lib/typed-racket/infer/infer-unit.rkt @@ -827,6 +827,8 @@ (cg e e*)] [((Set: a) (Set: a*)) (cg a a*)] + [((TreeList: a) (TreeList: a*)) + (cg a a*)] [((Evt: a) (Evt: a*)) (cg a a*)] [((? Base:Semaphore?) (Evt: t)) diff --git a/typed-racket-lib/typed-racket/private/type-contract.rkt b/typed-racket-lib/typed-racket/private/type-contract.rkt index 988018b7b..429a2da5c 100644 --- a/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -42,6 +42,7 @@ racket/format racket/string racket/set + racket/treelist syntax/flatten-begin (only-in "../types/abbrev.rkt" -Bottom -Boolean) "../static-contracts/instantiate.rkt" @@ -564,6 +565,7 @@ [(? Fun? t) (t->sc/fun t)] [(? DepFun? t) (t->sc/fun t)] [(Set: t) (set/sc (t->sc t))] + [(TreeList: t) (treelist/sc (t->sc t))] [(Sequence: (list t)) #:when (subtype t:-Nat t) ;; sequence/c is always a wrapper, so avoid it when we just have a number @@ -930,6 +932,7 @@ none/sc (make-procedure-arity-flat/sc num-mand-args '() '()))] [(Set: _) set?/sc] + [(TreeList: _) treelist?/sc] [(or (Sequence: _) (SequenceTop:) (SequenceDots: _ _ _)) diff --git a/typed-racket-lib/typed-racket/rep/type-mask.rkt b/typed-racket-lib/typed-racket/rep/type-mask.rkt index 348797657..db47747f6 100644 --- a/typed-racket-lib/typed-racket/rep/type-mask.rkt +++ b/typed-racket-lib/typed-racket/rep/type-mask.rkt @@ -143,6 +143,7 @@ mask:future mask:other-box mask:set + mask:treelist mask:procedure mask:prompt-tag mask:continuation-mark-key diff --git a/typed-racket-lib/typed-racket/rep/type-rep.rkt b/typed-racket-lib/typed-racket/rep/type-rep.rkt index b412e09e8..1cb38e9ae 100644 --- a/typed-racket-lib/typed-racket/rep/type-rep.rkt +++ b/typed-racket-lib/typed-racket/rep/type-rep.rkt @@ -353,6 +353,13 @@ (def-structural Set ([elem #:covariant]) [#:mask mask:set]) +;;------ +;; Treelist (Immutable) +;;------ + +(def-structural TreeList ([elem #:covariant]) + [#:mask mask:treelist]) + ;;------------ ;; HashTable ;;------------ diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt index ce0b1169c..0197649db 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt @@ -11,6 +11,7 @@ racket/list racket/promise racket/set + racket/treelist racket/unit) "simple.rkt" "structural.rkt") @@ -30,6 +31,9 @@ (define set?/sc (flat/sc #'(lambda (x) (or (set? x) (set-mutable? x) (set-weak? x))))) (define empty-set/sc (and/sc set?/sc (flat/sc #'set-empty?))) +(define treelist?/sc (flat/sc #'treelist?)) +(define empty-treelist/sc (and/sc treelist?/sc (flat/sc #'treelist-empty?))) + (define vector?/sc (flat/sc #'vector?)) (define immutable-vector?/sc (and/sc vector?/sc (flat/sc #'immutable?))) diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt index e78f7082b..b7ff09fce 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt @@ -9,10 +9,12 @@ racket/match (for-syntax racket/base racket/syntax syntax/stx syntax/parse) racket/set + racket/treelist racket/sequence (for-template racket/base racket/contract/base racket/set + racket/treelist racket/async-channel racket/sequence racket/promise @@ -160,6 +162,7 @@ ((listof/sc (#:covariant)) listof #:flat) ((cons/sc (#:covariant) (#:covariant)) cons/c #:flat) ((set/sc (#:covariant #:chaperone)) set/c #:flat) + ((treelist/sc (#:covariant #:chaperone)) treelist/c #:flat) ((struct-property/sc (#:invariant)) struct-type-property/c #:impersonator) ((immutable-vectorof/sc (#:covariant)) immutable-vectorof/c #:flat) ((mutable-vectorof/sc (#:invariant)) mutable-vectorof/c #:chaperone) diff --git a/typed-racket-lib/typed-racket/types/abbrev.rkt b/typed-racket-lib/typed-racket/types/abbrev.rkt index d548a3c36..25d9ac8de 100644 --- a/typed-racket-lib/typed-racket/types/abbrev.rkt +++ b/typed-racket-lib/typed-racket/types/abbrev.rkt @@ -49,6 +49,7 @@ (define -thread-cell make-ThreadCell) (define -Promise make-Promise) (define -set make-Set) +(define -treelist make-TreeList) (define -mvec make-Mutable-Vector) (define -ivec make-Immutable-Vector) diff --git a/typed-racket-lib/typed-racket/types/printer.rkt b/typed-racket-lib/typed-racket/types/printer.rkt index 8fd78cfde..484be305d 100644 --- a/typed-racket-lib/typed-racket/types/printer.rkt +++ b/typed-racket-lib/typed-racket/types/printer.rkt @@ -687,6 +687,7 @@ [(Ephemeron: e) `(Ephemeronof ,(t->s e))] [(CustodianBox: e) `(CustodianBoxof ,(t->s e))] [(Set: e) `(Setof ,(t->s e))] + [(TreeList: e) `(TreeListof ,(t->s e))] [(Evt: r) `(Evtof ,(t->s r))] [(? Union? (app normalize-type type)) (match type diff --git a/typed-racket-lib/typed-racket/types/subtype.rkt b/typed-racket-lib/typed-racket/types/subtype.rkt index e4301d3ef..ba7937d2f 100644 --- a/typed-racket-lib/typed-racket/types/subtype.rkt +++ b/typed-racket-lib/typed-racket/types/subtype.rkt @@ -1278,6 +1278,12 @@ [(? ThreadCellTop?) A] [(ThreadCell: elem2) (type≡? A elem1 elem2)] [_ (continue<: A t1 t2 obj)])] + [(case: TreeList (TreeList: elem1)) + (match t2 + [(TreeList: elem2) (subtype* A elem1 elem2)] + [(SequenceTop:) A] + [(Sequence: (list seq-t)) (subtype* A elem1 seq-t)] + [_ (continue<: A t1 t2 obj)])] [(case: Union (Union/set: base1 ts1 elems1)) (let ([A (subtype* A base1 t2 obj)]) (and A diff --git a/typed-racket-test/succeed/treelist-contract.rkt b/typed-racket-test/succeed/treelist-contract.rkt new file mode 100644 index 000000000..5938bf358 --- /dev/null +++ b/typed-racket-test/succeed/treelist-contract.rkt @@ -0,0 +1,9 @@ +#lang typed/racket + +(require racket/treelist) + +(define-predicate string-treelist? (TreeListof String)) + +(string-treelist? (treelist 1 2 3)) + +(string-treelist? (treelist "1" "2" "3")) diff --git a/typed-racket-test/succeed/treelist.rkt b/typed-racket-test/succeed/treelist.rkt new file mode 100644 index 000000000..103d6adaf --- /dev/null +++ b/typed-racket-test/succeed/treelist.rkt @@ -0,0 +1,69 @@ +#lang typed/racket + +(require racket/treelist) + +(define tl (treelist 0 1 2 3)) + +(treelist-empty? tl) + +(treelist-length tl) + +(treelist-member? tl 1) + +(treelist-first tl) + +(treelist-rest tl) + +(treelist-last tl) + +(treelist-add tl 1) + +(treelist-cons tl 1) + +(treelist-delete tl 1) + +(make-treelist 5 1) + +(treelist-ref tl 1) + +(treelist-insert tl 1 1) + +(treelist-set tl 0 1) + +(treelist-take tl 2) + +(treelist-take tl 2) +(treelist-drop tl 2) +(treelist-take-right tl 2) +(treelist-drop-right tl 2) + +(treelist-sublist tl 1 3) + +(treelist-reverse tl) + +(treelist->list tl) +(list->treelist (list 0 1 2 3)) + +(treelist->vector tl) +(vector->treelist (vector 0 1 2 3)) + +(treelist? treelist) + +(treelist-append tl tl tl) + +(treelist-map tl (λ ([x : Byte]) (+ x 1))) + +(treelist-for-each tl (λ ([x : Byte]) (+ x 1))) + +(treelist-filter (λ ([x : Byte]) (equal? x 1)) tl) + +(treelist-find tl (λ ([x : Byte]) (equal? x 1))) + +(treelist-index-of tl 3) +(treelist-index-of tl 3 equal?) + +(treelist-flatten (treelist tl tl)) + +(treelist-append (treelist (treelist tl) tl)) + +(treelist-sort tl >) \ No newline at end of file diff --git a/typed-racket-test/unit-tests/subtype-tests.rkt b/typed-racket-test/unit-tests/subtype-tests.rkt index 543e79edc..d65994fb2 100644 --- a/typed-racket-test/unit-tests/subtype-tests.rkt +++ b/typed-racket-test/unit-tests/subtype-tests.rkt @@ -179,6 +179,7 @@ [make-Immutable-Vector ()] [make-Immutable-HashTable () ()] [make-Set ()] + [make-TreeList ()] [make-Evt ()] [make-Syntax ()] [make-Future ()]) @@ -298,6 +299,10 @@ [(-mu x (make-Listof x)) (-mu x* (make-Listof x*))] [(-pair -Number -Number) (-pair Univ -Number)] [(-pair -Number -Number) (-pair -Number -Number)] + ;; simple treelist types + [(-treelist -Number) (-treelist Univ)] + [(-treelist -Number) (-treelist -Number)] + [FAIL (-treelist -Number) (-treelist -Symbol)] ;; from page 7 (my favorite page! But seriously, page 7 of... what???) [(-mu t (-> t t)) (-mu s (-> s s))] [(-mu s (-> -Number s)) (-mu t (-> -Number (-> -Number t)))] diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt index 25a5add9d..ad1aa2a22 100644 --- a/typed-racket-test/unit-tests/typecheck-tests.rkt +++ b/typed-racket-test/unit-tests/typecheck-tests.rkt @@ -381,6 +381,7 @@ racket/port racket/sequence racket/set + racket/treelist racket/string racket/system racket/tcp @@ -1900,6 +1901,62 @@ (tc-e (list->seteqv (list 'one 'two)) (-set (one-of/c 'one 'two))) (tc-e (set->list (set 'one 'two)) (-lst (one-of/c 'one 'two))) + ;;Treelist operations + + (tc-e (treelist-empty? (treelist)) -Boolean) + (tc-e (treelist-empty? (treelist "a" "b")) -Boolean) + (tc-e (treelist-length (treelist "a" "b" "c")) -Index) + (tc-e (treelist-member? (treelist 1) 1 =) -Boolean) + (tc-e (treelist-first (treelist "a")) -String) + (tc-e (treelist-last (treelist "a")) -String) + (tc-e (treelist-rest (treelist "a" "b")) (-treelist -String)) + (tc-e (treelist-add (treelist "a") "b") (-treelist -String)) + (tc-e (treelist-cons (treelist "a") "b") (-treelist -String)) + (tc-e (treelist-cons (treelist "a") 9) (-treelist (t:Un -PosByte -String))) + (tc-e (treelist-delete (treelist "a") 0) (-treelist -String)) + (tc-err (treelist-delete (treelist "a") "b")) + (tc-e (make-treelist 5 "a") (-treelist -String)) + (tc-e (treelist-ref (treelist "a" "b") 1) -String) + (tc-err (treelist-ref (treelist "a" "b") "b")) + (tc-e (treelist-insert (treelist "a" "c") 1 "b") (-treelist -String)) + (tc-e (treelist-insert (treelist "a" "c") 1 9) (-treelist (t:Un -PosByte -String))) + (tc-err (treelist-insert (treelist "a" "c") "b" "b")) + (tc-e (treelist-set (treelist "a" "c") 1 "b") (-treelist -String)) + (tc-e (treelist-set (treelist "a" "c") 1 9) (-treelist (t:Un -PosByte -String))) + (tc-err (treelist-set (treelist "a" "c") "b" "b")) + (tc-e (treelist-take (treelist "a" "b") 1) (-treelist -String)) + (tc-err (treelist-take (treelist "a" "b") "a")) + (tc-e (treelist-drop (treelist "a" "b") 1) (-treelist -String)) + (tc-err (treelist-drop (treelist "a" "b") "a")) + (tc-e (treelist-take-right (treelist "a" "b") 1) (-treelist -String)) + (tc-err (treelist-take-right (treelist "a" "b") "a")) + (tc-e (treelist-drop-right (treelist "a" "b") 1) (-treelist -String)) + (tc-err (treelist-drop-right (treelist "a" "b") "a")) + (tc-e (treelist-sublist (treelist "a" "b" "c") 1 2) (-treelist -String)) + (tc-err (treelist-sublist (treelist "a" "b" "c") 1 "c")) + (tc-err (treelist-sublist (treelist "a" "b" "c") "b" 1)) + (tc-e (treelist-reverse (treelist "a" "b")) (-treelist -String)) + (tc-e (treelist->list (treelist "a")) (-lst -String)) + (tc-e (treelist->vector (treelist "a")) (-vec -String)) + ;;(tc-e (in-treelist (treelist "a")) (-seq -String)) FIXME: "missing type identifier" + (tc-e (list->treelist (list "a")) (-treelist -String)) + (tc-e (vector->treelist (vector "a")) (-treelist -String)) + (tc-e (treelist? (treelist "a")) #:ret (tc-ret -Boolean -true-propset)) + (tc-e (treelist? (list "a")) #:ret (tc-ret -Boolean -false-propset)) + (tc-e (treelist-append (treelist "a") (treelist "b")) (-treelist -String)) + (tc-e (treelist-append (treelist "a") (treelist "b") (treelist "c")) (-treelist -String)) + (tc-e (treelist-append (treelist "a") (treelist 9)) (-treelist (t:Un -PosByte -String))) + (tc-e (treelist-map (treelist "a" "b") (λ (x) "c")) (-treelist -String)) + (tc-e (treelist-map (treelist "a" "b") (λ (x) 9)) (-treelist -PosByte)) + (tc-e (treelist-for-each (treelist "a" "b") (λ (x) x)) -Void) + (tc-e (treelist-find (treelist "a" "b") (λ (x) (if (equal? x "a") #t #f))) -String) + (tc-e (treelist-filter even? (treelist 1 2 3 4 5)) (-treelist -PosByte)) + (tc-e (treelist-flatten (treelist (treelist (treelist (treelist "a"))))) (-treelist Univ)) + (tc-e (treelist-flatten "a") (-treelist Univ)) + (tc-e (treelist-append* (treelist (treelist "a" "b") (treelist "c" (treelist "d") "e") (treelist))) (-treelist Univ)) + (tc-e (treelist-index-of (treelist "a" "b" "c") "b") -Index) + (tc-e (treelist-index-of (treelist "a" "b" "c") "b" equal?) -Index) + (tc-e (treelist-sort (treelist "c" "a" "b") string