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

Make tc-app-object use a real dictionary.

Browse Source
This commit is contained in:
Eric Dobson 2013-05-25 13:32:57 -07:00
parent c851fad6bc
commit e54e67fc29
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/typed-racket/typecheck/tc-app/tc-app-objects.rkt
View File

@ -4,7 +4,7 @@
"signatures.rkt" "signatures.rkt"
"utils.rkt" "utils.rkt"
syntax/parse syntax/stx racket/match unstable/sequence unstable/syntax syntax/parse syntax/stx racket/match unstable/sequence unstable/syntax
syntax/parse/experimental/reflect syntax/parse/experimental/reflect racket/dict
(typecheck signatures tc-funapp) (typecheck signatures tc-funapp)
(types abbrev union utils) (types abbrev union utils)
(rep type-rep) (rep type-rep)
@ -32,7 +32,7 @@
;; (it's just an s-expression) ;; (it's just an s-expression)
(define (check-do-make-object b cl pos-args names named-args) (define (check-do-make-object b cl pos-args names named-args)
(let* ([names (stx-map syntax-e names)] (let* ([names (stx-map syntax-e names)]
[name-assoc (stx-map list names named-args)]) [name-assoc (stx-map cons names named-args)])
(let loop ([t (tc-expr cl)]) (let loop ([t (tc-expr cl)])
(match t (match t
[(tc-result1: (? Mu? t*)) (loop (ret (unfold t*)))] [(tc-result1: (? Mu? t*)) (loop (ret (unfold t*)))]
@ -53,12 +53,12 @@
n (stringify tnames))) n (stringify tnames)))
(for-each (match-lambda (for-each (match-lambda
[(list tname tfty opt?) [(list tname tfty opt?)
(let ([s (cond [(assq tname name-assoc) => cadr] (let ([s (dict-ref name-assoc tname
[(not opt?) (lambda ()
(tc-error/delayed "value not provided for named init arg ~a" (unless opt?
tname) (tc-error/delayed "value not provided for named init arg ~a"
#f] tname))
[else #f])]) #f))])
(if s (if s
;; this argument was present ;; this argument was present
(tc-expr/check s (ret tfty)) (tc-expr/check s (ret tfty))