commit cce0f70c69961ff6e58788f5db465a5cdf88c2f3
parent 2a1c03257251a555ca9002f65c0fc5f36fb725db
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Wed, 21 Sep 2016 04:30:39 +0200
Implemented, tested and documented xlist types
Diffstat:
9 files changed, 780 insertions(+), 44 deletions(-)
diff --git a/README.md b/README.md
@@ -6,4 +6,4 @@
xlist
=====
-Fancy lists, with bounded or unbounded repetition of elements. Can be used as a type, match pattern or to create instances.
-\ No newline at end of file
+Fancy lists, with bounded or unbounded repetition of elements. Can be used as a type or match pattern.
+\ No newline at end of file
diff --git a/caret-identifier.rkt b/caret-identifier.rkt
@@ -0,0 +1,11 @@
+#lang racket/base
+(provide ^)
+
+(require (for-syntax racket/base))
+
+(define-syntax ^
+ (λ (stx)
+ (raise-syntax-error
+ '^
+ "The ^ identifier can only be used in some contexts"
+ stx)))
+\ No newline at end of file
diff --git a/infinity-identifier.rkt b/infinity-identifier.rkt
@@ -0,0 +1,6 @@
+#lang racket/base
+(provide ∞)
+
+(require (for-syntax racket/base))
+
+(define ∞ +inf.0)
+\ No newline at end of file
diff --git a/info.rkt b/info.rkt
@@ -1,8 +1,16 @@
#lang info
(define collection "xlist")
(define deps '("base"
- "rackunit-lib"))
-(define build-deps '("scribble-lib" "racket-doc"))
+ "rackunit-lib"
+ "mutable-match-lambda"
+ "scribble-enhanced"
+ "multi-id"
+ "type-expander"
+ "typed-racket-lib"))
+(define build-deps '("scribble-lib"
+ "racket-doc"
+ "typed-racket-doc"
+ "scribble-math"))
(define scribblings '(("scribblings/xlist.scrbl" ())))
(define pkg-desc "Description Here")
(define version "0.0")
diff --git a/main.rkt b/main.rkt
@@ -1,35 +1,204 @@
-#lang racket/base
-
-(module+ test
- (require rackunit))
-
-;; Notice
-;; To install (from within the package directory):
-;; $ raco pkg install
-;; To install (once uploaded to pkgs.racket-lang.org):
-;; $ raco pkg install <<name>>
-;; To uninstall:
-;; $ raco pkg remove <<name>>
-;; To view documentation:
-;; $ raco docs <<name>>
-;;
-;; For your convenience, we have included a LICENSE.txt file, which links to
-;; the GNU Lesser General Public License.
-;; If you would prefer to use a different license, replace LICENSE.txt with the
-;; desired license.
-;;
-;; Some users like to add a `private/` directory, place auxiliary files there,
-;; and require them in `main.rkt`.
-;;
-;; See the current version of the racket style guide here:
-;; http://docs.racket-lang.org/style/index.html
-
-;; Code here
-
-(module+ test
- ;; Tests to be run with raco test
- )
-
-(module+ main
- ;; Main entry point, executed when run with the `racket` executable or DrRacket.
- )
+#lang typed/racket/base
+
+(require type-expander
+ multi-id
+ "caret-identifier.rkt"
+ "infinity-identifier.rkt"
+ (for-syntax
+ (rename-in racket/base
+ [* mul]
+ [+ plus]
+ [compose ∘]
+ [... …])
+ racket/syntax
+ racket/match
+ racket/contract
+ racket/list
+ racket/function
+ racket/string
+ (rename-in syntax/parse
+ [...+ …+])
+ syntax/stx
+ type-expander/expander))
+
+(provide xlist xList ^ ∞)
+
+(define-syntax stop
+ (λ (stx) (raise-syntax-error 'stop "This is a private marker" stx)))
+
+(begin-for-syntax
+ (define number/rx #px"^(.*?)([⁰¹²³⁴⁵⁶⁷⁸⁹]+)$")
+ (define */rx #px"^(.*?)⃰$")
+ (define +/rx #px"^(.*?)([⁰¹²³⁴⁵⁶⁷⁸⁹]*)⁺$")
+ (define -/rx #px"^(.*?)([⁰¹²³⁴⁵⁶⁷⁸⁹]*)⁻([⁰¹²³⁴⁵⁶⁷⁸⁹]*)$")
+
+ (define (regexp-match/c rx)
+ (and/c string? (λ (s) (regexp-match? rx s))))
+
+ (define (id/c id)
+ (and/c identifier? (λ (i) (free-identifier=? i id))))
+
+
+ (define string-superscript-number/c (regexp-match/c number/rx))
+ (define string-superscript-*/c (regexp-match/c */rx))
+ (define string-superscript-+/c (regexp-match/c +/rx))
+ (define string-superscript--/c (regexp-match/c -/rx))
+
+ (define string-superscript-any/c
+ (or/c string-superscript-number/c
+ string-superscript-*/c
+ string-superscript-+/c
+ string-superscript--/c))
+
+ (define normal-rest/c
+ (or/c (list/c (id/c #'^) exact-nonnegative-integer?)
+ (list/c (id/c #'^) (id/c #'*))
+ (list/c (id/c #'^) exact-nonnegative-integer? (id/c #'+))
+ (list/c (id/c #'^)
+ exact-nonnegative-integer?
+ (id/c #'-)
+ (or/c (id/c #'∞) exact-nonnegative-integer?))))
+
+ (define normal-string/c (cons/c string?
+ normal-rest/c))
+ (define normal-id/c (cons/c (and/c identifier? (not/c (syntax/c '||)))
+ normal-rest/c))
+
+ (define/contract (string-superscripts->number superscripts)
+ (-> string-superscript-number/c exact-nonnegative-integer?)
+ (string->number
+ (string-join
+ (map (match-lambda ["⁰" "0"] ["¹" "1"] ["²" "2"] ["³" "3"] ["⁴" "4"]
+ ["⁵" "5"] ["⁶" "6"] ["⁷" "7"] ["⁸" "8"] ["⁹" "9"])
+ (map string (string->list superscripts))))))
+
+ (define/contract (string-superscripts->normal superscripts)
+ (-> string-superscript-any/c
+ normal-string/c)
+ (define ->num string-superscripts->number)
+ (match superscripts
+ ;; Order is important, the regexpes overlap
+ [(regexp -/rx (list _ base n m))
+ (list base
+ #'^
+ (if (string=? n "") 0 (->num n))
+ #'-
+ (if (string=? m "") #'∞ (->num m)))]
+ [(regexp number/rx (list _ base n)) (list base #'^ (->num n))]
+ [(regexp */rx (list _ base)) (list base #'^ #'*)]
+ [(regexp +/rx (list _ base n))
+ (list base #'^ (if (string=? n "") 1 (->num n)) #'+)]))
+
+ (define/contract (id-superscripts->normal id)
+ (-> identifier? (or/c #f normal-id/c))
+ (define str (symbol->string (syntax-e id)))
+ (if (string-superscript-any/c str)
+ (match (string-superscripts->normal str)
+ [(cons "" _) #f]
+ [(cons base rest) (cons (format-id id "~a" base) rest)])
+ #f))
+
+ (define/contract (only-superscripts->normal id)
+ (-> identifier? (or/c #f normal-rest/c))
+ (define str (symbol->string (syntax-e id)))
+ (if (string-superscript-any/c str)
+ (match (string-superscripts->normal str)
+ [(cons "" rest) rest]
+ [_ #f])
+ #f))
+
+ (define-splicing-syntax-class with-superscripts
+ (pattern (~seq id:id)
+ #:do [(define normal (id-superscripts->normal #'id))]
+ #:when normal
+ #:with (expanded …) normal)
+ (pattern (~seq base:expr super:id)
+ #:do [(define normal (only-superscripts->normal #'super))]
+ #:when normal
+ #:with (expanded …) (cons #'base normal)))
+
+ (define-syntax-class not-stx-list
+ (pattern {~not (_ …)}))
+
+ (define-syntax-class base
+ #:literals (^ + *)
+ (pattern {~and base {~not {~or ^ + *}}}))
+
+ (define-splicing-syntax-class fixed-repeat
+ (pattern {~seq :base {~literal ^} power:number}
+ #:with (expanded …) (map (const #'base)
+ (range (syntax-e #'power))))
+ (pattern {~literal stop}
+ #:with (expanded …) #'())
+ (pattern e:base
+ #:with (expanded …) #'(e)))
+
+ (define-syntax-class repeat-spec
+ #:literals (* + - ∞)
+ (pattern (:number))
+ (pattern ({~optional :number} +))
+ (pattern ({~optional :number} - {~optional {~or ∞ :number}}))
+ (pattern (*)))
+
+ #;(define-splicing-syntax-class xlist-*-element
+ #:attributes (base)
+ (pattern :split-superscript-*-id)
+ (pattern (~seq base :superscript-ish-*)))
+
+ #;(define-splicing-syntax-class xlist-+-element
+ #:attributes (base min)
+ (pattern :split-superscript-+-id)
+ (pattern (~seq base :superscript-ish-+)))
+
+ (define (xlist-type context)
+ ;; The order of clauses is important, as they otherwise overlap.
+ (syntax-parser
+ #:context context
+ #:literals (^ * + - ∞ stop)
+ [()
+ #'Null]
+ [rest:not-stx-list
+ #'rest]
+ [(stop . rest) ;; eliminate the private marker
+ #'(xlist . rest)]
+ [(s:with-superscripts . rest)
+ #'(xlist s.expanded … . rest)]
+ [(:base {~optional ^} *)
+ #'(Listof base)]
+ [(:base {~optional ^} * . rest)
+ #:with R (gensym 'R)
+ #'(Rec R (U (Pairof base R)
+ (xList . rest)))]
+ [(:base {~optional ^} + . rest)
+ #'(xlist base ^ 1 + . rest)]
+ [(:base ^ power:nat + . rest)
+ #'(xlist base ^ power stop base * . rest)]
+ [(:base ^ - . rest)
+ #'(xlist base ^ 0 - . rest)]
+ [(:base ^ from:nat - ∞ . rest)
+ #'(xlist base ^ from stop base * . rest)]
+ [(:base ^ 0 - to:nat . rest)
+ #`(U . #,(foldl (λ (iteration u*)
+ (syntax-case u* ()
+ [[(_ . base…rest) . _]
+ #`[(xlist base . base…rest) . #,u*]]))
+ #'[(xlist . rest)]
+ (range (syntax-e #'to))))]
+ [(:base ^ from:nat - to:nat . rest)
+ #:with difference (- (syntax-e #'to) (syntax-e #'from))
+ (when (< (syntax-e #'difference) 0)
+ (raise-syntax-error 'xlist
+ "invalid range: m is larger than n"
+ #'-))
+ #`(xlist base ^ from stop base ^ 0 - difference . rest)]
+ [(:base ^ from:nat - . rest)
+ ;; "-" is not followed by a number, nor by ∞, so default to ∞.
+ #`(xlist base ^ from - ∞ . rest)]
+ [(e:fixed-repeat . rest)
+ #'(List* e.expanded … (xList . rest))])))
+
+(define-type-expander (xList stx)
+ ((xlist-type stx) (stx-cdr stx)))
+
+(define-multi-id xlist
+ #:type-expander (λ (stx) ((xlist-type stx) (stx-cdr stx))))
diff --git a/scribble-enhanced.rkt b/scribble-enhanced.rkt
@@ -0,0 +1,32 @@
+#lang racket
+
+(require (for-syntax mutable-match-lambda
+ racket/string
+ racket/match
+ racket/function
+ racket/syntax)
+ scribble-enhanced/with-manual)
+
+;; Correctly display xyz⃰, xyzⁿ, xyz⁰, xyz¹, … xyz⁹
+(begin-for-syntax
+ (mutable-match-lambda-add-overriding-clause!
+ mutable-match-element-id-transformer
+ #:match-lambda
+ [(? identifier?
+ whole-id
+ (app (compose symbol->string syntax-e)
+ (pregexp
+ #px"^(.*?)(⃰|⁺|[⁰¹²³⁴⁵⁶⁷⁸⁹]+⁺?|[⁰¹²³⁴⁵⁶⁷⁸⁹]*⁻[⁰¹²³⁴⁵⁶⁷⁸⁹]*)$"
+ (list whole base power))))
+ (define/with-syntax base-id (format-id whole-id "~a" base))
+ (define/with-syntax power-characters
+ (string-join
+ (map (match-lambda ["⃰" "*"]
+ ["⁺" "+"]
+ ["⁻" "-"]
+ ;["ⁿ" "n"]
+ ["⁰" "0"] ["¹" "1"] ["²" "2"] ["³" "3"] ["⁴" "4"]
+ ["⁵" "5"] ["⁶" "6"] ["⁷" "7"] ["⁸" "8"] ["⁹" "9"])
+ (map string (string->list power)))))
+ #`(elem (list #,@(if (> (string-length base) 0) #'((racket base-id)) #'())
+ (superscript power-characters)))]))
diff --git a/scribblings/xlist.scrbl b/scribblings/xlist.scrbl
@@ -1,10 +1,198 @@
#lang scribble/manual
-@require[@for-label[xlist
- racket/base]]
+@require[scribble-enhanced/with-manual
+ xlist/scribble-enhanced
+ scribble-math
+ racket/require
+ @for-label[xlist
+ (subtract-in typed/racket/base match-string)
+ (only-in syntax/parse ...+)
+ match-string]]
-@title{xlist}
-@author{georges}
+@title[#:style (with-html5 manual-doc-style)]{xlist}
+@author[@author+email["Georges Dupéron" "georges.duperon@gmail.com"]]
@defmodule[xlist]
-Package Description Here
+Fancy lists, with bounded or unbounded repetition of elements. Can be used as a
+type or match pattern.
+
+To use the type expander, you must first require the
+@racketmodname[type-expander] library.
+
+@deftogether[
+ [@defform*[#:kind "type-expander"
+ [(xList τᵢ …)
+ (xList τᵢ … . rest)]]
+ @defform*[#:kind "type-expander"
+ #:literals (^ *)
+ [(xlist τᵢ …)
+ (xlist τᵢ … . rest)]
+ #:grammar
+ [(τᵢ type
+ repeated-type)
+ (repeated-type (code:line type ^ repeat)
+ (code:line type ^ {repeat})
+ (code:line type {repeat})
+ (code:line type superscripted-repeat)
+ (code:line type *)
+ (code:line type +)
+ (code:line superscripted-id))
+ (repeat (code:line number)
+ (code:line number +)
+ (code:line +)
+ (code:line number - number)
+ (code:line number -)
+ (code:line number - ∞)
+ (code:line - number)
+ (code:line -)
+ (code:line *))]]]]{
+ The notation @racket[type ^ _n], where @racket[_n] is a number, indicates that
+ the given type should be repeated @racket[_n] times within the list. Therefore,
+ the following two types are equivalent:
+
+ @racketblock[
+ (xList Number ^ 3 Symbol String ^ 2)
+ (List Number Number Number Symbol String String)]
+
+ The notation @racket[type *] indicates that the given type may be repeated zero
+ or more times. Therefore, the following two types are equivalent:
+
+ @racketblock[
+ (xList Number * Symbol String *)
+ (Rec R1 (U (Pairof Number R1)
+ (List* Symbol (Rec R2 (U (Pairof String R2)
+ Null)))))]
+
+ The notation @racket[type ^ _n +] indicates that the given type may be repeated
+ @racket[_n] or more times. Therefore, the following two types are equivalent:
+
+ @racketblock[
+ (xList Number ^ {2 +} String)
+ (List* Number Number (Rec R1 (U (Pairof Number R1)
+ (List String))))]
+
+ When the number preceding @racket[+] is omitted, it defaults to @racket[1].
+
+ The notation @racket[type ^ _n - _m] indicates that the given type may be
+ repeated between @racket[_n] (inclusive) and @racket[_m] (inclusive) times.
+ Therefore, the following two types are equivalent:
+
+ @racketblock[
+ (xList Number ^ {2 - 5} String)
+ (U (List Number Number String)
+ (List Number Number Number String)
+ (List Number Number Number Number String)
+ (List Number Number Number Number Number String))]
+
+ Be aware that the tail of the @racket[xList] following the use of
+ @racket[type ^ _n - _m] is repeated @${n - m} times, so if the tail itself
+ contains uses of @racket[-], the resulting macro-expanded type will be huge,
+ and may easily make Typed/Racket run out of memory, or slow down the type
+ checking.
+
+ If the first bound is omitted, it defaults to @racket[0], and if the second
+ bound is omited, it defaults to @racket[∞]. This means that @racket[-] on its
+ own is equivalent to @racket[*], but the latter form is preferred.
+
+ The @racket[superscripted-repeat] is a representation of @racket[repeat] using
+ superscripted unicode characters, without spaces (i.e. the
+ @racket[superscripted-repeat] is a single identifier):
+
+ @itemlist[
+ @item{Digits are replaced by their unicode superscripted counterparts
+ @elem[#:style 'tt "⁰¹²³⁴⁵⁶⁷⁸⁹"]}
+ @item{@racket[+] and @racket[-] are replaced by their unicode superscripted
+ counterparts, respectively @elem[#:style 'tt "⁺"] and @elem[#:style 'tt "⁻"]}
+ @item{@racket[*] is replaced by the unicode character ``COMBINING ASTERISK
+ ABOVE'' @racket[ ⃰] (code point U+20F0)}
+ @item{@racket[∞] is always omitted, as @racket[_n - ∞] and @racket[- ∞] are
+ equivalent to @racket[_n -] and @racket[0 -]}]
+
+ A @racket[superscripted-id] is a type identifier ending with a sequence of
+ characters which would otherwise be valid for @racket[superscripted-repeat]. In
+ other words, if the @racket[type] is an identifier, the type and the
+ @racket[superscripted-repeat] can be coalesced into a single identifier.
+
+ The identifier @racket[String³] is equivalent to the notations
+ @racket[String ³] (with a space between the identifier and the @racket[ ⃰]) and
+ @racket[String ^ 3].
+
+ Similarly, the identifier @racket[String⃰] is equivalent to the notations
+ @racket[String ⃰] (with a space between the identifier and the @racket[ ⃰]),
+ @racket[String ^ *] (using a regular asterisk, i.e. the multiplication function
+ in Racket) and @racket[String *] (using a regular asterisk, i.e. the
+ multiplication function in Racket).
+
+ The same logic applies to the other cases.}
+
+@defform*[#:kind "match-expander"
+ #:link-target? #f
+ #:literals (^ *)
+ [(xlist patᵢ ...)
+ (xlist patᵢ ... . rest)]
+ #:grammar
+ [(patᵢ pattern-or-spliced
+ repeated-pattern
+ spliced-pattern)
+ (pattern-or-spliced pattern
+ spliced-pattern)
+ (spliced-pattern ,@pattern)
+ (repeated-pattern (code:line pattern-or-spliced ^ repeat)
+ (code:line pattern-or-spliced ^ {repeat})
+ (code:line pattern-or-spliced superscripted-repeat)
+ (code:line pattern-or-spliced *)
+ (code:line pattern-or-spliced +)
+ (code:line superscripted-id))
+ (repeat (code:line number)
+ (code:line number +)
+ (code:line +)
+ (code:line number - number)
+ (code:line number -)
+ (code:line number - ∞)
+ (code:line - number)
+ (code:line -)
+ (code:line *)
+ (code:line ...)
+ (code:line ..k)
+ (code:line ____)
+ (code:line ___k)
+ (code:line ...+))]]{
+
+ This match expander works like the @racket[xList] type expander, but instead
+ controls the repetition of match patterns. The repeated patterns are not
+ literally copied, as this would likely cause errors related to duplicate
+ attributes. Instead, the @racket[repeat] forms control the number of times a
+ pattern may be bound, like @racket[...] does.
+
+ For convenience and compatibility with existing match patterns, the following
+ equivalences are provided:
+ @itemlist[
+ @item{@racket[...] is equivalent to @racket[*]}
+ @item{@racket[_..k] is equivalent to @racket[_k +]}
+ @item{@racket[____] is equivalent to @racket[*]}
+ @item{@racket[___k] is equivalent to @racket[_k +]}
+ @item{@racket[...+] is equivalent to @racket[+]}]
+
+ Additionally, when @RACKET[#,@pattern] appears as one of the @racket[xlist]
+ elements, the given @racket[pattern] may match any number of elements in the
+ list. This is implemented in terms of @racket[append] from the
+ @racketmodname[match-string] library.
+
+ The following two match patterns are therefore equivalent:
+
+ @racketblock[
+ (xlist number?³⁻⁵ ,@(list-no-order number? string?) symbol?⁺)
+ (append (and (list number? ...) (app length (between/c 3 5)))
+ (list-no-order number? string?)
+ (list symbol? ..1))]
+
+ Applying a repeat indicator on a splice is not supported yet, i.e.
+ @racket[(xlist ,@(list-no-order number? string?)⁵)] will not work.}
+
+@defidform[^]{This identifier can only be used within xlist forms.}
+@defthing[∞]{This identifier is meant to be used within xlist
+ forms, but is also equal to @racket[+inf.0] as a convenience. In the future,
+ this package will make it possible for other packages to overload the meaning
+ of the @racket[^] and @racket[∞] identifiers, so that the value of @racket[∞]
+ may depend on the packages loaded (for example a symbolic math package may want
+ to attach a special value to @racket[∞].}
+\ No newline at end of file
diff --git a/test/test-type-superscripts.rkt b/test/test-type-superscripts.rkt
@@ -0,0 +1,173 @@
+#lang typed/racket
+
+(require xlist
+ type-expander
+ typed/rackunit)
+
+;; Should fail (for now)
+;(test-begin
+; "(xlist 1 2 3 4 5)"
+; (ann '() (xlist))
+; (ann '(1) (xlist 1¹))
+; (ann '(1 2) (xlist 1¹ 2¹))
+; (ann '(1 2 3) (xlist 1¹ 2¹ 3¹))
+; (ann '(1 2 3 4) (xlist 1¹ 2¹ 3¹ 4¹))
+; (ann '(1 2 3 4 5) (xlist 1¹ 2¹ 3¹ 4¹ 5¹))
+; (void))
+
+;; Should fail:
+; (xlist ^ 1)
+; (xlist ^ 1 +)
+; (xlist ^ 1 *)
+; (xlist +)
+; (xlist *)
+
+;(test-begin
+; "(xlist 1 *) and (xlist 1 +) with or witout ^"
+; (ann '() (xlist 1 *))
+; (ann '(1) (xlist 1 *))
+; (ann '(1 1) (xlist 1 *))
+; (ann '(1 1 1) (xlist 1 *))
+;
+; ; NOT (ann '() (xlist 1 +))
+; (ann '(1) (xlist 1 +))
+; (ann '(1 1) (xlist 1 +))
+; (ann '(1 1 1) (xlist 1 +))
+;
+; (ann '() (xlist 1 ^ *))
+; (ann '(1) (xlist 1 ^ *))
+; (ann '(1 1) (xlist 1 ^ *))
+; (ann '(1 1 1) (xlist 1 ^ *))
+;
+; ; NOT (ann '() (xlist 1 ^ +))
+; (ann '(1) (xlist 1 ^ +))
+; (ann '(1 1) (xlist 1 ^ +))
+; (ann '(1 1 1) (xlist 1 ^ +))
+; (void))
+
+
+(test-begin
+ "(xlist Number⃰) and (xlist Number⁺) with or without space"
+ (ann '() (xlist Number⃰))
+ (ann '(1) (xlist Number⃰))
+ (ann '(1 1) (xlist Number⃰))
+ (ann '(1 1 1) (xlist Number⃰))
+
+ ; NOT (ann '() (xlist Number⁺))
+ (ann '(1) (xlist Number⁺))
+ (ann '(1 1) (xlist Number⁺))
+ (ann '(1 1 1) (xlist Number⁺))
+
+ (ann '() (xlist Number ⃰))
+ (ann '(1) (xlist Number ⃰))
+ (ann '(1 1) (xlist Number ⃰))
+ (ann '(1 1 1) (xlist Number ⃰))
+
+ ; NOT (ann '() (xlist Number ⁺))
+ (ann '(1) (xlist 1 ⁺))
+ (ann '(1 1) (xlist 1 ⁺))
+ (ann '(1 1 1) (xlist 1 ⁺))
+ (void))
+
+(test-begin
+ "(xlist Number⃰) and (xlist Number +) something after"
+ (ann '() (xlist Number⃰ String⃰))
+ (ann '(1) (xlist Number⃰ String⃰))
+ (ann '("b") (xlist Number⃰ String⃰))
+ (ann '(1 "b") (xlist Number⃰ String⃰))
+ (ann '(1 1 1 "b" "b") (xlist Number⃰ String⃰))
+ (ann '(1 1 1) (xlist Number⃰ String⃰))
+ (ann '("b" "b" "b") (xlist Number⃰ String⃰))
+
+ ; NOT (ann '() (xlist Number⁺ String⁺))
+ ; NOT (ann '(1) (xlist Number⁺ String⁺))
+ ; NOT (ann '("b") (xlist Number⁺ String⁺))
+ (ann '(1 "b") (xlist Number⁺ String⁺))
+ (ann '(1 1 "b") (xlist Number⁺ String⁺))
+ (ann '(1 "b" "b") (xlist Number⁺ String⁺))
+
+ (ann '() (xlist Number ⃰ String ⃰))
+ (ann '(1) (xlist Number ⃰ String ⃰))
+ (ann '("b") (xlist Number ⃰ String ⃰))
+ (ann '(1 "b") (xlist Number ⃰ String ⃰))
+ (ann '(1 1 1 "b" "b") (xlist Number ⃰ String ⃰))
+ (ann '(1 1 1) (xlist Number ⃰ String ⃰))
+ (ann '("b" "b" "b") (xlist Number ⃰ String ⃰))
+
+ ; NOT (ann '() (xlist Number ⁺ String ⁺))
+ ; NOT (ann '(1) (xlist Number ⁺ String ⁺))
+ ; NOT (ann '("b") (xlist Number ⁺ String ⁺))
+ (ann '(1 "b") (xlist Number ⁺ String ⁺))
+ (ann '(1 1 "b") (xlist Number ⁺ String ⁺))
+ (ann '(1 "b" "b") (xlist Number ⁺ String ⁺))
+ (void))
+
+(test-begin
+ "(xlist Numberⁿ⁺) with or without space"
+ (ann '(1 1 1) (xlist Number⁺))
+ (ann '(1 1 1) (xlist Number⁰⁺))
+ (ann '(1 1 1) (xlist Number¹⁺))
+ (ann '(1 1 1) (xlist Number²⁺))
+ (ann '(1 1 1) (xlist Number³⁺))
+ (ann '(1 1 1) (xlist Number ⁺))
+ (ann '(1 1 1) (xlist Number ⁰⁺))
+ (ann '(1 1 1) (xlist Number ¹⁺))
+ (ann '(1 1 1) (xlist Number ²⁺))
+ (ann '(1 1 1) (xlist Number ³⁺))
+ (void))
+
+(test-begin
+ "(xlist Numberⁱ⁻ⁿ) without space"
+ (ann '() (xlist Number⁻))
+ (ann '(1 1 1) (xlist Number⁻))
+ (ann '() (xlist Number⁰⁻))
+ (ann '(1 1 1) (xlist Number⁰⁻))
+ (ann '(1 1 1) (xlist Number¹⁻))
+ (ann '(1 1 1) (xlist Number²⁻))
+ (ann '(1 1 1) (xlist Number³⁻))
+ ;(ann '(1 1 1) (xlist Number ^ - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ 0 - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ 1 - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ 2 - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ 3 - ∞))
+ (ann '(1 1 1) (xlist Number⁰⁻⁵))
+ (ann '(1 1 1) (xlist Number³⁻⁵))
+ (ann '(1 1 1 1) (xlist Number⁰⁻⁵))
+ (ann '(1 1 1 1) (xlist Number³⁻⁵))
+ (ann '(1 1 1 1 1) (xlist Number⁰⁻⁵))
+ (ann '(1 1 1 1 1) (xlist Number⁰⁻⁵))
+ (void))
+
+(test-begin
+ "(xlist Number ⁱ⁻ⁿ) with space"
+ (ann '() (xlist Number ⁻))
+ (ann '(1 1 1) (xlist Number ⁻))
+ (ann '() (xlist Number ⁰⁻))
+ (ann '(1 1 1) (xlist Number ⁰⁻))
+ (ann '(1 1 1) (xlist Number ¹⁻))
+ (ann '(1 1 1) (xlist Number ²⁻))
+ (ann '(1 1 1) (xlist Number ³⁻))
+ ;(ann '() (xlist Number ^ - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ - ∞))
+ ;(ann '() (xlist Number ^ 0 - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ 0 - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ 1 - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ 2 - ∞))
+ ;(ann '(1 1 1) (xlist Number ^ 3 - ∞))
+ (ann '(1 1 1) (xlist Number ⁰⁻⁵))
+ (ann '(1 1 1) (xlist Number ³⁻⁵))
+ (ann '(1 1 1 1) (xlist Number ⁰⁻⁵))
+ (ann '(1 1 1 1) (xlist Number ³⁻⁵))
+ (ann '(1 1 1 1 1) (xlist Number ⁰⁻⁵))
+ (ann '(1 1 1 1 1) (xlist Number ⁰⁻⁵))
+ (void))
+
+(test-begin
+ "(xlist Numberⁿ⁻ String)"
+ (ann '("b") (xlist Number⁻ String))
+ (ann '(1 1 1 "b") (xlist Number⁻ String))
+ (ann '("b") (xlist Number⁰⁻ String))
+ (ann '(1 1 1 "b") (xlist Number⁰⁻ String))
+ (ann '(1 1 1 "b") (xlist Number¹⁻ String))
+ (ann '(1 1 1 "b") (xlist Number²⁻ String))
+ (void))
diff --git a/test/test-type.rkt b/test/test-type.rkt
@@ -0,0 +1,146 @@
+#lang typed/racket
+
+(require xlist
+ type-expander
+ typed/rackunit)
+
+(test-begin
+ "(xlist 1 2 3 4 5)"
+ (ann '() (xlist))
+ (ann '(1) (xlist 1))
+ (ann '(1 2) (xlist 1 2))
+ (ann '(1 2 3) (xlist 1 2 3))
+ (ann '(1 2 3 4) (xlist 1 2 3 4))
+ (ann '(1 2 3 4 5) (xlist 1 2 3 4 5))
+ (void))
+
+;; Should fail:
+; (xlist ^ 1)
+; (xlist ^ 1 +)
+; (xlist ^ 1 *)
+; (xlist +)
+; (xlist *)
+
+(test-begin
+ "(xlist 1 *) and (xlist 1 +) with or witout ^"
+ (ann '() (xlist 1 *))
+ (ann '(1) (xlist 1 *))
+ (ann '(1 1) (xlist 1 *))
+ (ann '(1 1 1) (xlist 1 *))
+
+ ; NOT (ann '() (xlist 1 +))
+ (ann '(1) (xlist 1 +))
+ (ann '(1 1) (xlist 1 +))
+ (ann '(1 1 1) (xlist 1 +))
+
+ (ann '() (xlist 1 ^ *))
+ (ann '(1) (xlist 1 ^ *))
+ (ann '(1 1) (xlist 1 ^ *))
+ (ann '(1 1 1) (xlist 1 ^ *))
+
+ ; NOT (ann '() (xlist 1 ^ +))
+ (ann '(1) (xlist 1 ^ +))
+ (ann '(1 1) (xlist 1 ^ +))
+ (ann '(1 1 1) (xlist 1 ^ +))
+ (void))
+
+
+(test-begin
+ "(xlist Number *) and (xlist Number +) with or witout ^"
+ (ann '() (xlist Number *))
+ (ann '(1) (xlist Number *))
+ (ann '(1 1) (xlist Number *))
+ (ann '(1 1 1) (xlist Number *))
+
+ ; NOT (ann '() (xlist Number +))
+ (ann '(1) (xlist Number +))
+ (ann '(1 1) (xlist Number +))
+ (ann '(1 1 1) (xlist Number +))
+
+ (ann '() (xlist Number ^ *))
+ (ann '(1) (xlist Number ^ *))
+ (ann '(1 1) (xlist Number ^ *))
+ (ann '(1 1 1) (xlist Number ^ *))
+
+ ; NOT (ann '() (xlist Number ^ +))
+ (ann '(1) (xlist 1 ^ +))
+ (ann '(1 1) (xlist 1 ^ +))
+ (ann '(1 1 1) (xlist 1 ^ +))
+ (void))
+
+(test-begin
+ "(xlist Number *) and (xlist Number +) something after"
+ (ann '() (xlist Number * String *))
+ (ann '(1) (xlist Number * String *))
+ (ann '("b") (xlist Number * String *))
+ (ann '(1 "b") (xlist Number * String *))
+ (ann '(1 1 1 "b" "b") (xlist Number * String *))
+ (ann '(1 1 1) (xlist Number * String *))
+ (ann '("b" "b" "b") (xlist Number * String *))
+
+ ; NOT (ann '() (xlist Number + String +))
+ ; NOT (ann '(1) (xlist Number + String +))
+ ; NOT (ann '("b") (xlist Number + String +))
+ (ann '(1 "b") (xlist Number + String +))
+ (ann '(1 1 "b") (xlist Number + String +))
+ (ann '(1 "b" "b") (xlist Number + String +))
+
+ (ann '() (xlist Number ^ * String ^ *))
+ (ann '(1) (xlist Number ^ * String ^ *))
+ (ann '("b") (xlist Number ^ * String ^ *))
+ (ann '(1 "b") (xlist Number ^ * String ^ *))
+ (ann '(1 1 1 "b" "b") (xlist Number ^ * String ^ *))
+ (ann '(1 1 1) (xlist Number ^ * String ^ *))
+ (ann '("b" "b" "b") (xlist Number ^ * String ^ *))
+
+ ; NOT (ann '() (xlist Number ^ + String ^ +))
+ ; NOT (ann '(1) (xlist Number ^ + String ^ +))
+ ; NOT (ann '("b") (xlist Number ^ + String ^ +))
+ (ann '(1 "b") (xlist Number ^ + String ^ +))
+ (ann '(1 1 "b") (xlist Number ^ + String ^ +))
+ (ann '(1 "b" "b") (xlist Number ^ + String ^ +))
+ (void))
+
+(test-begin
+ "(xlist Number ^ x +)"
+ (ann '(1 1 1) (xlist Number +))
+ (ann '(1 1 1) (xlist Number ^ +))
+ (ann '(1 1 1) (xlist Number ^ 0 +))
+ (ann '(1 1 1) (xlist Number ^ 1 +))
+ (ann '(1 1 1) (xlist Number ^ 2 +))
+ (ann '(1 1 1) (xlist Number ^ 3 +))
+ (void))
+
+(test-begin
+ "(xlist Number ^ x - y)"
+ (ann '() (xlist Number ^ -))
+ (ann '(1 1 1) (xlist Number ^ -))
+ (ann '() (xlist Number ^ 0 -))
+ (ann '(1 1 1) (xlist Number ^ 0 -))
+ (ann '(1 1 1) (xlist Number ^ 1 -))
+ (ann '(1 1 1) (xlist Number ^ 2 -))
+ (ann '(1 1 1) (xlist Number ^ 3 -))
+ (ann '() (xlist Number ^ - ∞))
+ (ann '(1 1 1) (xlist Number ^ - ∞))
+ (ann '() (xlist Number ^ 0 - ∞))
+ (ann '(1 1 1) (xlist Number ^ 0 - ∞))
+ (ann '(1 1 1) (xlist Number ^ 1 - ∞))
+ (ann '(1 1 1) (xlist Number ^ 2 - ∞))
+ (ann '(1 1 1) (xlist Number ^ 3 - ∞))
+ (ann '(1 1 1) (xlist Number ^ 0 - 5))
+ (ann '(1 1 1) (xlist Number ^ 3 - 5))
+ (ann '(1 1 1 1) (xlist Number ^ 0 - 5))
+ (ann '(1 1 1 1) (xlist Number ^ 3 - 5))
+ (ann '(1 1 1 1 1) (xlist Number ^ 0 - 5))
+ (ann '(1 1 1 1 1) (xlist Number ^ 3 - 5))
+ (void))
+
+(test-begin
+ "(xlist Number ^ x - String)"
+ (ann '("b") (xlist Number ^ - String))
+ (ann '(1 1 1 "b") (xlist Number ^ - String))
+ (ann '("b") (xlist Number ^ 0 - String))
+ (ann '(1 1 1 "b") (xlist Number ^ 0 - String))
+ (ann '(1 1 1 "b") (xlist Number ^ 1 - String))
+ (ann '(1 1 1 "b") (xlist Number ^ 2 - String))
+ (void))
