Implemented, tested and documented xlist types

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.
+Fancy lists, with bounded or unbounded repetition of elements. Can be used as a type or match pattern.

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)))

infinity-identifier.rkt

@@ -0,0 +1,6 @@
+#lang racket/base
+(provide ∞)
+
+(require (for-syntax racket/base))
+
+(define ∞ +inf.0)

info.rkt

@@ -1,8 +1,16 @@
 #lang info
 (define collection "xlist")
 (define deps '("base"
-               "rackunit-lib"))
+               "rackunit-lib"
-(define build-deps '("scribble-lib" "racket-doc"))
+               "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")

main.rkt

@@ -1,35 +1,204 @@
-#lang racket/base
+#lang typed/racket/base
 
-(module+ test
+(require type-expander
-  (require rackunit))
+         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))
 
-;; Notice
+(provide xlist xList ^ ∞)
-;; 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
+(define-syntax stop
+  (λ (stx) (raise-syntax-error 'stop "This is a private marker" stx)))
 
-(module+ test
+(begin-for-syntax
-  ;; Tests to be run with raco test
+  (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))))
 
-(module+ main
+  
-  ;; Main entry point, executed when run with the `racket` executable or DrRacket.
+  (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))))

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)))]))

scribblings/xlist.scrbl

@@ -1,10 +1,198 @@
 #lang scribble/manual
-@require[@for-label[xlist
+@require[scribble-enhanced/with-manual
-                    racket/base]]
+         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}
+@title[#:style (with-html5 manual-doc-style)]{xlist}
-@author{georges}
+@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[∞].}

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))

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))