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

Make struct: work at the REPL

Browse Source 
Closes PR 11669

(cherry picked from commit ebc6a6618e)
This commit is contained in:
Asumu Takikawa 2013-06-25 10:03:02 -04:00 committed by Ryan Culpepper
parent d6acbce609
commit c4b47ffc2e
3 changed files with 49 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/typed-racket/succeed/pr11669.rkt Normal file
View File

@ -0,0 +1,16 @@
#lang racket/load
(require typed/racket)
;; Test that struct: and define-struct: work at the
;; top-level.
;;
;; Test for PR 11669
(struct: Foo ([x : Integer]))
(define-struct: Bar ([y : Foo]))
(define-type Qux (U String Integer))
(struct: Quux ([qux : Qux]))
Quux-qux
Foo
make-Bar

24
collects/typed-racket/base-env/prims.rkt
View File

@ -569,7 +569,23 @@ This file defines two sorts of primitives. All of them are provided into any mod
[dtsi (quasisyntax/loc stx
(dtsi* (vars.vars ...) nm (fs ...)
#,@mutable?))])
#'(begin d-s dtsi)))]))
(if (eq? (syntax-local-context) 'top-level)
;; Use `eval` at top-level to avoid an unbound id error
;; from dtsi trying to look at the d-s bindings.
#'(begin (eval (quote-syntax d-s))
;; It is important here that the object under the
;; eval is a quasiquoted literal in order
;; for #%top-interaction to get the lexical
;; information for TR's actual #%top-interaction.
;; This effectively lets us invoke the type-checker
;; dynamically.
;;
;; The quote-syntax is also important because we want
;; the `dtsi` to have the lexical information from
;; this module. This ensures that the `dtsi` macro
;; is actually bound to its definition above.
(eval `(#%top-interaction . ,(quote-syntax dtsi))))
#'(begin d-s dtsi))))]))
(lambda (stx)
(syntax-parse stx
[(_ vars:maybe-type-vars nm:struct-name/new (fs:fld-spec ...)
@ -586,7 +602,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
nm.old-spec (fs ...)
#:maker #,cname
#,@mutable?))])
#'(begin d-s dtsi)))]))))
;; see comment above
(if (eq? (syntax-local-context) 'top-level)
#'(begin (eval (quote-syntax d-s))
(eval `(#%top-interaction . ,(quote-syntax dtsi))))
#'(begin d-s dtsi))))]))))
;Copied from racket/private/define-struct

11
collects/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -420,8 +420,19 @@
(begin0 (values #f (or result (void)))
(report-all-errors))]
[_
;; Handle type aliases
(when ((internal-syntax-pred define-type-alias-internal) form)
((compose register-type-alias parse-type-alias) form))
;; Handle struct definitions
(when ((internal-syntax-pred define-typed-struct-internal) form)
(define name (name-of-struct form))
(define tvars (type-vars-of-struct form))
(register-type-name name)
(add-constant-variance! name tvars)
(define parsed (parse-define-struct-internal form))
(register-parsed-struct-sty! parsed)
(refine-struct-variance! (list parsed))
(register-parsed-struct-bindings! parsed))
(tc-toplevel/pass1 form)
(begin0 (values #f (tc-toplevel/pass2 form))
(report-all-errors))]))