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

add unsafe-make-srcloc

Browse Source 
This function was already in Racket CS.
This commit is contained in:
Matthew Flatt 2019-03-12 17:55:41 -06:00
parent 861ddac5bc
commit 6d9ea44830
8 changed files with 34 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "7.2.0.9")
(define version "7.2.0.10")
(define deps `("racket-lib"
["racket" #:version ,version]))

11
pkgs/racket-doc/scribblings/reference/unsafe.scrbl
View File

@ -553,6 +553,17 @@ since an index cannot become invalid for an immutable @racket[hash].
@history[#:added "6.4.0.6"
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@defproc[(unsafe-make-srcloc [source any/c]
[line (or/c exact-positive-integer? #f)]
[column (or/c exact-nonnegative-integer? #f)]
[position (or/c exact-positive-integer? #f)]
[span (or/c exact-nonnegative-integer? #f)])
srcloc?]{
Unsafe version of @racket[srcloc].
@history[#:added "7.2.0.10"]}
@; ------------------------------------------------------------------------
@section[#:tag "unsafeextfl"]{Unsafe Extflonum Operations}

2
racket/src/cs/primitive/kernel.ss
View File

@ -767,7 +767,7 @@
[sleep (known-procedure 3)]
[split-path (known-procedure 2)]
[sqrt (known-procedure 2)]
[srcloc (known-constant)]
[srcloc (known-procedure/has-unsafe 32 'unsafe-make-srcloc)]
[srcloc->string (known-procedure 2)]
[srcloc-column (known-procedure 2)]
[srcloc-line (known-procedure 2)]

2
racket/src/racket/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1451
#define EXPECTED_PRIM_COUNT 1452
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

1
racket/src/racket/src/schpriv.h
View File

@ -3807,6 +3807,7 @@ Scheme_Object *scheme_copy_list(Scheme_Object *l);
Scheme_Object *scheme_append_strings(Scheme_Object *s1, Scheme_Object *s2);
Scheme_Object *scheme_unsafe_make_location(void);
Scheme_Object *scheme_unsafe_make_srcloc(int argc, Scheme_Object **argv);
void scheme_reset_hash_table(Scheme_Hash_Table *ht, int *history);

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "7.2.0.9"
#define MZSCHEME_VERSION "7.2.0.10"
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 9
#define MZSCHEME_VERSION_W 10
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

15
racket/src/racket/src/struct.c
View File

@ -5763,6 +5763,21 @@ Scheme_Object *scheme_unsafe_make_location(void)
return (Scheme_Object *)inst;
}
Scheme_Object *scheme_unsafe_make_srcloc(int argc, Scheme_Object **argv)
{
Scheme_Object *srcloc;
srcloc = scheme_unsafe_make_location();
((Scheme_Structure *)srcloc)->slots[0] = argv[0];
((Scheme_Structure *)srcloc)->slots[1] = argv[1];
((Scheme_Structure *)srcloc)->slots[2] = argv[2];
((Scheme_Structure *)srcloc)->slots[3] = argv[3];
((Scheme_Structure *)srcloc)->slots[4] = argv[4];
return srcloc;
}
int scheme_is_location(Scheme_Object *o)
{
if (SCHEME_CHAPERONEP(o))

2
racket/src/racket/src/thread.c
View File

@ -692,6 +692,8 @@ scheme_init_unsafe_thread (Scheme_Startup_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_AD_HOC_OPT);
scheme_addto_prim_instance("unsafe-place-local-set!", p, env);
ADD_PRIM_W_ARITY("unsafe-make-srcloc", scheme_unsafe_make_srcloc, 5, 5, env);
}
void scheme_init_thread_places(void) {