From 75c30b4e2ea75a1d4168ba377e9835ea6969a868 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 25 Dec 2018 13:15:29 -0600
Subject: [PATCH] cs: faster srcloc unmarshaling

---
 racket/src/cs/primitive/unsafe.ss |  1 +
 racket/src/cs/rumble.sls          |  1 +
 racket/src/cs/rumble/struct.ss    |  2 ++
 racket/src/schemify/serialize.rkt | 12 ++++++------
 4 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/racket/src/cs/primitive/unsafe.ss b/racket/src/cs/primitive/unsafe.ss
index 80134f44e1..1d4ff1c9cc 100644
--- a/racket/src/cs/primitive/unsafe.ss
+++ b/racket/src/cs/primitive/unsafe.ss
@@ -114,6 +114,7 @@
   [unsafe-make-place-local (known-procedure/pure 2)]
   [unsafe-make-os-semaphore (known-procedure 1)]
   [unsafe-make-security-guard-at-root (known-procedure 15)]
+  [unsafe-make-srcloc (known-procedure/pure 32)]
   [unsafe-mcar (known-procedure 2)]
   [unsafe-mcdr (known-procedure 2)]
   [unsafe-mutable-hash-iterate-first (known-procedure 2)]
diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls
index d947dfa958..b2f6d8812a 100644
--- a/racket/src/cs/rumble.sls
+++ b/racket/src/cs/rumble.sls
@@ -116,6 +116,7 @@
           struct:srcloc srcloc srcloc?
           srcloc-source srcloc-line srcloc-column srcloc-position srcloc-span
           prop:exn:srclocs exn:srclocs? exn:srclocs-accessor
+          unsafe-make-srcloc
 
           struct:date date? date make-date
           date-second date-minute date-hour date-day date-month date-year
diff --git a/racket/src/cs/rumble/struct.ss b/racket/src/cs/rumble/struct.ss
index 7185740485..977c34a96f 100644
--- a/racket/src/cs/rumble/struct.ss
+++ b/racket/src/cs/rumble/struct.ss
@@ -1153,6 +1153,7 @@
                         (datum->syntax id
                                        (string->symbol (chez:apply format fmt args))))])
          (with-syntax ([struct:name (make-id #'name "struct:~a" (syntax->datum #'name))]
+                       [unsafe-make-name (make-id #'name "unsafe-make-~a" (syntax->datum #'name))]
                        [authentic-name? (make-id #'name "authentic-~a?" (syntax->datum #'name))]
                        [name? (make-id #'name "~a?" (syntax->datum #'name))]
                        [(name-field ...) (map (lambda (field)
@@ -1172,6 +1173,7 @@
                          [uid (datum->syntax #'name ((current-generate-id) (syntax->datum #'name)))])
              #'(begin
                  (define struct:name (make-record-type-descriptor 'name struct:parent 'uid #f #f '#((immutable field) ...)))
+                 (define unsafe-make-name (record-constructor (make-record-constructor-descriptor struct:name #f #f)))
                  (define name ctr-expr)
                  (define authentic-name? (record-predicate struct:name))
                  (define name? (lambda (v) (or (authentic-name? v)
diff --git a/racket/src/schemify/serialize.rkt b/racket/src/schemify/serialize.rkt
index bfb401f04e..1a7bdba206 100644
--- a/racket/src/schemify/serialize.rkt
+++ b/racket/src/schemify/serialize.rkt
@@ -154,12 +154,12 @@
            [(regexp? q)
             `(,(if (pregexp? q) 'pregexp 'regexp) ,(object-name q))]
            [(srcloc? q)
-            `(#%app srcloc
-                    ,(make-construct (srcloc-source q))
-                    ,(make-construct (srcloc-line q))
-                    ,(make-construct (srcloc-column q))
-                    ,(make-construct (srcloc-position q))
-                    ,(make-construct (srcloc-span q)))]
+            `(unsafe-make-srcloc
+              ,(make-construct (srcloc-source q))
+              ,(make-construct (srcloc-line q))
+              ,(make-construct (srcloc-column q))
+              ,(make-construct (srcloc-position q))
+              ,(make-construct (srcloc-span q)))]
            [(byte-regexp? q)
             `(,(if (byte-pregexp? q) 'byte-pregexp 'byte-regexp) ,(object-name q))]
            [(keyword? q)