switch to typed/
original commit: 5a8fac0bdf9f4a93d2407c309c7c7110d5c029b3
This commit is contained in:
commit
da5bdb841a
|
@ -1,4 +1,4 @@
|
|||
#lang typed-scheme
|
||||
#lang typed/scheme
|
||||
|
||||
(: convert (Number -> Syntax))
|
||||
(define (convert n) (datum->syntax #f n))
|
||||
|
|
|
@ -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)]
|
||||
))
|
||||
|
|
|
@ -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]))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user