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

cs: faster srcloc unmarshaling

Browse Source
This commit is contained in:
Matthew Flatt 2018-12-25 13:15:29 -06:00
parent 885464c2ff
commit 75c30b4e2e
4 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
racket/src/cs/primitive/unsafe.ss
View File

@ -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)]

1
racket/src/cs/rumble.sls
View File

@ -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

2
racket/src/cs/rumble/struct.ss
View File

@ -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)

12
racket/src/schemify/serialize.rkt
View File

@ -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)