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

Add :-less versions of struct macros

Browse Source
This commit is contained in:
Asumu Takikawa 2014-02-12 12:11:44 -05:00
parent a941f95c2e
commit 45d36579d3
4 changed files with 29 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
View File

@ -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)

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt
View File

@ -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)))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed/racket/base.rkt
View File

@ -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

13
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/struct-no-colon.rkt Normal file
View File

@ -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)))