From cce0f70c69961ff6e58788f5db465a5cdf88c2f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Wed, 21 Sep 2016 04:30:39 +0200 Subject: [PATCH] Implemented, tested and documented xlist types --- README.md | 2 +- caret-identifier.rkt | 11 ++ infinity-identifier.rkt | 6 + info.rkt | 12 +- main.rkt | 229 +++++++++++++++++++++++++++----- scribble-enhanced.rkt | 32 +++++ scribblings/xlist.scrbl | 198 ++++++++++++++++++++++++++- test/test-type-superscripts.rkt | 173 ++++++++++++++++++++++++ test/test-type.rkt | 146 ++++++++++++++++++++ 9 files changed, 771 insertions(+), 38 deletions(-) create mode 100644 caret-identifier.rkt create mode 100644 infinity-identifier.rkt create mode 100644 scribble-enhanced.rkt create mode 100644 test/test-type-superscripts.rkt create mode 100644 test/test-type.rkt diff --git a/README.md b/README.md index b1e7490..357a039 100644 --- 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 new file mode 100644 index 0000000..c4c7d07 --- /dev/null +++ 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 new file mode 100644 index 0000000..f12db29 --- /dev/null +++ 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 index af15705..6fe7b71 100644 --- 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 index 216dcac..499f235 100644 --- a/main.rkt +++ b/main.rkt @@ -1,35 +1,204 @@ -#lang racket/base +#lang typed/racket/base -(module+ test - (require rackunit)) +(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)) -;; Notice -;; To install (from within the package directory): -;; $ raco pkg install -;; To install (once uploaded to pkgs.racket-lang.org): -;; $ raco pkg install <> -;; To uninstall: -;; $ raco pkg remove <> -;; To view documentation: -;; $ raco docs <> -;; -;; 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 +(provide xlist xList ^ ∞) -;; Code here +(define-syntax stop + (λ (stx) (raise-syntax-error 'stop "This is a private marker" stx))) -(module+ test - ;; Tests to be run with raco test - ) +(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)))) -(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)))) diff --git a/scribble-enhanced.rkt b/scribble-enhanced.rkt new file mode 100644 index 0000000..a64e044 --- /dev/null +++ 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 index 2d86308..4f6202f 100644 --- 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 new file mode 100644 index 0000000..5b356a4 --- /dev/null +++ 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 new file mode 100644 index 0000000..683193b --- /dev/null +++ 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))