switch to typed/

original commit: 5a8fac0bdf9f4a93d2407c309c7c7110d5c029b3
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-12 11:52:11 -04:00
commit da5bdb841a
5 changed files with 13 additions and 7 deletions

View File

@ -1,4 +1,4 @@
#lang typed-scheme
#lang typed/scheme
(: convert (Number -> Syntax))
(define (convert n) (datum->syntax #f n))

View File

@ -124,7 +124,8 @@
(FAIL (-poly (a b) (-> a a)) (-poly (a b) (-> a b)))
;; polymorphic function types should be subtypes of the function top
[(-poly (a) (a . -> . a)) top-func]
[(-poly (a) (a . -> . a)) top-func]
(FAIL (-> Univ) (null Univ . ->* . Univ))
[(cl->* (-Number . -> . -String) (-Boolean . -> . -String)) ((Un -Boolean -Number) . -> . -String)]
))

View File

@ -48,4 +48,4 @@
(syntax-parse stx #:literal-sets (kernel-literals)
[(define-values ~! ids e:opt-expr)
(syntax/loc stx (define-values ids e.opt))]
[_ (printf "nothing happened") stx]))
[_ stx]))

View File

@ -34,8 +34,8 @@
(define-syntax (module-begin stx)
(define module-name (syntax-property stx 'enclosing-module-name))
;(printf "BEGIN: ~a~n" (syntax->datum stx))
(syntax-case stx ()
[(mb forms ...)
(syntax-parse stx
[(mb (~optional (~and #:optimize (~bind [opt? #'#t]))) forms ...)
(nest
([begin (set-box! typed-context? #t)
(start-timing module-name)]
@ -48,6 +48,8 @@
[infer-param infer]
;; do we report multiple errors
[delay-errors? #t]
;; do we optimize?
[optimize? (or (attribute opt?) (optimize?))]
;; this parameter is for parsing types
[current-tvars initial-tvar-env]
;; this parameter is just for printing types
@ -81,7 +83,8 @@
[with-syntax ([(transformed-body ...)
(if (optimize?)
(map optimize (syntax->list #'(transformed-body ...)))
(begin (printf "optimizing ...\n")
(map optimize (syntax->list #'(transformed-body ...))))
#'(transformed-body ...))])])
(do-time "Typechecked")
#;(printf "checked ~a~n" module-name)

View File

@ -144,6 +144,9 @@
(subtypes*/varargs t-dom s-dom s-rest)
(kw-subtypes* t-kws s-kws)
(subtype* s-rng t-rng))]
[((arr: s-dom s-rng #f #f s-kws)
(arr: t-dom t-rng t-rest #f t-kws))
(fail! s t)]
[((arr: s-dom s-rng s-rest #f s-kws)
(arr: t-dom t-rng t-rest #f t-kws))
(subtype-seq A0
@ -352,7 +355,6 @@
;(trace subtype*)
;(trace supertype-of-one/arr)
;(trace arr-subtype*/no-fail)
;(trace subtype-of-one)
;(trace subtype*/no-fail)
;(trace subtypes*)
;(trace subtype)