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

Base type environment now checks for duplicate types.

Browse Source 
original commit: 88ce4e281c6b96d0e0602c6210fee7c2d1babf00
This commit is contained in:
Eric Dobson 2011-06-06 13:54:44 -04:00 committed by Vincent St-Amour
parent f936f3560d
commit 083295f4e3
3 changed files with 24 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/typed-scheme/base-env/base-env-numeric.rkt
View File

@ -1812,18 +1812,24 @@
[unsafe-fl< fl<-type]
[unsafe-flmin flmin-type]
[unsafe-flmax flmax-type]
[unsafe-flround flround-type]
[unsafe-flfloor flfloor-type]
[unsafe-flceiling flceiling-type]
[unsafe-fltruncate flround-type]
[unsafe-flsin fl-unop]
[unsafe-flcos fl-unop]
[unsafe-fltan fl-unop]
[unsafe-flatan fl-unop]
[unsafe-flasin fl-unop]
[unsafe-flacos fl-unop]
[unsafe-fllog fllog-type]
[unsafe-flexp flexp-type]
;These are currently the same binding as the safe versions
;and so are not needed. If this changes they should be
;uncommented.
;
;[unsafe-flround flround-type]
;[unsafe-flfloor flfloor-type]
;[unsafe-flceiling flceiling-type]
;[unsafe-fltruncate flround-type]
;[unsafe-flsin fl-unop]
;[unsafe-flcos fl-unop]
;[unsafe-fltan fl-unop]
;[unsafe-flatan fl-unop]
;[unsafe-flasin fl-unop]
;[unsafe-flacos fl-unop]
;[unsafe-fllog fllog-type]
;[unsafe-flexp flexp-type]
;
[unsafe-flsqrt flsqrt-type]
[unsafe-fx->fl fx->fl-type]
[unsafe-make-flrectangular make-flrectangular-type]

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

@ -208,7 +208,6 @@
;; 1 means predicate on second argument
(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)))]
[newline (->opt [-Output-Port] -Void)]
[not (-> Univ B)]
[box (-poly (a) (a . -> . (-box a)))]
[unbox (-poly (a) (cl->*
@ -292,7 +291,7 @@
[namespace-variable-value (Sym [Univ (-opt (-> Univ)) -Namespace] . ->opt . Univ)]
[match:error (Univ . -> . (Un))]
;[match:error (Univ . -> . (Un))]
[match-equality-test (-Param (Univ Univ . -> . Univ) (Univ Univ . -> . Univ))]
[matchable? (make-pred-ty (Un -String -Bytes))]
[display (Univ [-Output-Port] . ->opt . -Void)]
@ -448,7 +447,6 @@
[make-parameter (-poly (a b) (cl-> [(a) (-Param a a)]
[(b (a . -> . b)) (-Param a b)]))]
[current-directory (-Param -Pathlike -Path)]
[current-namespace (-Param -Namespace -Namespace)]
[print-struct (-Param B B)]
[read-decimal-as-inexact (-Param B B)]
[current-command-line-arguments (-Param (-vec -String) (-vec -String))]
@ -462,9 +460,6 @@
[pregexp (-String . -> . -PRegexp)]
[byte-regexp (-Bytes . -> . -Byte-Regexp)]
[byte-pregexp (-Bytes . -> . -Byte-PRegexp)]
[regexp-quote (cl->*
(-String [-Boolean] . ->opt . -String)
(-Bytes [-Boolean] . ->opt . -Bytes))]
[regexp-match-exact?
(-Pattern (Un -String -Bytes -Input-Port) . -> . B)]
@ -645,7 +640,6 @@
[hash-set (-poly (a b) ((-HT a b) a b . -> . (-HT a b)))]
[hash-set! (-poly (a b) ((-HT a b) a b . -> . -Void))]
[hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]
[hash-ref (-poly (a b c)
(cl-> [((-HT a b) a) b]
[((-HT a b) a (-> c)) (Un b c)]))]
@ -740,14 +734,14 @@
[-Input-Port . -> . (Un -Byte (-val eof))])]
[make-pipe
(cl->* [->opt [N] (-values (list -Input-Port -Output-Port))])]
[open-output-string
([Univ] . ->opt . -Output-Port)]
[open-output-bytes
(cl->* [[Univ] . ->opt . -Output-Port])]
([Univ] . ->opt . -Output-Port)]
[get-output-bytes (-Output-Port [Univ N N] . ->opt . -Bytes)]
[char-ready? (->opt [-Input-Port] B)]
[byte-ready? (->opt [-Input-Port] B)]
[open-output-string (-> -Output-Port)]
[open-output-bytes (-> -Output-Port)]
;; FIXME - this is too general
[get-output-string (-> -Output-Port -String)]
@ -1141,4 +1135,4 @@
; syntax/stx (needed for `with-syntax')
[stx->list (-> (-Syntax Univ) (-lst (-Syntax Univ)))]
[stx-list? (-> (-Syntax Univ) -Boolean)]
[stx-list? (-> (-Syntax Univ) -Boolean)]

2
collects/typed-scheme/env/init-envs.rkt vendored
View File

@ -16,7 +16,7 @@
(for-each (lambda (nm/ty) (register-resolved-type-alias (car nm/ty) (cadr nm/ty))) initial-type-names))
(define (initialize-type-env initial-env)
(for-each (lambda (nm/ty) (register-type (car nm/ty) (cadr nm/ty))) initial-env))
(for-each (lambda (nm/ty) (register-type-if-undefined (car nm/ty) (cadr nm/ty))) initial-env))
(define (converter v basic sub)
(define (gen-constructor sym)