From d22cdbcee19aaf76304b3c1fa20e52f1826f84ae Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Mon, 15 Mar 2010 08:57:41 +0000 Subject: [PATCH 1/2] Add handling of by-name inits to commented-out class/c use in typed-scheme. Also, fix class/c section of reference slightly by mentioning the role of external contracts in class instantiation. svn: r18542 original commit: 5a488ae7cbf9f973cf89169f5557c12e355a3f39 --- collects/typed-scheme/private/type-contract.ss | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/collects/typed-scheme/private/type-contract.ss b/collects/typed-scheme/private/type-contract.ss index 081fbd5f..f7566cb4 100644 --- a/collects/typed-scheme/private/type-contract.ss +++ b/collects/typed-scheme/private/type-contract.ss @@ -151,13 +151,15 @@ [(names ...) name]) #'(object/c (names fcn-cnts) ...))] ;; init args not currently handled by class/c - [(Class: _ _ (list (list name fcn) ...)) + [(Class: _ (list (list by-name-init by-name-init-ty _) ...) (list (list name fcn) ...)) (when flat? (exit (fail))) - (with-syntax ([(fcn-cnts ...) (for/list ([f fcn]) (t->c/fun f #:method #t))] - [(names ...) name]) + (with-syntax ([(fcn-cnt ...) (for/list ([f fcn]) (t->c/fun f #:method #t))] + [(name ...) name] + [(by-name-cnt ...) (for/list ([t by-name-init-ty]) (t->c/neg t))] + [(by-name-init ...) by-name-init]) #'class? #; - #'(class/c (names fcn-cnts) ...))] + #'(class/c (name fcn-cnt) ... (init [by-name-init by-name-cnt] ...)))] [(Value: '()) #'null?] [(Struct: nm par flds proc poly? pred? cert acc-ids) (cond From 7387b328253487c44074f828aa04442f0941fc5c Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Mon, 15 Mar 2010 09:04:10 +0000 Subject: [PATCH 2/2] Need scheme/class's init for use in class/c form. svn: r18543 original commit: bf56a108fe3c3f05976223dd81dbbf5b80baed33 --- collects/typed-scheme/private/type-contract.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/typed-scheme/private/type-contract.ss b/collects/typed-scheme/private/type-contract.ss index f7566cb4..7cf4c810 100644 --- a/collects/typed-scheme/private/type-contract.ss +++ b/collects/typed-scheme/private/type-contract.ss @@ -15,7 +15,7 @@ scheme/match syntax/struct syntax/stx mzlib/trace unstable/syntax scheme/list (only-in scheme/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c) (for-template scheme/base scheme/contract unstable/poly-c (utils any-wrap) - (only-in scheme/class object% is-a?/c subclass?/c object-contract class/c object/c class?))) + (only-in scheme/class object% is-a?/c subclass?/c object-contract class/c init object/c class?))) (define (define/fixup-contract? stx) (or (syntax-property stx 'typechecker:contract-def)