From 45d36579d3823f024a7448ed9efc552aa90b9b0f Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Wed, 12 Feb 2014 12:11:44 -0500 Subject: [PATCH] Add :-less versions of `struct` macros --- .../typed-racket/base-env/prims.rkt | 18 ++++++++++++++---- .../typed-racket/private/with-types.rkt | 2 +- .../typed-racket-lib/typed/racket/base.rkt | 2 +- .../typed-racket/succeed/struct-no-colon.rkt | 13 +++++++++++++ 4 files changed, 29 insertions(+), 6 deletions(-) create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/struct-no-colon.rkt diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt index 7a5fa17887..d10afc2b72 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt @@ -30,6 +30,9 @@ This file defines two sorts of primitives. All of them are provided into any mod (all-from-out "top-interaction.rkt") : (rename-out [define-typed-struct define-struct:] + [define-typed-struct define-struct] + [-struct struct] + [-struct struct:] [lambda: λ:] [-lambda lambda] [-lambda λ] @@ -52,6 +55,7 @@ This file defines two sorts of primitives. All of them are provided into any mod [-do do:] [with-handlers: with-handlers] [define-typed-struct/exec define-struct/exec:] + [define-typed-struct/exec define-struct/exec] [for/annotation for] [for*/annotation for*])) @@ -572,7 +576,13 @@ This file defines two sorts of primitives. All of them are provided into any mod (define-syntax-class fld-spec #:literals (:) #:description "[field-name : type]" - (pattern [fld:id : ty])) + (pattern [fld:id : ty] + #:with form this-syntax) + (pattern fld:id + #:fail-when #t + (format "field `~a' requires a type annotation" + (syntax-e #'fld)) + #:with form 'dummy)) (define-syntax-class struct-name #:description "struct name (with optional super-struct name)" @@ -610,7 +620,7 @@ This file defines two sorts of primitives. All of them are provided into any mod ...)))) ;; User-facing macros for defining typed structure types -(define-syntaxes (define-typed-struct struct:) +(define-syntaxes (define-typed-struct -struct) (values (lambda (stx) (syntax-parse stx @@ -621,7 +631,7 @@ This file defines two sorts of primitives. All of them are provided into any mod (with-syntax ([d-s (ignore-some (syntax/loc stx (define-struct nm (fs.fld ...) . opts)))] [dtsi (quasisyntax/loc stx - (dtsi* (vars.vars ...) nm (fs ...) + (dtsi* (vars.vars ...) nm (fs.form ...) #:maker #,cname #,@mutable?))]) (if (eq? (syntax-local-context) 'top-level) @@ -651,7 +661,7 @@ This file defines two sorts of primitives. All of them are provided into any mod . opts)))] [dtsi (quasisyntax/loc stx (dtsi* (vars.vars ...) - nm.old-spec (fs ...) + nm.old-spec (fs.form ...) #,@mutable?))]) ;; see comment above (if (eq? (syntax-local-context) 'top-level) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt index b76c18f00f..17ecd50e7d 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt @@ -4,7 +4,7 @@ (for-template (except-in racket/base for for* with-handlers lambda λ define let let* letrec letrec-values let-values - let/cc let/ec do + let/cc let/ec do struct define-struct default-continuation-prompt-tag) "../base-env/prims.rkt" (prefix-in c: (combine-in racket/contract/region racket/contract/base))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed/racket/base.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed/racket/base.rkt index 465953bd98..4e30cfc8fa 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed/racket/base.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed/racket/base.rkt @@ -4,7 +4,7 @@ with-handlers default-continuation-prompt-tag define λ lambda define-struct for for* let let* let-values letrec letrec-values - let/cc let/ec do)) + let/cc let/ec do struct)) (basics #%module-begin #%top-interaction)) (require typed-racket/base-env/extra-procs diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/struct-no-colon.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/struct-no-colon.rkt new file mode 100644 index 0000000000..14856db83d --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/struct-no-colon.rkt @@ -0,0 +1,13 @@ +#lang typed/racket + +;; Test struct forms without colons. Ideally should be +;; unit tests, but these have to be at the top-level. + +(struct foo ([x : String] [y : Symbol])) +(string-append (foo-x (foo "a" 'b)) "b") +(symbol->string (foo-y (foo "a" 'b))) + +(define-struct foo2 ([x : String] [y : Symbol])) +(string-append (foo2-x (make-foo2 "a" 'b)) "b") +(symbol->string (foo2-y (make-foo2 "a" 'b))) +