feat: 9.5.9

s/types.ss

@@ -0,0 +1,111 @@
+;;; types.ss
+;;; Copyright 1984-2017 Cisco Systems, Inc.
+;;; 
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;; 
+;;; http://www.apache.org/licenses/LICENSE-2.0
+;;; 
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; annotation fields are mutable so that the reader can handle
+;;; cycles involving annotated data
+(define-record-type annotation
+  (fields (mutable expression) (mutable source) (mutable stripped) (mutable flags))
+  (nongenerative #{annotation bc6o9md359cw9ds5-b})
+  (sealed #t)
+  (protocol
+    (lambda (new)
+      (case-lambda
+        [(expression source stripped) (new expression source stripped (fxlogor (constant annotation-debug) (constant annotation-profile)))]
+        [(expression source stripped flags) (new expression source stripped flags)]))))
+
+(define-record-type source
+  (fields (immutable sfd) (immutable bfp) (immutable efp))
+  (nongenerative #{source gbwctw0mahurbuiegp7uq3-0}))
+
+(define-record-type source-2d
+  (parent source)
+  (fields (immutable line) (immutable column))
+  (nongenerative #{source-2d gbwctw0mahurbuiegp7uq3-2})
+  (sealed #t))
+
+(define-record-type source-file-descriptor
+  (fields (immutable name) (immutable length) (immutable crc))
+  (nongenerative #{source-file-descriptor bdbv4s3hk5ja7rql-a})
+  (sealed #t))
+
+(define-record-type syntax-object
+  (fields (immutable expression) (immutable wrap))
+  (nongenerative #{syntax-object bdehkef6almh6ypb-a})
+  (sealed #t))
+
+(define-syntax syntax-object-rtd
+  (identifier-syntax (type-descriptor syntax-object)))
+
+(define-record-type code-info
+  (fields
+    (immutable src)
+    (immutable sexpr)
+    (immutable free)    ; vector of elts, elt = symbols #f
+    (immutable live)    ; vector of pairs each mapping a symbol or pair of symbols to an index
+    (immutable rpis))   ; vector of rp-infos
+  (nongenerative #{code-info gr886ae7iuw4wt9ft4vxym-2})
+  (sealed #t))
+
+(define-record-type rp-info
+  (fields (immutable offset) (immutable src) (immutable sexpr) (immutable mask))
+  (nongenerative #{rp-info gr886ae7iuw4wt9ft4vxym-1})
+  (sealed #t))
+
+(define cpsymbol '#{closure cedozdf6uqtmcjjt-2})
+
+; block profiling record
+(define-record-type rblock
+  (fields (immutable srecs) (immutable op))
+  (nongenerative #{rblock bt50nyec0orotoeb-0})
+  (sealed #t))
+
+(define-record-type static-closure-info
+  (nongenerative #{static-closure-info cv84l52b3ghjjuqa-0})
+  (sealed #t)
+  (fields
+    (mutable raw-closure-count)
+    (mutable raw-free-var-count)
+    (mutable wk-borrowed-count)
+    (mutable wk-empty-count)
+    (mutable wk-single-count)
+    (mutable wk-pair-count)
+    (mutable wk-vector-count)
+    (mutable wk-vector-free-var-count)
+    (mutable nwk-empty-count)
+    (mutable nwk-closure-count)
+    (mutable nwk-closure-free-var-count))
+  (protocol
+    (lambda (new)
+      (lambda ()
+        (new 0 0 0 0 0 0 0 0 0 0 0)))))
+
+#;(define-record-type profile-counter
+    (fields (mutable uptr count)) ; sadly, can't specify the type
+    (nongenerative #{profile-counter b5vnnom9h4o4uny0-2})
+    (sealed #t)
+    (protocol (lambda (new) (lambda () (new 0)))))
+(let-syntax ([a (lambda (x)
+                  (syntax-case x ()
+                    [(_ profile-counter? make-profile-counter profile-counter-count profile-counter-count-set!)
+                     (let ([rtd ($make-record-type #!base-rtd #f
+                                  '#{profile-counter b5vnnom9h4o4uny0-2}
+                                  '((mutable uptr count))
+                                  #t #f)])
+                       #`(begin
+                           (define make-profile-counter (record-constructor '#,rtd))
+                           (define profile-counter? (record-predicate '#,rtd))
+                           (define profile-counter-count (record-accessor '#,rtd 0))
+                           (define profile-counter-count-set! (record-mutator '#,rtd 0))))]))])
+  (a profile-counter? make-profile-counter profile-counter-count profile-counter-count-set!))