From 33978615f16f7ea71412ef0df37b5bcd35d9acbd Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Mon, 20 Oct 2014 22:47:28 -0400
Subject: [PATCH] Add struct inheritance in type-environment

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

original commit: b56eb4302282952bce152351ea7facbc6d73ebfc
---
 .../typed-racket/base-env/extra-env-lang.rkt  | 19 ++++++++++--
 .../typed-racket-more/info.rkt                |  5 +--
 .../typed/racket/sandbox.rkt                  | 31 +++++++++++++++++++
 3 files changed, 51 insertions(+), 4 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/sandbox.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/extra-env-lang.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/extra-env-lang.rkt
index f58ef004..652ef36f 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/extra-env-lang.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/extra-env-lang.rkt
@@ -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
diff --git a/pkgs/typed-racket-pkgs/typed-racket-more/info.rkt b/pkgs/typed-racket-pkgs/typed-racket-more/info.rkt
index ba4b1f59..7926e1ce 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-more/info.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-more/info.rkt
@@ -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")
\ No newline at end of file
+(define version "1.1")
diff --git a/pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/sandbox.rkt b/pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/sandbox.rkt
new file mode 100644
index 00000000..6b96c83e
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/sandbox.rkt
@@ -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])