Add struct inheritance in type-environment

Use it to start adding types for a subset of
typed/racket/sandbox

original commit: b56eb4302282952bce152351ea7facbc6d73ebfc
This commit is contained in:
Asumu Takikawa 2014-10-20 22:47:28 -04:00
parent 1030f59a07
commit 33978615f1
3 changed files with 51 additions and 4 deletions

View File

@ -65,9 +65,24 @@
;; FIXME: support other struct options
(pattern [#:struct name:id ([field:id (~datum :) type:expr] ...)
(~optional (~seq #:extra-constructor-name extra:id)
#:defaults ([extra #f]))]
#:defaults ([extra #f]))
(~optional (~and (~seq #:no-provide) (~bind [provide? #f]))
#:defaults ([provide? #t]))]
#:with form #'(d-s name ([field : type] ...))
#:with outer-form #'(provide (struct-out name)))))
#:with outer-form (if (attribute provide?)
#'(provide (struct-out name))
#'(void)))
(pattern [#:struct (name:id par:id)
([field:id (~datum :) type:expr] ...)
(par-type:expr ...)
(~optional (~seq #:extra-constructor-name extra:id)
#:defaults ([extra #f]))
(~optional (~and (~seq #:no-provide) (~bind [provide? #f]))
#:defaults ([provide? #t]))]
#:with form #'(d-s (name par) ([field : type] ...) (par-type ...))
#:with outer-form (if (attribute provide?)
#'(provide (struct-out name))
#'(void)))))
(define-syntax (-#%module-begin stx)
(syntax-parse stx

View File

@ -11,10 +11,11 @@
"snip-lib"
"typed-racket-lib"
"gui-lib"
"pict-lib"))
"pict-lib"
"sandbox-lib"))
(define pkg-desc "Types for various libraries")
(define pkg-authors '(samth stamourv))
(define version "1.1")
(define version "1.1")

View File

@ -0,0 +1,31 @@
#lang s-exp typed-racket/base-env/extra-env-lang
;; This module provides a base type environment for
;; racket/sandbox
(require racket/sandbox
(for-syntax (only-in typed-racket/rep/type-rep make-ValuesDots)))
(provide exn:fail:resource?
exn:fail:resource-resource)
(type-environment
;; 14.12 Sandboxed Evaluation
;; 14.12.1 Customizing Evaluators
;; 14.12.1 Interacting with Evaluators
;; 14.12.3 Miscellaneous
[gui? -Boolean]
[call-with-limits
(-polydots (a)
(-> (-opt -Integer) (-opt -Integer)
(-> (make-ValuesDots null a 'a))
(make-ValuesDots null a 'a)))]
[call-with-deep-time-limit
(-polydots (a)
(-> (-opt -Integer)
(-> (make-ValuesDots null a 'a))
(make-ValuesDots null a 'a)))]
[#:struct (exn:fail:resource exn:fail)
([resource : (one-of/c 'time 'memory 'deep-time)])
(-String -Cont-Mark-Set)
#:no-provide])