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

Fix bug in init-envs (need to generate Rows too)

Browse Source 
Also simplified Class case a bit
This commit is contained in:
Asumu Takikawa 2016-06-22 17:45:10 -04:00
parent 3c616f480a
commit ee02c26020
2 changed files with 29 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
typed-racket-lib/typed-racket/env/init-envs.rkt vendored
View File

@ -267,20 +267,19 @@
`(quote ,n)))
(quote ,c)
,(type->sexp b))]
[(Row: inits fields methods augments init-rest)
`(make-Row (list ,@(convert-row-clause inits #t))
(list ,@(convert-row-clause fields))
(list ,@(convert-row-clause methods))
(list ,@(convert-row-clause augments))
,(and init-rest (type->sexp init-rest)))]
[(Class: row inits fields methods augments init-rest)
(define (convert members [inits? #f])
(for/list ([m members])
`(list (quote ,(car m))
,(type->sexp (cadr m))
,@(if inits? (cddr m) '()))))
(define class-type
`(make-Class ,(and row (type->sexp row))
(list ,@(convert inits #t))
(list ,@(convert fields))
(list ,@(convert methods))
(list ,@(convert augments))
,(and init-rest (type->sexp init-rest))))
class-type]
`(make-Class ,(and row (type->sexp row))
(list ,@(convert-row-clause inits #t))
(list ,@(convert-row-clause fields))
(list ,@(convert-row-clause methods))
(list ,@(convert-row-clause augments))
,(and init-rest (type->sexp init-rest)))]
[(Instance: ty) `(make-Instance ,(type->sexp ty))]
[(Signature: name extends mapping)
(define (serialize-mapping m)
@ -323,6 +322,13 @@
;; are not
[(StructTop: name) `(make-StructTop ,(type->sexp name))]))
;; Helper for class/row clauses
(define (convert-row-clause members [inits? #f])
(for/list ([m members])
`(list (quote ,(car m))
,(type->sexp (cadr m))
,@(if inits? (cddr m) '()))))
;; Prop -> Sexp
;; Convert a prop to an s-expression
(define (prop->sexp prop)

10
typed-racket-test/unit-tests/init-env-tests.rkt
View File

@ -48,5 +48,15 @@
(convert (make-StructTop (make-Struct #'foo #f null #f #f #'foo?)))
'(make-StructTop
(make-Struct (quote-syntax foo) #f (list) #f #f (quote-syntax foo?))))
(check-equal?
(convert (make-Row null null null null #f))
'(make-Row (list) (list) (list) (list) #f))
(check-equal?
(convert (make-Row (list (list 'foo -String #t))
(list (list 'bar -String))
null null #f))
'(make-Row (list (list 'foo -String #t))
(list (list 'bar -String))
(list) (list) #f))
)
))