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

racket/fasl: support unsafe-undefined

Browse Source 
Since a literal unsafe-undefined can be serialized in compiled code,
support in fasl.
This commit is contained in:
Matthew Flatt 2019-07-11 05:09:39 -06:00
parent e6922e76ea
commit bad64945e7
3 changed files with 73 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-test-core/tests/racket/fasl.rktl
View File

@ -209,4 +209,7 @@
[current-load-relative-directory #f])
(fasl->s-exp (s-exp->fasl (build-path root 'same))))))
(test (list (dynamic-require 'racket/unsafe/undefined 'unsafe-undefined))
fasl->s-exp (s-exp->fasl (list (dynamic-require 'racket/unsafe/undefined 'unsafe-undefined))))
(report-errs)

10
racket/collects/racket/fasl.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require '#%extfl
racket/linklet
racket/unsafe/undefined
(for-syntax racket/base)
"private/truncate-path.rkt"
"private/relative-path.rkt"
@ -95,10 +96,9 @@
(fasl-immutable-hash-type 37)
(fasl-srcloc-type 38)
(fasl-extflonum-type 39)
(fasl-correlated-type 40)
(fasl-undefined-type 41)
;; Unallocated numbers here are for future extensions
@ -350,8 +350,10 @@
(correlated-span v)))
(loop (for/list ([k (in-list (correlated-property-symbol-keys v))])
(cons k (correlated-property v k))))]
[(eq? v unsafe-undefined)
(write-byte fasl-undefined-type o)]
[else
(raise-arguments-error 'fasl-write
(raise-arguments-error 's-exp->fasl
"cannot write value"
"value" v)]))
(get-output-bytes o #t)))
@ -501,6 +503,8 @@
(srcloc-span s))))
(for/fold ([c c]) ([p (in-list (loop))])
(correlated-property c (car p) (cdr p)))]
[(fasl-undefined-type)
unsafe-undefined]
[else
(cond
[(type . >= . fasl-small-integer-start)

116
racket/src/racket/src/startup.inc
View File

@ -18147,6 +18147,7 @@ static const char *startup_source =
"(define-values(fasl-srcloc-type) 38)"
"(define-values(fasl-extflonum-type) 39)"
"(define-values(fasl-correlated-type) 40)"
"(define-values(fasl-undefined-type) 41)"
"(define-values(fasl-small-integer-start) 100)"
"(define-values(fasl-lowest-small-integer) -10)"
"(define-values(fasl-highest-small-integer)(- 255(- fasl-small-integer-start fasl-lowest-small-integer) 1))"
@ -19049,12 +19050,19 @@ static const char *startup_source =
" for-loop_0)"
" null"
" lst_0)))))))"
"(if(eq?"
" v_1"
" unsafe-undefined)"
"(let-values()"
"(1/write-byte"
" fasl-undefined-type"
" o_1))"
"(let-values()"
"(raise-arguments-error"
" 'fasl-write"
" \"cannot write value\""
" \"value\""
" v_1))))))))))))))))))))))))))))))))))"
" 's-exp->fasl"
" \"cannot write value\""
" \"value\""
" v_1)))))))))))))))))))))))))))))))))))"
" loop_0)"
" v_0)"
"(get-output-bytes o_1 #t)))))"
@ -19102,7 +19110,7 @@ static const char *startup_source =
"(let-values(((index_0)"
"(if(fixnum-for-every-system? tmp_0)"
"(if(if(unsafe-fx>= tmp_0 1)"
"(unsafe-fx< tmp_0 41)"
"(unsafe-fx< tmp_0 42)"
" #f)"
"(let-values(((tbl_0)"
" '#(1"
@ -19144,11 +19152,12 @@ static const char *startup_source =
" 37"
" 38"
" 11"
" 39)))"
" 39"
" 40)))"
"(unsafe-vector*-ref tbl_0(unsafe-fx- tmp_0 1)))"
" 0)"
" 0)))"
"(if(unsafe-fx< index_0 19)"
"(if(unsafe-fx< index_0 20)"
"(if(unsafe-fx< index_0 9)"
"(if(unsafe-fx< index_0 4)"
"(if(unsafe-fx< index_0 1)"
@ -19190,18 +19199,18 @@ static const char *startup_source =
"(if(unsafe-fx< index_0 8)"
"(let-values() eof)"
"(let-values()(intern_0(read-fasl-integer i_0)))))))"
"(if(unsafe-fx< index_0 13)"
"(if(unsafe-fx< index_0 14)"
"(if(unsafe-fx< index_0 11)"
"(if(unsafe-fx< index_0 10)"
"(let-values()"
"(floating-point-bytes->real"
"(read-bytes/exactly 8 i_0)"
" #f))"
"(if(unsafe-fx< index_0 11)"
"(let-values()"
"(real->single-flonum"
"(floating-point-bytes->real"
"(read-bytes/exactly 4 i_0)"
" #f)))"
" #f))))"
"(if(unsafe-fx< index_0 12)"
"(let-values()"
"(let-values(((bstr_0)"
@ -19212,41 +19221,41 @@ static const char *startup_source =
"(bytes->string/utf-8 bstr_0)"
" 10"
" 'read)))"
"(let-values()(intern_0(/(loop_0)(loop_0)))))))"
"(if(unsafe-fx< index_0 15)"
"(if(unsafe-fx< index_0 14)"
"(if(unsafe-fx< index_0 13)"
"(let-values()(intern_0(/(loop_0)(loop_0))))"
"(let-values()"
"(intern_0(make-rectangular(loop_0)(loop_0))))"
"(let-values()"
"(intern_0(integer->char(read-fasl-integer i_0)))))"
"(intern_0(make-rectangular(loop_0)(loop_0)))))))"
"(if(unsafe-fx< index_0 16)"
"(let-values()(string->symbol(read-fasl-string i_0)))"
"(if(unsafe-fx< index_0 15)"
"(let-values()"
"(intern_0(integer->char(read-fasl-integer i_0))))"
"(let-values()(string->symbol(read-fasl-string i_0))))"
"(if(unsafe-fx< index_0 17)"
"(let-values()"
"(string->unreadable-symbol(read-fasl-string i_0)))"
"(if(unsafe-fx< index_0 18)"
"(let-values()"
"(string->uninterned-symbol"
"(read-fasl-string i_0)))"
"(string->uninterned-symbol(read-fasl-string i_0)))"
"(if(unsafe-fx< index_0 19)"
"(let-values()"
"(string->keyword(read-fasl-string i_0)))))))))"
"(if(unsafe-fx< index_0 29)"
"(if(unsafe-fx< index_0 23)"
"(if(unsafe-fx< index_0 20)"
"(let-values()(read-fasl-string i_0))"
"(string->keyword(read-fasl-string i_0)))"
"(let-values()(read-fasl-string i_0))))))))"
"(if(unsafe-fx< index_0 30)"
"(if(unsafe-fx< index_0 24)"
"(if(unsafe-fx< index_0 21)"
"(let-values()"
"(intern_0"
"(string->immutable-string(read-fasl-string i_0))))"
"(if(unsafe-fx< index_0 22)"
"(let-values()(read-fasl-bytes i_0))"
"(if(unsafe-fx< index_0 23)"
"(let-values()"
"(intern_0"
"(bytes->immutable-bytes(read-fasl-bytes i_0)))))))"
"(if(unsafe-fx< index_0 25)"
"(if(unsafe-fx< index_0 24)"
"(bytes->immutable-bytes(read-fasl-bytes i_0))))"
"(let-values()"
"(bytes->path(read-fasl-bytes i_0)(loop_0)))"
"(bytes->path(read-fasl-bytes i_0)(loop_0))))))"
"(if(unsafe-fx< index_0 26)"
"(if(unsafe-fx< index_0 25)"
"(let-values()"
"(let-values(((wrt-dir_0)"
"(current-load-relative-directory)))"
@ -19303,22 +19312,18 @@ static const char *startup_source =
"(if(null? rel-elems_0)"
"(let-values()(build-path 'same))"
"(let-values()"
"(apply build-path rel-elems_0))))))))"
"(if(unsafe-fx< index_0 26)"
"(apply build-path rel-elems_0)))))))"
"(let-values()"
"(intern_0(pregexp(read-fasl-string i_0))))"
"(intern_0(pregexp(read-fasl-string i_0)))))"
"(if(unsafe-fx< index_0 27)"
"(let-values()"
"(intern_0(regexp(read-fasl-string i_0))))"
"(if(unsafe-fx< index_0 28)"
"(let-values()"
"(intern_0(byte-pregexp(read-fasl-bytes i_0))))"
"(if(unsafe-fx< index_0 29)"
"(let-values()"
"(intern_0"
"(byte-regexp(read-fasl-bytes i_0)))))))))"
"(if(unsafe-fx< index_0 34)"
"(if(unsafe-fx< index_0 31)"
"(if(unsafe-fx< index_0 30)"
"(intern_0(byte-regexp(read-fasl-bytes i_0))))"
"(let-values()"
"(let-values(((len_1)(read-fasl-integer i_0)))"
"(reverse$1"
@ -19332,7 +19337,8 @@ static const char *startup_source =
"(let-values()"
"(check-range start_0 end_0 inc_0)))"
"((letrec-values(((for-loop_0)"
"(lambda(fold-var_0 pos_0)"
"(lambda(fold-var_0"
" pos_0)"
"(begin"
" 'for-loop"
"(if(< pos_0 end_0)"
@ -19351,14 +19357,18 @@ static const char *startup_source =
"(if(not #f)"
"(for-loop_0"
" fold-var_1"
"(+ pos_0 inc_0))"
"(+"
" pos_0"
" inc_0))"
" fold-var_1)))"
" fold-var_0)))))"
" for-loop_0)"
" null"
" start_0))))))"
"(let-values()(cons(loop_0)(loop_0))))"
" start_0)))))))))))"
"(if(unsafe-fx< index_0 35)"
"(if(unsafe-fx< index_0 32)"
"(if(unsafe-fx< index_0 31)"
"(let-values()(cons(loop_0)(loop_0)))"
"(let-values()"
"(let-values(((len_1)(read-fasl-integer i_0)))"
"((letrec-values(((ploop_0)"
@ -19372,7 +19382,7 @@ static const char *startup_source =
"(ploop_0"
"(sub1 len_2))))))))"
" ploop_0)"
" len_1)))"
" len_1))))"
"(if(unsafe-fx< index_0 33)"
"(let-values()"
"(let-values(((len_1)(read-fasl-integer i_0)))"
@ -19385,7 +19395,7 @@ static const char *startup_source =
"(let-values()"
"(raise-argument-error"
" 'for/vector"
" \"exact-nonnegative-integer?\""
" \"exact-nonnegative-integer?\""
" len_2)))"
"(let-values(((v_0)"
"(make-vector"
@ -19395,12 +19405,10 @@ static const char *startup_source =
"(if(zero? len_2)"
"(void)"
"(let-values()"
"(let-values(((start_0)"
" 0)"
"(let-values(((start_0) 0)"
"((end_0)"
" len_1)"
"((inc_0)"
" 1))"
"((inc_0) 1))"
"(begin"
"(if(variable-reference-from-unsafe?"
"(#%variable-reference))"
@ -19459,10 +19467,11 @@ static const char *startup_source =
"(if(eqv? type_0 fasl-immutable-vector-type)"
"(vector->immutable-vector vec_0)"
" vec_0))))"
"(let-values()(box(loop_0))))))"
"(if(unsafe-fx< index_0 34)"
"(let-values()(box(loop_0)))"
"(let-values()(box-immutable(loop_0))))))"
"(if(unsafe-fx< index_0 37)"
"(if(unsafe-fx< index_0 36)"
"(if(unsafe-fx< index_0 35)"
"(let-values()(box-immutable(loop_0)))"
"(let-values()"
"(let-values(((key_0)(loop_0)))"
"(let-values(((len_1)(read-fasl-integer i_0)))"
@ -19506,8 +19515,7 @@ static const char *startup_source =
" fold-var_0)))))"
" for-loop_0)"
" null"
" start_0)))))))))"
"(if(unsafe-fx< index_0 37)"
" start_0))))))))"
"(let-values()"
"(let-values(((ht_0)"
"(let-values(((tmp_1)"
@ -19556,7 +19564,7 @@ static const char *startup_source =
" for-loop_0)"
" start_0)))"
"(void)"
" ht_0))))"
" ht_0)))))"
"(if(unsafe-fx< index_0 38)"
"(let-values()"
"(let-values(((ht_0)"
@ -19613,6 +19621,7 @@ static const char *startup_source =
"(loop_0)"
"(loop_0)"
"(loop_0)))"
"(if(unsafe-fx< index_0 40)"
"(let-values()"
"(let-values(((e_0)(loop_0)))"
"(let-values(((s_0)(loop_0)))"
@ -19663,7 +19672,8 @@ static const char *startup_source =
" c_1)))))"
" for-loop_0)"
" c_0"
" lst_0)))))))))))))))))))))"
" lst_0)))))))"
"(let-values() unsafe-undefined)))))))))))))))"
" loop_0)))))))))))))))"
"(define-values"
"(write-fasl-integer)"