From f3191ff4d680fa6664f0d51e981c6ae76d5109be Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Wed, 13 Oct 2010 09:41:10 +0200 Subject: [PATCH] Define `any' signature differently. ... to actually enable the subtyping check. Also, make named signatures work for signature variables. --- collects/deinprogramm/DMdA.rkt | 4 ++-- collects/deinprogramm/signature/signature-syntax.rkt | 4 ++-- collects/lang/private/signature-syntax.rkt | 4 ++-- collects/lang/private/teach.rkt | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/collects/deinprogramm/DMdA.rkt b/collects/deinprogramm/DMdA.rkt index 45b27321e3..9410d10372 100644 --- a/collects/deinprogramm/DMdA.rkt +++ b/collects/deinprogramm/DMdA.rkt @@ -921,8 +921,8 @@ (define symbol (signature/arbitrary arbitrary-symbol (predicate symbol?))) (define empty-list (signature (one-of empty))) -(define unspecific (signature (predicate (lambda (_) #t)))) -(define any (signature (predicate (lambda (_) #t)))) +(define unspecific (signature unspecific %unspecific)) +(define any (signature any %any)) ;; aus collects/lang/private/teach.ss diff --git a/collects/deinprogramm/signature/signature-syntax.rkt b/collects/deinprogramm/signature/signature-syntax.rkt index 226a5368af..f73075d039 100644 --- a/collects/deinprogramm/signature/signature-syntax.rkt +++ b/collects/deinprogramm/signature/signature-syntax.rkt @@ -94,10 +94,10 @@ (?id (identifier? #'?id) (with-syntax ((?stx (phase-lift stx)) - (?name name)) + (?name (or name (syntax->datum #'?id)))) (let ((name (symbol->string (syntax->datum #'?id)))) (if (char=? #\% (string-ref name 0)) - #'(make-type-variable-signature '?id ?stx) + #'(make-type-variable-signature '?name ?stx) (with-syntax ((?raise (syntax/loc #'?stx diff --git a/collects/lang/private/signature-syntax.rkt b/collects/lang/private/signature-syntax.rkt index 5936a08845..5b99bf7505 100644 --- a/collects/lang/private/signature-syntax.rkt +++ b/collects/lang/private/signature-syntax.rkt @@ -85,10 +85,10 @@ (?id (identifier? #'?id) (with-syntax ((?stx (phase-lift stx)) - (?name name)) + (?name (or name (syntax->datum #'?id)))) (let ((name (symbol->string (syntax->datum #'?id)))) (if (char=? #\% (string-ref name 0)) - #'(make-type-variable-signature '?id ?stx) + #'(make-type-variable-signature '?name ?stx) (with-syntax ((?raise #'(error 'signatures "expected a signature, found ~e" ?id))) diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt index 9506c26149..ee19d57cac 100644 --- a/collects/lang/private/teach.rkt +++ b/collects/lang/private/teach.rkt @@ -2916,9 +2916,9 @@ (define Symbol (signature/arbitrary arbitrary-symbol (predicate symbol?))) (define Empty-list (signature (one-of empty))) -(define Any (signature (predicate (lambda (_) #t)))) +(define Any (signature Any %Any)) -(define Unspecific (signature (predicate (lambda (_) #t)))) +(define Unspecific (signature Unspecific %Unspecific)) (define (cons-of car-sig cdr-sig) (make-pair-signature #t car-sig cdr-sig))