suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added types and tests for equality operations.

Browse Source
This commit is contained in:
Eric Dobson 2011-06-15 15:04:04 -04:00 committed by Sam Tobin-Hochstadt
parent 2d152bac79
commit c77e906c7a
3 changed files with 43 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/tests/typed-scheme/succeed/equality.rkt Normal file
View File

@ -0,0 +1,15 @@
#lang typed/racket
(boolean? true)
(boolean? (not 6))
(immutable? (cons 3 4))
(boolean=? #t false)
(symbol=? 'foo 'foo)
(false? 'foo)
(equal? 1 2)
(eqv? 1 2)
(eq? 1 2)
(equal?/recur 'foo 'bar eq?)

29
collects/typed-scheme/base-env/base-env.rkt
View File

@ -206,10 +206,29 @@
[null (-val null)] [null (-val null)]
[char? (make-pred-ty -Char)] [char? (make-pred-ty -Char)]
;Section 3.1
[boolean? (make-pred-ty B)] [boolean? (make-pred-ty B)]
[eq? (-> Univ Univ B)] [not (-> Univ B)]
[eqv? (-> Univ Univ B)]
[equal? (-> Univ Univ B)] [equal? (-> Univ Univ B)]
[eqv? (-> Univ Univ B)]
[eq? (-> Univ Univ B)]
[equal?/recur (-> Univ Univ (-> Univ Univ Univ) B)]
[immutable? (-> Univ B)]
[prop:equal+hash -Struct-Type-Property]
;; scheme/bool
[true (-val #t)]
[false (-val #f)]
[boolean=? (B B . -> . B)]
[symbol=? (Sym Sym . -> . B)]
[false? (make-pred-ty (-val #f))]
[assert (-poly (a b) (cl->* [assert (-poly (a b) (cl->*
(Univ (make-pred-ty (list a) Univ b) . -> . b) (Univ (make-pred-ty (list a) Univ b) . -> . b)
(-> (Un a (-val #f)) a)))] (-> (Un a (-val #f)) a)))]
@ -231,7 +250,7 @@
;; 1 means predicate on second argument ;; 1 means predicate on second argument
(make-pred-ty (list (make-pred-ty (list a) c d) (-lst a)) c (-lst d) 1) (make-pred-ty (list (make-pred-ty (list a) c d) (-lst a)) c (-lst d) 1)
(->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c)))] (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c)))]
[not (make-pred-ty (-val #f))]
[box (-poly (a) (a . -> . (-box a)))] [box (-poly (a) (a . -> . (-box a)))]
[unbox (-poly (a) (cl->* [unbox (-poly (a) (cl->*
((-box a) . -> . a) ((-box a) . -> . a)
@ -968,10 +987,6 @@
[tcp-connect/enable-break (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))] [tcp-connect/enable-break (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))]
[tcp-listen (-Integer [-Integer Univ (-opt -String)] . ->opt . -TCP-Listener)] [tcp-listen (-Integer [-Integer Univ (-opt -String)] . ->opt . -TCP-Listener)]
;; scheme/bool
[boolean=? (B B . -> . B)]
[symbol=? (Sym Sym . -> . B)]
[false? (make-pred-ty (-val #f))]
;; with-stx.rkt ;; with-stx.rkt
[generate-temporaries ((Un (-Syntax Univ) (-lst Univ)) . -> . (-lst (-Syntax Sym)))] [generate-temporaries ((Un (-Syntax Univ) (-lst Univ)) . -> . (-lst (-Syntax Sym)))]

6
collects/typed-scheme/types/abbrev.rkt
View File

@ -177,6 +177,12 @@
(define -Pattern (*Un -Bytes -Regexp -PRegexp -Byte-Regexp -Byte-PRegexp -String)) (define -Pattern (*Un -Bytes -Regexp -PRegexp -Byte-Regexp -Byte-PRegexp -String))
(define -Struct-Type-Property
(make-Base 'Struct-Type-Property #'struct-type-property? struct-type-property? #'Struct-Type-Property))
(define -top (make-Top)) (define -top (make-Top))
(define -bot (make-Bot)) (define -bot (make-Bot))
(define -no-filter (make-FilterSet -top -top)) (define -no-filter (make-FilterSet -top -top))