From 42426272c275d594922fc18fd288feae223c3404 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Fri, 1 Aug 2014 21:17:40 -0400 Subject: [PATCH] disabled signatures instead of allowing renaming because they are not working anyway (?) --- .../htdp-pkgs/htdp-lib/lang/private/teach.rkt | 67 ++++++++++--------- 1 file changed, 37 insertions(+), 30 deletions(-) diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt index a4ca0fd209..eedd9c2781 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/teach.rkt @@ -879,7 +879,7 @@ [(proc-name ...) proc-names] [(getter-id ...) getter-names]) (define defns - #`(define-values (#,signature-name #,parametric-signature-name def-proc-name ...) + #`(define-values (#;#,signature-name #,parametric-signature-name def-proc-name ...) (let () (define-values (type-descriptor raw-constructor @@ -997,13 +997,23 @@ arbs)))) sig))) - (values #,signature-name #,parametric-signature-name proc-name ...)))) + (values #;#,signature-name #,parametric-signature-name proc-name ...)))) ;; --- IN --- (stepper-syntax-property defns 'stepper-black-box-expr stx))))) ;; -------------------------------------------------------------------------------- (define struct-name-size (string-length (symbol->string (syntax-e #'name_)))) (define struct-name/locally-introduced (syntax-local-introduce #'name_)) + (define signature-name-directive + (vector (syntax-local-introduce constructor-name) + 5 + struct-name-size + struct-name/locally-introduced + 0 + struct-name-size)) + + (define parametric-signature-name-directive #f) + (define struct-name-to-maker-directive (vector (syntax-local-introduce constructor-name) 5 @@ -1064,9 +1074,6 @@ 0 field-name-size)) - (define signature-name-directive #f) - (define parametric-signature-name-directive #f) - (define all-directives (list* signature-name-directive parametric-signature-name-directive @@ -1081,34 +1088,34 @@ (define defn1 defn0) (define defn2 (quasisyntax/loc stx - (begin - #,(stepper-syntax-property - #`(define-syntaxes (name_) - (let () - (racket:define-struct info () - #:super struct:struct-info - ;; support `signature' - #:property - prop:procedure - (lambda (_ stx) - (syntax-case stx () - [(self . args) - (raise-syntax-error - #f - EXPECTED-FUNCTION-NAME - stx - #'self)] - [_ #'#,signature-name]))) - ;; support `shared' - (make-info (lambda () compile-info)))) - 'stepper-skip-completely - #t) - #,defn1))) + (begin + #,(stepper-syntax-property + #`(define-syntaxes (name_) + (let () + (racket:define-struct info () + #:super struct:struct-info + ;; support `signature' + #:property + prop:procedure + (lambda (_ stx) + (syntax-case stx () + [(self . args) + (raise-syntax-error + #f + EXPECTED-FUNCTION-NAME + stx + #'self)] + [_ #'#,signature-name]))) + ;; support `shared' + (make-info (lambda () compile-info)))) + 'stepper-skip-completely + #t) + #,defn1))) (define defn3 (check-definitions-new 'define-struct stx (list* name parametric-signature-name to-define-names) - defn2 + defn1 (and setters? bind-names))) (define defn4 (syntax-property defn3 'disappeared-use (list struct-name/locally-introduced))) @@ -3260,4 +3267,4 @@ (quickcheck:property () (ormap (lambda (cand) (teach-equal? val cand)) candidates))) (define Property - (signature (predicate (lambda (x) (or (boolean? x) (property? x)))))) \ No newline at end of file + (signature (predicate (lambda (x) (or (boolean? x) (property? x))))))