24c64e9de0
This is a major to some of the internal representation of things within Typed Racket (mostly affecting structs that inherited from Rep (see rep/rep-utils.rkt)), and lots of tweaks and bug fixes that happened along the way. This PR includes the following major changes: A new rep-utils implementation, which uses struct properties for the generic operations and properties of the various Reps (see rep-utils.rkt) More specific Rep inheritance (i.e. arr no longer inherits from Type, because it is not a Type, etc ...) (see type-rep.rkt, core-rep.rkt, values-rep.rkt), and thus things like Type/c no longer exist New Rep's to classify the things that are no longer Type or Prop, (such as PropSets, SomeValues, Results, etc -- see core-rep.rkt and values-rep.rkt) uses of type-case now replaced by uses of Rep-fold and Rep-walk structural types can specify their fields' variance and operations like subtyping and free-vars can generically operate over these types (see type-rep.rkt) type-mask replaces types key -- types masks are described in detail in (rep/type-mask.rkt) Types can specify a predicate to recognize their "top type" via [#:top pred]) There is an explicit 'Bottom' type now (i.e. neither union or intersection are used) subtyping re-organized, slight tweaking to inference various environments got for-each functions in addition to the map functions they had (e.g. type-name-env.rkt) Empty is no longer an Object? -- the OptObject? predicate checks for either Object or Empty, and so it is easier to be clear about where Empty makes sense appearing and where it does not Previously signatures were created with promises in their fields, now we create a promise around each signature (this way the contracts for Signature fields are cleaner) Names for structs now use the args field to describe how many type arguments they take (Note: this could use further tidying for sure!) simplified the propositional logic code in several places, got rid of escape continuations, etc (see prop-ops.rkt, tc-envops.rkt, tc-metafunctions.rkt) we now use subsumption more to simplify type results from type checking, e.g. if the type does not overlap w/ false, it's false proposition is FalseProp, etc (see tc-expr-unit.rkt and prop-ops.rkt, the function is called reduce-tc-results/subsumption) updating along a path will now intersect with the expected structural type if it is not encountered (e.g. updating Any with (Int @ car) now produces (Pairof Int Any) instead of Any -- see update.rkt) lots of tests were tweaked to match up w/ the new prop subsumption that occurs remove was renamed subtract (so as to not conflict w/ racket/base's remove) a restrict function was added, which acts like intersect but is never additive (i.e. it will never create an intersection if it can't figure out how the two types relate -- see intersect.rkt) tc-subst was modified to substitute out all the variables leaving scope at once (and I simplified/tweaked some of the logic in there a little, see tc-subst.rkt) Type checking function applications now propagates information learned why type checking the arguments, (e.g. (begin (f (assert x boolean?)) ...)) ; the remainder of the begin is aware that x is a boolean)
135 lines
4.0 KiB
Racket
135 lines
4.0 KiB
Racket
#lang racket/base
|
|
|
|
(require "test-utils.rkt"
|
|
rackunit racket/format
|
|
(rep prop-rep)
|
|
(types abbrev union prop-ops)
|
|
(for-syntax racket/base syntax/parse))
|
|
|
|
(provide tests)
|
|
(gen-test-main)
|
|
|
|
(define (not-implies-atomic? y x) (not (implies-atomic? y x)))
|
|
|
|
(define-syntax (test-opposite stx)
|
|
(define-syntax-class complementary
|
|
(pattern #:complementary #:with check #'check-true)
|
|
(pattern #:not-complementary #:with check #'check-false))
|
|
(define-syntax-class contradictory
|
|
(pattern #:contradictory #:with check #'check-true)
|
|
(pattern #:not-contradictory #:with check #'check-false))
|
|
(syntax-parse stx
|
|
[(_ comp:complementary contr:contradictory p1* p2*)
|
|
(syntax/loc stx
|
|
(test-case (~a '(opposite p1* p2*))
|
|
(define p1 p1*)
|
|
(define p2 p2*)
|
|
(comp.check (complementary? p1 p2) "Complementary")
|
|
(contr.check (contradictory? p1 p2) "Contradictory")))]))
|
|
|
|
|
|
(define tests
|
|
(test-suite "Props"
|
|
(test-suite "Opposite"
|
|
(test-opposite #:not-complementary #:contradictory
|
|
(-is-type 0 -Symbol)
|
|
(-not-type 0 (Un -Symbol -String)))
|
|
|
|
(test-opposite #:complementary #:not-contradictory
|
|
(-is-type 0 (Un -Symbol -String))
|
|
(-not-type 0 -Symbol))
|
|
|
|
(test-opposite #:complementary #:contradictory
|
|
(-not-type 0 -Symbol)
|
|
(-is-type 0 -Symbol))
|
|
|
|
(test-opposite #:not-complementary #:not-contradictory
|
|
(-is-type 1 -Symbol)
|
|
(-not-type 0 -Symbol))
|
|
|
|
(test-opposite #:not-complementary #:not-contradictory
|
|
(-not-type 0 -Symbol)
|
|
(-is-type 0 -String))
|
|
|
|
(test-opposite #:not-complementary #:not-contradictory
|
|
(-not-type 0 -Symbol)
|
|
(-is-type 0 -String))
|
|
|
|
(test-opposite #:not-complementary #:contradictory
|
|
-ff
|
|
-ff)
|
|
|
|
(test-opposite #:complementary #:contradictory
|
|
-ff
|
|
-tt)
|
|
|
|
(test-opposite #:complementary #:not-contradictory
|
|
-tt
|
|
-tt)
|
|
|
|
)
|
|
|
|
(test-suite "Implies Atomic"
|
|
(check implies-atomic?
|
|
-tt -tt)
|
|
(check implies-atomic?
|
|
-ff -ff)
|
|
(check implies-atomic?
|
|
-ff -tt)
|
|
(check not-implies-atomic?
|
|
-tt -ff)
|
|
(check implies-atomic?
|
|
(-is-type 0 -Symbol) -tt)
|
|
(check implies-atomic?
|
|
-ff (-is-type 0 -Symbol))
|
|
(check implies-atomic?
|
|
(-is-type 0 -Symbol)
|
|
(-is-type 0 (Un -String -Symbol)))
|
|
(check not-implies-atomic?
|
|
(-is-type 0 (Un -String -Symbol))
|
|
(-is-type 0 -Symbol))
|
|
(check implies-atomic?
|
|
(-not-type 0 (Un -String -Symbol))
|
|
(-not-type 0 -Symbol))
|
|
(check not-implies-atomic?
|
|
(-not-type 0 -Symbol)
|
|
(-not-type 0 (Un -String -Symbol)))
|
|
(check not-implies-atomic?
|
|
(-is-type 0 -Symbol)
|
|
(-is-type 1 -Symbol))
|
|
(check implies-atomic?
|
|
(-is-type #'x -Symbol)
|
|
(-is-type #'x -Symbol))
|
|
(check implies-atomic?
|
|
(-is-type #'x -Symbol)
|
|
(-or (-is-type 1 -Symbol) (-is-type #'x -Symbol)))
|
|
(check implies-atomic?
|
|
(-and (-is-type 1 -Symbol) (-is-type #'x -Symbol))
|
|
(-is-type #'x -Symbol))
|
|
(check implies-atomic?
|
|
(-is-type #'x -Symbol)
|
|
(-not-type #'x (-val #f)))
|
|
)
|
|
|
|
(test-suite "Simplification"
|
|
(check-equal?
|
|
(-and (-is-type #'x -Symbol) (-not-type #'x (-val #f)))
|
|
(-is-type #'x -Symbol))
|
|
(check-equal?
|
|
(-and (-not-type #'x (-val #f)) (-is-type #'x -Symbol))
|
|
(-is-type #'x -Symbol))
|
|
|
|
(check-equal?
|
|
(-and (-is-type #'y (-val #f))
|
|
(-or (-is-type #'y (-val #f))
|
|
(-is-type #'x (-val #f))))
|
|
(-is-type #'y (-val #f)))
|
|
|
|
(check-equal?
|
|
(-and (-not-type #'y (-val #f))
|
|
(-or (-not-type #'y (-val #f))
|
|
(-not-type #'x (-val #f))))
|
|
(-not-type #'y (-val #f))))
|
|
|
|
))
|