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

Enforce method types as function types in parsing

Browse Source 
original commit: 0d498e18e7c6284a87797e7491906523ca641fe1
This commit is contained in:
Asumu Takikawa 2013-07-09 13:37:43 -04:00
parent 707de1ef68
commit 1722644560
2 changed files with 25 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt
View File

@ -653,6 +653,7 @@
(define methods (map list
(stx-map syntax-e #'clause.method-names)
(stx-map parse-type #'clause.method-types)))
(check-function-types methods)
(make-Instance (make-Class #f null fields methods null))]))
;; Syntax -> Type
@ -671,6 +672,9 @@
(and (attribute clause.row-var)
(parse-type (attribute clause.row-var))))
(check-function-types given-methods)
(check-function-types given-augments)
;; merge with all given parent types, erroring if needed
(define-values (row-var fields methods augments)
(for/fold ([row-var given-row-var]
@ -694,6 +698,24 @@
class-type]))
;; check-function-types : Dict<Name, Type> -> Void
;; ensure all types recorded in the dictionary are function types
(define (check-function-types method-types)
;; TODO: this function should probably go in a utility
;; module since it's duplicated elsewhere
(define (function-type? type)
(match (resolve type)
[(? Function?) #t]
[(Poly: _ body) (function-type? body)]
[(PolyDots: _ body) (function-type? body)]
[(PolyRow: _ _ body) (function-type? body)]
[_ #f]))
(for ([(id pre-type) (in-dict method-types)])
(define type (car pre-type))
(unless (function-type? type)
(tc-error "method ~a must have a function type, given ~a"
id type))))
;; check-constraints : Dict<Name, _> Listof<Name> -> Void
;; helper to check if the constraints are consistent with the type
(define (check-constraints type-table constraint-names)

3
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
View File

@ -222,6 +222,8 @@
[FAIL (Class [x UNBOUND])]
[FAIL (Class [x Number #:random-keyword])]
[FAIL (Class (random-clause [x Number]))]
[FAIL (Class [m Number])]
[FAIL (Class (augment [m Number]))]
;; test duplicates
[FAIL (Class [x Number] [x Number])]
[FAIL (Class (init [x Number]) (init [x Number]))]
@ -290,6 +292,7 @@
[FAIL (Object [x Number] [x Number])]
[FAIL (Object (field [x Number]) (field [x Number]))]
[FAIL (Object [x Number] [x Number])]
[FAIL (Object [m Number])]
;; Test row polymorphic types
[(All (r #:row) ((Class #:row-var r) -> (Class #:row-var r)))
(-polyrow (r) (list null null null null)