optimizer: add symbol?, keyword? and char? to the relevant predicates
Also, add a new primitive interned-char? that is hidden, but it's useful to track in the optimizer the the chars? with a value < 256 that are interned because they are treated specially, and if they are equal? then they are eq?.
This commit is contained in:
Gustavo Massaccesi
parent
3760de1fa9
commit
7c1cb1a2f0
|
|
@ -12,7 +12,7 @@
|
|||
|
||||
(define collection 'multi)
|
||||
|
||||
(define version "6.7.0.2")
|
||||
(define version "6.7.0.3")
|
||||
|
||||
(define deps `("racket-lib"
|
||||
["racket" #:version ,version]))
|
||||
|
|
|
|||
|
|
@ -5,8 +5,7 @@
|
|||
|
||||
(require racket/flonum
|
||||
racket/function
|
||||
(only-in '#%kernel (list-pair? k:list-pair?)
|
||||
(true-object? k:true-object?)))
|
||||
(prefix-in k: '#%kernel))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -457,7 +456,21 @@
|
|||
(test #t char? #\()
|
||||
(test #t char? #\ )
|
||||
(test #t char? '#\newline)
|
||||
(test #t char? #\u100)
|
||||
(test #f char? 7)
|
||||
(test #f char? #t)
|
||||
(test #f char? 'x)
|
||||
(arity-test char? 1 1)
|
||||
(test #t k:interned-char? #\a)
|
||||
(test #t k:interned-char? #\()
|
||||
(test #t k:interned-char? #\ )
|
||||
(test #t k:interned-char? '#\newline)
|
||||
(test #f k:interned-char? #\u100)
|
||||
(test #f k:interned-char? 7)
|
||||
(test #f k:interned-char? #t)
|
||||
(test #f k:interned-char? #t)
|
||||
(test #f k:interned-char? 'x)
|
||||
(arity-test k:interned-char? 1 1)
|
||||
|
||||
(test #f char=? #\A #\B)
|
||||
(test #f char=? #\A #\A #\B)
|
||||
|
|
|
|||
|
|
@ -1438,7 +1438,7 @@
|
|||
(test-arg-types '(vector-length vector?) 'fixnum? 'may-omit)
|
||||
(test-arg-types '(vector->values vector?) #f)
|
||||
(test-arg-types '(vector-ref vector? fixnum?) #f)
|
||||
(test-arg-types '(vector-set! vector? fixnum? #f) #f)
|
||||
(test-arg-types '(vector-set! vector? fixnum? #f) 'void?)
|
||||
(test-arg-types '(vector->list vector?) 'list?)
|
||||
(test-arg-types '(list->vector list?) 'vector?)
|
||||
(test-arg-types '(struct->vector #f) 'vector?)
|
||||
|
|
@ -1465,10 +1465,16 @@
|
|||
'(lambda (w z) #t)
|
||||
#f)
|
||||
|
||||
;Test types inference for box?
|
||||
(test-arg-types '(box #f) 'box?)
|
||||
(test-arg-types '(box-immutable #f) 'box?)
|
||||
(test-arg-types '(unbox box?) #f)
|
||||
(test-arg-types '(set-box! box? #f) 'void?)
|
||||
|
||||
;Test types inference for string?
|
||||
(test-arg-types '(string-length string?) 'fixnum? 'may-omit)
|
||||
(test-arg-types '(string-ref string? fixnum?) #f)
|
||||
(test-arg-types '(string-set! string? fixnum? #f) #f)
|
||||
(test-arg-types '(string-ref string? fixnum?) 'char?)
|
||||
(test-arg-types '(string-set! string? fixnum? char?) 'void?)
|
||||
(test-arg-types '(string->immutable-string string?) 'string? 'may-omit)
|
||||
(test-arg-types '(string-append) string? 'may-omit)
|
||||
(test-arg-types '(string-append string?) 'string? 'may-omit)
|
||||
|
|
@ -1478,8 +1484,8 @@
|
|||
|
||||
;Test types inference for bytes?
|
||||
(test-arg-types '(bytes-length bytes?) 'fixnum? 'may-omit)
|
||||
(test-arg-types '(bytes-ref bytes? fixnum?) #f)
|
||||
(test-arg-types '(bytes-set! bytes? fixnum? #f) #f)
|
||||
(test-arg-types '(bytes-ref bytes? fixnum?) 'fixnum?)
|
||||
(test-arg-types '(bytes-set! bytes? fixnum? fixnum?) 'void?)
|
||||
(test-arg-types '(bytes->immutable-bytes bytes?) 'bytes? 'may-omit)
|
||||
(test-arg-types '(bytes-append) bytes? 'may-omit)
|
||||
(test-arg-types '(bytes-append bytes?) 'bytes? 'may-omit)
|
||||
|
|
@ -1500,6 +1506,14 @@
|
|||
(test-arg-types '(append list? list? list?) list? 'may-omit 'dont-infer)
|
||||
(test-arg-types '(append list? list? list? list?) list? 'may-omit 'dont-infer)
|
||||
|
||||
;Test types inference for symbol? and keyword?
|
||||
(test-arg-types '(symbol->string symbol?) 'string? 'may-omit)
|
||||
(test-arg-types '(string->symbol string?) 'symbol? 'may-omit)
|
||||
(test-arg-types '(keyword->string keyword?) 'string? 'may-omit)
|
||||
(test-arg-types '(string->keyword string?) 'keyword? 'may-omit)
|
||||
(test-arg-types '(gensym) 'symbol?)
|
||||
(test-arg-types '(gensym #f) 'symbol?)
|
||||
|
||||
;Test the map primitive and the map version defined in private/map.rkt
|
||||
;The optimizer is not capable of figuring out that the result of map is a list?
|
||||
(test-arg-types '(k:map procedure? list?) 'list?)
|
||||
|
|
@ -3080,6 +3094,7 @@
|
|||
(test-pred 'bytes?)
|
||||
(test-pred 'path?)
|
||||
(test-pred 'char?)
|
||||
(test-pred 'k:interned-char?)
|
||||
(test-pred 'boolean?)
|
||||
(test-pred 'chaperone?)
|
||||
(test-pred 'impersonator?)
|
||||
|
|
@ -3128,6 +3143,7 @@
|
|||
(test-implies 'k:list-pair? 'pair?)
|
||||
(test-implies 'k:list-pair? 'list?)
|
||||
(test-implies 'list? 'pair? '?)
|
||||
(test-implies 'k:interned-char? 'char?)
|
||||
(test-implies 'not 'boolean?)
|
||||
(test-implies 'k:true-object? 'boolean?)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -231,8 +231,7 @@
|
|||
chaperone-procedure* impersonate-procedure*
|
||||
assq assv assoc
|
||||
prop:incomplete-arity prop:method-arity-error
|
||||
list-pair?
|
||||
true-object?
|
||||
list-pair? interned-char? true-object?
|
||||
random)
|
||||
(all-from "reqprov.rkt")
|
||||
(all-from-except "for.rkt"
|
||||
|
|
|
|||
|
|
@ -31,8 +31,12 @@
|
|||
READ_ONLY Scheme_Object **scheme_char_constants;
|
||||
READ_ONLY static Scheme_Object *general_category_symbols[NUM_GENERAL_CATEGORIES];
|
||||
|
||||
READ_ONLY Scheme_Object *scheme_char_p_proc;
|
||||
READ_ONLY Scheme_Object *scheme_interned_char_p_proc;
|
||||
|
||||
/* locals */
|
||||
static Scheme_Object *char_p (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *interned_char_p (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *char_eq (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *char_lt (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *char_gt (int argc, Scheme_Object *argv[]);
|
||||
|
|
@ -98,11 +102,20 @@ void scheme_init_char (Scheme_Env *env)
|
|||
{
|
||||
Scheme_Object *p;
|
||||
|
||||
REGISTER_SO(scheme_char_p_proc);
|
||||
p = scheme_make_folding_prim(char_p, "char?", 1, 1, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_OMITABLE);
|
||||
scheme_char_p_proc = p;
|
||||
scheme_add_global_constant("char?", p, env);
|
||||
|
||||
REGISTER_SO(scheme_interned_char_p_proc);
|
||||
p = scheme_make_folding_prim(interned_char_p, "interned-char?", 1, 1, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_OMITABLE);
|
||||
scheme_interned_char_p_proc = p;
|
||||
scheme_add_global_constant("interned-char?", p, env);
|
||||
|
||||
p = scheme_make_folding_prim(char_eq, "char=?", 2, -1, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
|
||||
scheme_add_global_constant("char=?", p, env);
|
||||
|
|
@ -125,7 +138,6 @@ void scheme_init_char (Scheme_Env *env)
|
|||
GLOBAL_FOLDING_PRIM("char-iso-control?", char_control, 1, 1, 1, env);
|
||||
GLOBAL_FOLDING_PRIM("char-punctuation?", char_punctuation, 1, 1, 1, env);
|
||||
GLOBAL_FOLDING_PRIM("char-upper-case?", char_upper_case, 1, 1, 1, env);
|
||||
GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env);
|
||||
GLOBAL_FOLDING_PRIM("char-lower-case?", char_lower_case, 1, 1, 1, env);
|
||||
GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env);
|
||||
|
||||
|
|
@ -177,6 +189,12 @@ char_p (int argc, Scheme_Object *argv[])
|
|||
return (SCHEME_CHARP(argv[0]) ? scheme_true : scheme_false);
|
||||
}
|
||||
|
||||
static Scheme_Object *
|
||||
interned_char_p (int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return (SCHEME_CHARP(argv[0]) && SCHEME_CHAR_VAL(argv[0]) < 256) ? scheme_true : scheme_false;
|
||||
}
|
||||
|
||||
#define charSTD_FOLDCASE(nl) nl;
|
||||
#define charNO_FOLDCASE(nl) /* empty */
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,54,0,0,0,1,0,0,8,0,18,0,
|
||||
22,0,26,0,31,0,38,0,42,0,47,0,59,0,66,0,69,0,82,0,89,
|
||||
0,94,0,103,0,109,0,123,0,137,0,140,0,146,0,157,0,159,0,173,0,
|
||||
|
|
@ -102,7 +102,7 @@
|
|||
EVAL_ONE_SIZED_STR((char *)expr, 2090);
|
||||
}
|
||||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,184,0,0,0,1,0,0,8,0,16,0,
|
||||
29,0,34,0,51,0,63,0,85,0,114,0,158,0,164,0,178,0,193,0,211,
|
||||
0,223,0,239,0,253,0,19,1,39,1,73,1,90,1,107,1,130,1,145,1,
|
||||
|
|
@ -1026,7 +1026,7 @@
|
|||
EVAL_ONE_SIZED_STR((char *)expr, 19329);
|
||||
}
|
||||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,15,0,0,0,1,0,0,8,0,23,0,
|
||||
48,0,65,0,83,0,105,0,128,0,149,0,171,0,181,0,191,0,199,0,209,
|
||||
0,217,0,0,0,253,1,0,0,3,1,5,105,110,115,112,48,76,35,37,112,
|
||||
|
|
@ -1057,7 +1057,7 @@
|
|||
EVAL_ONE_SIZED_STR((char *)expr, 581);
|
||||
}
|
||||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,102,0,0,0,1,0,0,8,0,15,0,
|
||||
26,0,53,0,59,0,73,0,86,0,112,0,129,0,151,0,159,0,171,0,186,
|
||||
0,202,0,220,0,241,0,253,0,13,1,36,1,60,1,72,1,103,1,108,1,
|
||||
|
|
@ -1238,55 +1238,55 @@
|
|||
9,32,58,88,149,8,38,42,54,11,2,30,39,223,48,33,73,32,59,88,149,
|
||||
8,38,42,53,11,2,30,39,223,48,33,72,32,60,88,148,8,36,40,53,11,
|
||||
2,31,222,33,71,32,61,88,149,8,38,42,53,11,2,30,39,223,48,33,62,
|
||||
28,249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,145,9,7,
|
||||
28,249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,146,9,7,
|
||||
47,249,22,166,7,23,197,2,23,199,2,249,22,82,250,22,184,7,23,198,2,
|
||||
39,23,200,2,248,2,60,249,22,184,7,23,198,1,248,22,187,3,23,201,1,
|
||||
250,2,61,195,23,197,4,248,22,187,3,198,32,63,88,149,8,38,42,55,11,
|
||||
2,30,39,223,48,33,70,32,64,88,149,8,38,42,54,11,2,30,39,223,48,
|
||||
33,67,32,65,88,149,8,38,42,53,11,2,30,39,223,48,33,66,28,249,22,
|
||||
134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,145,9,7,47,249,22,
|
||||
134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,146,9,7,47,249,22,
|
||||
166,7,23,197,2,23,199,2,249,22,82,250,22,184,7,23,198,2,39,23,200,
|
||||
2,248,2,60,249,22,184,7,23,198,1,248,22,187,3,23,201,1,250,2,65,
|
||||
195,23,197,4,248,22,187,3,198,28,249,22,134,4,23,197,2,23,196,4,248,
|
||||
22,92,193,28,249,22,145,9,7,47,249,22,166,7,23,197,2,23,199,2,249,
|
||||
22,92,193,28,249,22,146,9,7,47,249,22,166,7,23,197,2,23,199,2,249,
|
||||
22,82,250,22,184,7,23,198,2,39,23,200,2,27,249,22,184,7,23,198,1,
|
||||
248,22,187,3,23,201,1,19,248,22,165,7,23,195,2,250,2,65,23,197,1,
|
||||
23,196,4,39,2,27,248,22,187,3,23,197,1,28,249,22,134,4,23,195,2,
|
||||
23,197,4,248,22,92,194,28,249,22,145,9,7,47,249,22,166,7,23,198,2,
|
||||
23,197,4,248,22,92,194,28,249,22,146,9,7,47,249,22,166,7,23,198,2,
|
||||
23,197,2,249,22,82,250,22,184,7,23,199,2,39,23,198,2,248,2,60,249,
|
||||
22,184,7,23,199,1,248,22,187,3,23,199,1,250,2,64,196,23,198,4,248,
|
||||
22,187,3,196,32,68,88,149,8,38,42,53,11,2,30,39,223,48,33,69,28,
|
||||
249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,145,9,7,47,
|
||||
249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,146,9,7,47,
|
||||
249,22,166,7,23,197,2,23,199,2,249,22,82,250,22,184,7,23,198,2,39,
|
||||
23,200,2,248,2,60,249,22,184,7,23,198,1,248,22,187,3,23,201,1,250,
|
||||
2,68,195,23,197,4,248,22,187,3,198,28,249,22,134,4,23,197,2,23,196,
|
||||
4,248,22,92,193,28,249,22,145,9,7,47,249,22,166,7,23,197,2,23,199,
|
||||
4,248,22,92,193,28,249,22,146,9,7,47,249,22,166,7,23,197,2,23,199,
|
||||
2,249,22,82,250,22,184,7,23,198,2,39,23,200,2,27,249,22,184,7,23,
|
||||
198,1,248,22,187,3,23,201,1,19,248,22,165,7,23,195,2,250,2,64,23,
|
||||
197,1,23,196,4,39,2,27,248,22,187,3,23,197,1,28,249,22,134,4,23,
|
||||
195,2,23,197,4,248,22,92,194,28,249,22,145,9,7,47,249,22,166,7,23,
|
||||
195,2,23,197,4,248,22,92,194,28,249,22,146,9,7,47,249,22,166,7,23,
|
||||
198,2,23,197,2,249,22,82,250,22,184,7,23,199,2,39,23,198,2,27,249,
|
||||
22,184,7,23,199,1,248,22,187,3,23,199,1,19,248,22,165,7,23,195,2,
|
||||
250,2,68,23,197,1,23,196,4,39,2,27,248,22,187,3,23,195,1,28,249,
|
||||
22,134,4,23,195,2,23,198,4,248,22,92,195,28,249,22,145,9,7,47,249,
|
||||
22,134,4,23,195,2,23,198,4,248,22,92,195,28,249,22,146,9,7,47,249,
|
||||
22,166,7,23,199,2,23,197,2,249,22,82,250,22,184,7,23,200,2,39,23,
|
||||
198,2,248,2,60,249,22,184,7,23,200,1,248,22,187,3,23,199,1,250,2,
|
||||
63,197,23,199,4,248,22,187,3,196,19,248,22,165,7,23,195,2,28,249,22,
|
||||
167,20,39,23,195,4,248,22,92,194,28,249,22,145,9,7,47,249,22,166,7,
|
||||
167,20,39,23,195,4,248,22,92,194,28,249,22,146,9,7,47,249,22,166,7,
|
||||
23,198,2,39,249,22,82,250,22,184,7,23,199,2,39,39,27,249,22,184,7,
|
||||
23,199,1,40,19,248,22,165,7,23,195,2,250,2,61,23,197,1,23,196,4,
|
||||
39,2,28,249,22,167,20,40,23,195,4,248,22,92,194,28,249,22,145,9,7,
|
||||
39,2,28,249,22,167,20,40,23,195,4,248,22,92,194,28,249,22,146,9,7,
|
||||
47,249,22,166,7,23,198,2,40,249,22,82,250,22,184,7,23,199,2,39,40,
|
||||
248,2,60,249,22,184,7,23,199,1,41,250,2,63,196,23,196,4,41,2,28,
|
||||
249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,145,9,7,47,
|
||||
249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,146,9,7,47,
|
||||
249,22,166,7,23,197,2,23,199,2,249,22,82,250,22,184,7,23,198,2,39,
|
||||
23,200,2,248,2,60,249,22,184,7,23,198,1,248,22,187,3,23,201,1,250,
|
||||
2,59,195,23,197,4,248,22,187,3,198,28,249,22,134,4,23,197,2,23,196,
|
||||
4,248,22,92,193,28,249,22,145,9,7,47,249,22,166,7,23,197,2,23,199,
|
||||
4,248,22,92,193,28,249,22,146,9,7,47,249,22,166,7,23,197,2,23,199,
|
||||
2,249,22,82,250,22,184,7,23,198,2,39,23,200,2,27,249,22,184,7,23,
|
||||
198,1,248,22,187,3,23,201,1,19,248,22,165,7,23,195,2,250,2,59,23,
|
||||
197,1,23,196,4,39,2,27,248,22,187,3,23,197,1,28,249,22,134,4,23,
|
||||
195,2,23,197,4,248,22,92,194,28,249,22,145,9,7,47,249,22,166,7,23,
|
||||
195,2,23,197,4,248,22,92,194,28,249,22,146,9,7,47,249,22,166,7,23,
|
||||
198,2,23,197,2,249,22,82,250,22,184,7,23,199,2,39,23,198,2,248,2,
|
||||
60,249,22,184,7,23,199,1,248,22,187,3,23,199,1,250,2,58,196,23,198,
|
||||
4,248,22,187,3,196,32,74,88,148,39,40,58,11,2,31,222,33,75,28,248,
|
||||
|
|
@ -1553,32 +1553,32 @@
|
|||
EVAL_ONE_SIZED_STR((char *)expr, 10346);
|
||||
}
|
||||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,17,0,0,0,1,0,0,8,0,18,0,
|
||||
24,0,38,0,52,0,64,0,84,0,98,0,113,0,126,0,131,0,135,0,147,
|
||||
0,231,0,238,0,8,1,0,0,214,1,0,0,3,1,5,105,110,115,112,48,
|
||||
71,35,37,98,117,105,108,116,105,110,67,113,117,111,116,101,29,94,2,3,70,
|
||||
35,37,107,101,114,110,101,108,11,29,94,2,3,70,35,37,101,120,112,111,98,
|
||||
115,11,29,94,2,3,68,35,37,98,111,111,116,11,29,94,2,3,76,35,37,
|
||||
112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,2,3,70,35,37,112,
|
||||
97,114,97,109,122,11,29,94,2,3,71,35,37,110,101,116,119,111,114,107,11,
|
||||
29,94,2,3,69,35,37,117,116,105,108,115,11,38,11,93,2,12,36,12,0,
|
||||
39,38,13,93,143,16,3,39,2,14,2,2,39,36,14,1,150,40,143,2,15,
|
||||
16,4,2,4,39,39,2,1,143,2,15,16,4,2,5,39,39,2,1,143,2,
|
||||
15,16,4,2,6,39,39,2,1,143,2,15,16,4,2,7,39,39,2,1,143,
|
||||
2,15,16,4,2,8,39,39,2,1,143,2,15,16,4,2,9,39,39,2,1,
|
||||
143,2,15,16,4,2,10,39,39,2,1,16,0,38,15,143,2,14,2,11,18,
|
||||
143,16,2,143,10,16,3,9,2,11,2,13,143,11,16,3,9,9,2,13,16,
|
||||
3,9,9,9,145,40,9,20,122,145,2,1,39,16,1,11,16,0,20,27,15,
|
||||
56,9,2,2,2,2,29,11,11,11,11,11,11,11,9,9,11,11,11,33,16,
|
||||
40,80,143,39,39,20,122,145,2,1,39,16,0,16,0,40,42,39,16,0,39,
|
||||
16,0,39,11,11,11,16,0,16,0,16,0,39,39,40,12,11,11,16,0,16,
|
||||
0,16,0,39,39,11,12,11,11,16,0,16,0,16,0,39,39,16,0,105,2,
|
||||
4,2,5,29,94,2,3,71,35,37,102,111,114,101,105,103,110,11,29,94,2,
|
||||
3,70,35,37,117,110,115,97,102,101,11,29,94,2,3,71,35,37,102,108,102,
|
||||
120,110,117,109,11,2,6,2,7,2,8,2,9,2,10,29,94,2,3,69,35,
|
||||
37,112,108,97,99,101,11,29,94,2,3,71,35,37,102,117,116,117,114,101,115,
|
||||
11,29,94,2,3,71,35,37,108,105,110,107,108,101,116,11,9,9,9,39,9,
|
||||
0};
|
||||
EVAL_ONE_SIZED_STR((char *)expr, 546);
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,18,0,0,0,1,0,0,8,0,18,0,
|
||||
22,0,28,0,42,0,56,0,68,0,88,0,102,0,117,0,130,0,135,0,139,
|
||||
0,151,0,235,0,242,0,20,1,0,0,224,1,0,0,3,1,5,105,110,115,
|
||||
112,48,71,35,37,98,117,105,108,116,105,110,29,11,11,11,67,113,117,111,116,
|
||||
101,29,94,2,4,70,35,37,107,101,114,110,101,108,11,29,94,2,4,70,35,
|
||||
37,101,120,112,111,98,115,11,29,94,2,4,68,35,37,98,111,111,116,11,29,
|
||||
94,2,4,76,35,37,112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,
|
||||
2,4,70,35,37,112,97,114,97,109,122,11,29,94,2,4,71,35,37,110,101,
|
||||
116,119,111,114,107,11,29,94,2,4,69,35,37,117,116,105,108,115,11,38,12,
|
||||
93,2,13,36,13,0,39,38,14,93,143,16,3,39,2,15,2,2,39,36,15,
|
||||
1,150,40,143,2,16,16,4,2,5,39,39,2,1,143,2,16,16,4,2,6,
|
||||
39,39,2,1,143,2,16,16,4,2,7,39,39,2,1,143,2,16,16,4,2,
|
||||
8,39,39,2,1,143,2,16,16,4,2,9,39,39,2,1,143,2,16,16,4,
|
||||
2,10,39,39,2,1,143,2,16,16,4,2,11,39,39,2,1,16,0,38,16,
|
||||
143,2,15,2,12,18,143,16,2,143,10,16,3,93,16,2,29,11,11,11,2,
|
||||
3,2,12,2,14,143,11,16,3,9,9,2,14,16,3,9,9,9,145,40,9,
|
||||
20,122,145,2,1,39,16,1,11,16,0,20,27,15,56,9,2,2,2,2,2,
|
||||
3,11,11,11,11,9,9,11,11,11,33,17,40,80,143,39,39,20,122,145,2,
|
||||
1,39,16,0,16,0,40,42,39,16,0,39,16,0,39,11,11,11,16,0,16,
|
||||
0,16,0,39,39,40,12,11,11,16,0,16,0,16,0,39,39,11,12,11,11,
|
||||
16,0,16,0,16,0,39,39,16,0,105,2,5,2,6,29,94,2,4,71,35,
|
||||
37,102,111,114,101,105,103,110,11,29,94,2,4,70,35,37,117,110,115,97,102,
|
||||
101,11,29,94,2,4,71,35,37,102,108,102,120,110,117,109,11,2,7,2,8,
|
||||
2,9,2,10,2,11,29,94,2,4,69,35,37,112,108,97,99,101,11,29,94,
|
||||
2,4,71,35,37,102,117,116,117,114,101,115,11,29,94,2,4,71,35,37,108,
|
||||
105,110,107,108,101,116,11,9,9,9,39,9,0};
|
||||
EVAL_ONE_SIZED_STR((char *)expr, 558);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -379,6 +379,72 @@ static int generate_inlined_type_test(mz_jit_state *jitter, Scheme_App2_Rec *app
|
|||
return 1;
|
||||
}
|
||||
|
||||
static int generate_inlined_interned_char_test(mz_jit_state *jitter, Scheme_App2_Rec *app,
|
||||
Branch_Info *for_branch, int branch_short,
|
||||
int dest)
|
||||
{
|
||||
GC_CAN_IGNORE jit_insn *ref1, *ref2, *ref3;
|
||||
int reg_valid;
|
||||
|
||||
LOG_IT(("inlined interned-char?\n"));
|
||||
|
||||
mz_runstack_skipped(jitter, 1);
|
||||
|
||||
scheme_generate_non_tail(app->rand, jitter, 0, 1, 0);
|
||||
CHECK_LIMIT();
|
||||
|
||||
mz_runstack_unskipped(jitter, 1);
|
||||
|
||||
mz_rs_sync();
|
||||
|
||||
__START_SHORT_JUMPS__(branch_short);
|
||||
|
||||
reg_valid = 0;
|
||||
if (for_branch) {
|
||||
reg_valid = mz_CURRENT_REG_STATUS_VALID();
|
||||
scheme_prepare_branch_jump(jitter, for_branch);
|
||||
CHECK_LIMIT();
|
||||
}
|
||||
|
||||
/* Test that it's not a fixnum */
|
||||
ref1 = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1);
|
||||
/* Test that it's a char */
|
||||
#ifdef jit_bxnei_s
|
||||
ref2 = jit_bxnei_s(jit_forward(), JIT_R0, scheme_char_type);
|
||||
#else
|
||||
jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type);
|
||||
ref2 = jit_bnei_i(jit_forward(), JIT_R1, scheme_char_type);
|
||||
#endif
|
||||
/* Test that it's < 256 */
|
||||
jit_ldxi_s(JIT_R1, JIT_R0, &SCHEME_CHAR_VAL(0x0));
|
||||
ref3 = jit_blti_i(jit_forward(), JIT_R1, 256);
|
||||
|
||||
if (for_branch) {
|
||||
scheme_add_branch_false(for_branch, ref1);
|
||||
scheme_add_branch_false(for_branch, ref2);
|
||||
scheme_add_branch_false(for_branch, ref3);
|
||||
|
||||
/* Note that the test didn't disturb R0: */
|
||||
mz_SET_R0_STATUS_VALID(reg_valid);
|
||||
|
||||
scheme_branch_for_true(jitter, for_branch);
|
||||
CHECK_LIMIT();
|
||||
} else {
|
||||
GC_CAN_IGNORE jit_insn *ref_ucfinish;
|
||||
(void)jit_movi_p(dest, scheme_true);
|
||||
ref_ucfinish = jit_jmpi(jit_forward());
|
||||
mz_patch_branch(ref1);
|
||||
mz_patch_branch(ref2);
|
||||
mz_patch_branch(ref3);
|
||||
(void)jit_movi_p(dest, scheme_false);
|
||||
mz_patch_ucbranch(ref_ucfinish);
|
||||
}
|
||||
|
||||
__END_SHORT_JUMPS__(branch_short);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int generate_inlined_immutable_test(mz_jit_state *jitter, Scheme_App2_Rec *app,
|
||||
Branch_Info *for_branch, int branch_short,
|
||||
int dest)
|
||||
|
|
@ -1116,6 +1182,9 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
|
|||
} else if (IS_NAMED_PRIM(rator, "char?")) {
|
||||
generate_inlined_type_test(jitter, app, scheme_char_type, scheme_char_type, 0, for_branch, branch_short, dest);
|
||||
return 1;
|
||||
} else if (IS_NAMED_PRIM(rator, "interned-char?")) {
|
||||
generate_inlined_interned_char_test(jitter, app, for_branch, branch_short, dest);
|
||||
return 1;
|
||||
} else if (IS_NAMED_PRIM(rator, "boolean?")) {
|
||||
generate_inlined_constant_test(jitter, app, scheme_false, scheme_true, for_branch, branch_short, dest);
|
||||
return 1;
|
||||
|
|
|
|||
|
|
@ -2926,8 +2926,12 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Inf
|
|||
} else if (IS_NAMED_PRIM(rator, "vector->list")
|
||||
|| IS_NAMED_PRIM(rator, "map")) {
|
||||
return scheme_list_p_proc;
|
||||
} else if (IS_NAMED_PRIM(rator, "string-ref")) {
|
||||
return scheme_char_p_proc;
|
||||
} else if (IS_NAMED_PRIM(rator, "string-append")
|
||||
|| IS_NAMED_PRIM(rator, "string->immutable-string")) {
|
||||
|| IS_NAMED_PRIM(rator, "string->immutable-string")
|
||||
|| IS_NAMED_PRIM(rator, "symbol->string")
|
||||
|| IS_NAMED_PRIM(rator, "keyword->string")) {
|
||||
return scheme_string_p_proc;
|
||||
} else if (IS_NAMED_PRIM(rator, "bytes-append")
|
||||
|| IS_NAMED_PRIM(rator, "bytes->immutable-bytes")) {
|
||||
|
|
@ -2946,6 +2950,20 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Inf
|
|||
return scheme_void_p_proc;
|
||||
else if (SAME_OBJ(rator, scheme_procedure_specialize_proc))
|
||||
return scheme_procedure_p_proc;
|
||||
else if (IS_NAMED_PRIM(rator, "vector-set!")
|
||||
|| IS_NAMED_PRIM(rator, "string-set!")
|
||||
|| IS_NAMED_PRIM(rator, "bytes-set!")
|
||||
|| IS_NAMED_PRIM(rator, "set-box!"))
|
||||
return scheme_void_p_proc;
|
||||
else if (IS_NAMED_PRIM(rator, "vector-set!")
|
||||
|| IS_NAMED_PRIM(rator, "string-set!")
|
||||
|| IS_NAMED_PRIM(rator, "bytes-set!"))
|
||||
return scheme_void_p_proc;
|
||||
else if (IS_NAMED_PRIM(rator, "string->symbol")
|
||||
|| IS_NAMED_PRIM(rator, "gensym"))
|
||||
return scheme_symbol_p_proc;
|
||||
else if (IS_NAMED_PRIM(rator, "string->keyword"))
|
||||
return scheme_keyword_p_proc;
|
||||
else if (IS_NAMED_PRIM(rator, "pair?")
|
||||
|| IS_NAMED_PRIM(rator, "mpair?")
|
||||
|| IS_NAMED_PRIM(rator, "list?")
|
||||
|
|
@ -2972,6 +2990,7 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Inf
|
|||
|| IS_NAMED_PRIM(rator, "bytes?")
|
||||
|| IS_NAMED_PRIM(rator, "path?")
|
||||
|| IS_NAMED_PRIM(rator, "char?")
|
||||
|| IS_NAMED_PRIM(rator, "interned-char?")
|
||||
|| IS_NAMED_PRIM(rator, "boolean?")
|
||||
|| IS_NAMED_PRIM(rator, "chaperone?")
|
||||
|| IS_NAMED_PRIM(rator, "impersonator?")
|
||||
|
|
@ -2988,6 +3007,7 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Inf
|
|||
|| IS_NAMED_PRIM(rator, "equal?")
|
||||
|| IS_NAMED_PRIM(rator, "string=?")
|
||||
|| IS_NAMED_PRIM(rator, "bytes=?")
|
||||
|| IS_NAMED_PRIM(rator, "char=?")
|
||||
|| IS_NAMED_PRIM(rator, "free-identifier=?")
|
||||
|| IS_NAMED_PRIM(rator, "bound-identifier=?")
|
||||
|| IS_NAMED_PRIM(rator, "procedure-closure-contents-eq?")) {
|
||||
|
|
@ -3266,7 +3286,14 @@ static Scheme_Object *do_expr_implies_predicate(Scheme_Object *expr, Optimize_In
|
|||
return scheme_void_p_proc;
|
||||
if (SCHEME_EOFP(expr))
|
||||
return scheme_eof_object_p_proc;
|
||||
|
||||
if (SCHEME_KEYWORDP(expr))
|
||||
return scheme_keyword_p_proc;
|
||||
if (SCHEME_SYMBOLP(expr))
|
||||
return scheme_symbol_p_proc;
|
||||
if (SCHEME_CHARP(expr) && SCHEME_CHAR_VAL(expr) < 256)
|
||||
return scheme_interned_char_p_proc;
|
||||
if (SCHEME_CHARP(expr))
|
||||
return scheme_char_p_proc;
|
||||
if (SAME_OBJ(expr, scheme_true))
|
||||
return scheme_true_object_p_proc;
|
||||
if (SCHEME_FALSEP(expr))
|
||||
|
|
@ -3774,7 +3801,7 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_
|
|||
&& (app->num_args >= ((Scheme_Primitive_Proc *)app->args[0])->mina)
|
||||
&& (app->num_args <= ((Scheme_Primitive_Proc *)app->args[0])->mu.maxa)) {
|
||||
Scheme_Object *app_o = (Scheme_Object *)app, *rator = app->args[0];
|
||||
Scheme_Object *rand1 = NULL, *rand2 = NULL;
|
||||
Scheme_Object *rand1 = NULL, *rand2 = NULL, *rand3 = NULL;
|
||||
|
||||
if (app->num_args >= 1)
|
||||
rand1 = app->args[1];
|
||||
|
|
@ -3782,6 +3809,9 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_
|
|||
if (app->num_args >= 2)
|
||||
rand2 = app->args[2];
|
||||
|
||||
if (app->num_args >= 3)
|
||||
rand3 = app->args[3];
|
||||
|
||||
check_known(info, app_o, rator, rand1, "vector-set!", scheme_vector_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand2, "vector-set!", scheme_fixnum_p_proc, NULL);
|
||||
|
||||
|
|
@ -3798,8 +3828,10 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_
|
|||
|
||||
check_known(info, app_o, rator, rand1, "string-set!", scheme_string_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand2, "string-set!", scheme_fixnum_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand3, "string-set!", scheme_char_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand1, "bytes-set!", scheme_byte_string_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand2, "bytes-set!", scheme_fixnum_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand3, "bytes-set!", scheme_fixnum_p_proc, NULL);
|
||||
|
||||
check_known_all(info, app_o, 0, 0, "string-append", scheme_string_p_proc, scheme_true);
|
||||
check_known_all(info, app_o, 0, 0, "bytes-append", scheme_byte_string_p_proc, scheme_true);
|
||||
|
|
@ -4238,6 +4270,11 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
|
|||
check_known(info, app_o, rator, rand, "string->immutable-string", scheme_string_p_proc, scheme_true);
|
||||
check_known(info, app_o, rator, rand, "bytes->immutable-bytes", scheme_byte_string_p_proc, scheme_true);
|
||||
|
||||
check_known(info, app_o, rator, rand, "string->symbol", scheme_string_p_proc, scheme_true);
|
||||
check_known(info, app_o, rator, rand, "symbol->string", scheme_symbol_p_proc, scheme_true);
|
||||
check_known(info, app_o, rator, rand, "string->keyword", scheme_string_p_proc, scheme_true);
|
||||
check_known(info, app_o, rator, rand, "keyword->string", scheme_keyword_p_proc, scheme_true);
|
||||
|
||||
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_REAL)
|
||||
check_known(info, app_o, rator, rand, NULL, scheme_real_p_proc,
|
||||
(SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS) ? scheme_true : NULL);
|
||||
|
|
@ -4703,6 +4740,11 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
|
|||
&& SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_byte_string_type)) {
|
||||
return scheme_byte_string_eq_2(app->rand1, app->rand2);
|
||||
}
|
||||
} else if (IS_NAMED_PRIM(app->rator, "char=?")) {
|
||||
if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_char_type)
|
||||
&& SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_char_type)) {
|
||||
return (SCHEME_CHAR_VAL(app->rand1) == SCHEME_CHAR_VAL(app->rand2)) ? scheme_true : scheme_false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -4757,6 +4799,10 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
|
|||
check_known(info, app_o, rator, rand2, "vector-ref", scheme_fixnum_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand1, "make-vector", scheme_fixnum_p_proc, NULL);
|
||||
|
||||
check_known(info, app_o, rator, rand1, "set-box!", scheme_box_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand1, "unsafe-set-box!", scheme_box_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand1, "unsafe-set-box*!", scheme_box_p_proc, NULL);
|
||||
|
||||
check_known(info, app_o, rator, rand1, "procedure-closure-contents-eq?", scheme_procedure_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand2, "procedure-closure-contents-eq?", scheme_procedure_p_proc, NULL);
|
||||
check_known(info, app_o, rator, rand1, "procedure-arity-includes?", scheme_procedure_p_proc, NULL);
|
||||
|
|
@ -5249,6 +5295,8 @@ static int relevant_predicate(Scheme_Object *pred)
|
|||
|| SAME_OBJ(pred, scheme_string_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_byte_string_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_vector_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_symbol_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_keyword_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_procedure_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_syntax_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_fixnum_p_proc)
|
||||
|
|
@ -5256,6 +5304,8 @@ static int relevant_predicate(Scheme_Object *pred)
|
|||
|| SAME_OBJ(pred, scheme_extflonum_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_number_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_real_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_char_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_interned_char_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_void_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_eof_object_p_proc)
|
||||
|| SAME_OBJ(pred, scheme_boolean_p_proc)
|
||||
|
|
@ -5288,6 +5338,11 @@ static int predicate_implies(Scheme_Object *pred1, Scheme_Object *pred2)
|
|||
&& SAME_OBJ(pred1, scheme_list_pair_p_proc))
|
||||
return 1;
|
||||
|
||||
/* interned-char? => char? */
|
||||
if (SAME_OBJ(pred2, scheme_char_p_proc)
|
||||
&& SAME_OBJ(pred1, scheme_interned_char_p_proc))
|
||||
return 1;
|
||||
|
||||
/* not, true-object? => boolean? */
|
||||
if (SAME_OBJ(pred2, scheme_boolean_p_proc)
|
||||
&& (SAME_OBJ(pred1, scheme_not_proc)
|
||||
|
|
|
|||
|
|
@ -488,6 +488,10 @@ void scheme_done_os_thread();
|
|||
/* constants */
|
||||
/*========================================================================*/
|
||||
|
||||
extern Scheme_Object *scheme_symbol_p_proc;
|
||||
extern Scheme_Object *scheme_keyword_p_proc;
|
||||
extern Scheme_Object *scheme_char_p_proc;
|
||||
extern Scheme_Object *scheme_interned_char_p_proc;
|
||||
extern Scheme_Object *scheme_fixnum_p_proc;
|
||||
extern Scheme_Object *scheme_flonum_p_proc;
|
||||
extern Scheme_Object *scheme_extflonum_p_proc;
|
||||
|
|
@ -3570,7 +3574,6 @@ int scheme_get_eval_type(Scheme_Object *obj);
|
|||
Scheme_Object *scheme_make_application(Scheme_Object *v, Optimize_Info *info);
|
||||
Scheme_Object *scheme_try_apply(Scheme_Object *f, Scheme_Object *args, Optimize_Info *info);
|
||||
int scheme_is_foldable_prim(Scheme_Object *f);
|
||||
int scheme_eq_testable_constant(Scheme_Object *v);
|
||||
|
||||
Scheme_Object *scheme_get_stop_expander(void);
|
||||
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "6.7.0.2"
|
||||
#define MZSCHEME_VERSION "6.7.0.3"
|
||||
|
||||
#define MZSCHEME_VERSION_X 6
|
||||
#define MZSCHEME_VERSION_Y 7
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 2
|
||||
#define MZSCHEME_VERSION_W 3
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
|
|
@ -65,6 +65,9 @@ THREAD_LOCAL_DECL(static int gensym_counter);
|
|||
|
||||
void scheme_set_case_sensitive(int v) { scheme_case_sensitive = v; }
|
||||
|
||||
READ_ONLY Scheme_Object *scheme_symbol_p_proc;
|
||||
READ_ONLY Scheme_Object *scheme_keyword_p_proc;
|
||||
|
||||
/* locals */
|
||||
static Scheme_Object *symbol_lt (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *symbol_p_prim (int argc, Scheme_Object *argv[]);
|
||||
|
|
@ -330,9 +333,11 @@ scheme_init_symbol (Scheme_Env *env)
|
|||
{
|
||||
Scheme_Object *p;
|
||||
|
||||
REGISTER_SO(scheme_symbol_p_proc);
|
||||
p = scheme_make_folding_prim(symbol_p_prim, "symbol?", 1, 1, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_OMITABLE);
|
||||
scheme_symbol_p_proc = p;
|
||||
scheme_add_global_constant("symbol?", p, env);
|
||||
|
||||
p = scheme_make_folding_prim(symbol_unreadable_p_prim, "symbol-unreadable?", 1, 1, 1);
|
||||
|
|
@ -347,9 +352,11 @@ scheme_init_symbol (Scheme_Env *env)
|
|||
GLOBAL_IMMED_PRIM("string->unreadable-symbol", string_to_unreadable_symbol_prim, 1, 1, env);
|
||||
GLOBAL_IMMED_PRIM("symbol->string", symbol_to_string_prim, 1, 1, env);
|
||||
|
||||
REGISTER_SO(scheme_keyword_p_proc);
|
||||
p = scheme_make_folding_prim(keyword_p_prim, "keyword?", 1, 1, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_OMITABLE);
|
||||
scheme_keyword_p_proc = p;
|
||||
scheme_add_global_constant("keyword?", p, env);
|
||||
|
||||
GLOBAL_FOLDING_PRIM("keyword<?", keyword_lt, 2, -1, 1, env);
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user