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

change _string/utf-16 and _string/ucs-4 so that #f = NULL (for consistency with other pointer types), and drop the /null variants

Browse Source 
svn: r13031
This commit is contained in:
Matthew Flatt 2009-01-07 17:49:14 +00:00
parent c9ebe9bba3
commit 0663588ee1
4 changed files with 20 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/mzlib/foreign.ss
View File

@ -695,9 +695,8 @@
;; String types ;; String types
;; The internal _string type uses the native ucs-4 encoding, also providing a ;; The internal _string type uses the native ucs-4 encoding, also providing a
;; utf-16 type (note: the non-/null variants do not use #f as NULL). ;; utf-16 type
(provide _string/ucs-4 _string/utf-16 (provide _string/ucs-4 _string/utf-16)
_string/ucs-4/null _string/utf-16/null)
;; 8-bit string encodings, #f is NULL ;; 8-bit string encodings, #f is NULL
(define ((false-or-op op) x) (and x (op x))) (define ((false-or-op op) x) (and x (op x)))

14
collects/scribblings/foreign/types.scrbl
View File

@ -165,27 +165,25 @@ pointer.
@deftogether[( @deftogether[(
@defthing[_string/ucs-4 ctype?] @defthing[_string/ucs-4 ctype?]
@defthing[_string/ucs-4/null ctype?]
)]{ )]{
A type for Scheme's native Unicode strings, which are in UCS-4 format. A type for Scheme's native Unicode strings, which are in UCS-4 format.
These correspond to the C @cpp{mzchar*} type used by PLT Scheme. The These correspond to the C @cpp{mzchar*} type used by PLT Scheme. As usual, the types
@schemeidfont{/null} variant treats @scheme[#f] as @cpp{NULL} and treat @scheme[#f] as @cpp{NULL} and vice-versa.}
vice-versa.}
@deftogether[( @deftogether[(
@defthing[_string/utf-16 ctype?] @defthing[_string/utf-16 ctype?]
@defthing[_string/utf-16/null ctype?]
)]{ )]{
Unicode strings in UTF-16 format. The @schemeidfont{/null} variant Unicode strings in UTF-16 format. As usual, the types treat
treats @scheme[#f] as @cpp{NULL} and vice-versa.} @scheme[#f] as @cpp{NULL} and vice-versa.}
@defthing[_path ctype?]{ @defthing[_path ctype?]{
Simple @cpp{char*} strings, corresponding to Scheme's paths.} Simple @cpp{char*} strings, corresponding to Scheme's paths. As usual,
the types treat @scheme[#f] as @cpp{NULL} and vice-versa.}
@defthing[_symbol ctype?]{ @defthing[_symbol ctype?]{

106
src/foreign/foreign.c
View File

@ -703,16 +703,6 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
#define FOREIGN_string_ucs_4 (18) #define FOREIGN_string_ucs_4 (18)
/* Type Name: string/ucs-4 (string_ucs_4) /* Type Name: string/ucs-4 (string_ucs_4)
* LibFfi type: ffi_type_pointer
* C type: mzchar*
* Predicate: SCHEME_CHAR_STRINGP(<Scheme>)
* Scheme->C: SCHEME_CHAR_STR_VAL(<Scheme>)
* S->C offset: 0
* C->Scheme: scheme_make_char_string_without_copying(<C>)
*/
#define FOREIGN_string_ucs_4_null (19)
/* Type Name: string/ucs-4/null (string_ucs_4_null)
* LibFfi type: ffi_type_pointer * LibFfi type: ffi_type_pointer
* C type: mzchar* * C type: mzchar*
* Predicate: SCHEME_FALSEP_OR_CHAR_STRINGP(<Scheme>) * Predicate: SCHEME_FALSEP_OR_CHAR_STRINGP(<Scheme>)
@ -721,18 +711,8 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
* C->Scheme: scheme_make_char_string_without_copying(<C>) * C->Scheme: scheme_make_char_string_without_copying(<C>)
*/ */
#define FOREIGN_string_utf_16 (20) #define FOREIGN_string_utf_16 (19)
/* Type Name: string/utf-16 (string_utf_16) /* Type Name: string/utf-16 (string_utf_16)
* LibFfi type: ffi_type_pointer
* C type: unsigned short*
* Predicate: SCHEME_CHAR_STRINGP(<Scheme>)
* Scheme->C: ucs4_string_to_utf16_pointer(<Scheme>)
* S->C offset: 0
* C->Scheme: utf16_pointer_to_ucs4_string(<C>)
*/
#define FOREIGN_string_utf_16_null (21)
/* Type Name: string/utf-16/null (string_utf_16_null)
* LibFfi type: ffi_type_pointer * LibFfi type: ffi_type_pointer
* C type: unsigned short* * C type: unsigned short*
* Predicate: SCHEME_FALSEP_OR_CHAR_STRINGP(<Scheme>) * Predicate: SCHEME_FALSEP_OR_CHAR_STRINGP(<Scheme>)
@ -744,7 +724,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* Byte strings -- not copying C strings, #f is NULL. /* Byte strings -- not copying C strings, #f is NULL.
* (note: these are not like char* which is just a pointer) */ * (note: these are not like char* which is just a pointer) */
#define FOREIGN_bytes (22) #define FOREIGN_bytes (20)
/* Type Name: bytes /* Type Name: bytes
* LibFfi type: ffi_type_pointer * LibFfi type: ffi_type_pointer
* C type: char* * C type: char*
@ -754,7 +734,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
* C->Scheme: (<C>==NULL)?scheme_false:scheme_make_byte_string_without_copying(<C>) * C->Scheme: (<C>==NULL)?scheme_false:scheme_make_byte_string_without_copying(<C>)
*/ */
#define FOREIGN_path (23) #define FOREIGN_path (21)
/* Type Name: path /* Type Name: path
* LibFfi type: ffi_type_pointer * LibFfi type: ffi_type_pointer
* C type: char* * C type: char*
@ -764,7 +744,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
* C->Scheme: (<C>==NULL)?scheme_false:scheme_make_path_without_copying(<C>) * C->Scheme: (<C>==NULL)?scheme_false:scheme_make_path_without_copying(<C>)
*/ */
#define FOREIGN_symbol (24) #define FOREIGN_symbol (22)
/* Type Name: symbol /* Type Name: symbol
* LibFfi type: ffi_type_pointer * LibFfi type: ffi_type_pointer
* C type: char* * C type: char*
@ -777,7 +757,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* This is for any C pointer: #f is NULL, cpointer values as well as /* This is for any C pointer: #f is NULL, cpointer values as well as
* ffi-obj and string values pass their pointer. When used as a return * ffi-obj and string values pass their pointer. When used as a return
* value, either a cpointer object or #f is returned. */ * value, either a cpointer object or #f is returned. */
#define FOREIGN_pointer (25) #define FOREIGN_pointer (23)
/* Type Name: pointer /* Type Name: pointer
* LibFfi type: ffi_type_pointer * LibFfi type: ffi_type_pointer
* C type: void* * C type: void*
@ -789,7 +769,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* This is used for passing and Scheme_Object* value as is. Useful for /* This is used for passing and Scheme_Object* value as is. Useful for
* functions that know about Scheme_Object*s, like MzScheme's. */ * functions that know about Scheme_Object*s, like MzScheme's. */
#define FOREIGN_scheme (26) #define FOREIGN_scheme (24)
/* Type Name: scheme /* Type Name: scheme
* LibFfi type: ffi_type_pointer * LibFfi type: ffi_type_pointer
* C type: Scheme_Object* * C type: Scheme_Object*
@ -802,7 +782,7 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* Special type, not actually used for anything except to mark values /* Special type, not actually used for anything except to mark values
* that are treated like pointers but not referenced. Used for * that are treated like pointers but not referenced. Used for
* creating function types. */ * creating function types. */
#define FOREIGN_fpointer (27) #define FOREIGN_fpointer (25)
/* Type Name: fpointer /* Type Name: fpointer
* LibFfi type: ffi_type_pointer * LibFfi type: ffi_type_pointer
* C type: void* * C type: void*
@ -830,9 +810,7 @@ typedef union _ForeignAny {
double x_doubleS; double x_doubleS;
int x_bool; int x_bool;
mzchar* x_string_ucs_4; mzchar* x_string_ucs_4;
mzchar* x_string_ucs_4_null;
unsigned short* x_string_utf_16; unsigned short* x_string_utf_16;
unsigned short* x_string_utf_16_null;
char* x_bytes; char* x_bytes;
char* x_path; char* x_path;
char* x_symbol; char* x_symbol;
@ -842,7 +820,7 @@ typedef union _ForeignAny {
} ForeignAny; } ForeignAny;
/* This is a tag that is used to identify user-made struct types. */ /* This is a tag that is used to identify user-made struct types. */
#define FOREIGN_struct (28) #define FOREIGN_struct (26)
/*****************************************************************************/ /*****************************************************************************/
/* Type objects */ /* Type objects */
@ -963,9 +941,7 @@ static int ctype_sizeof(Scheme_Object *type)
case FOREIGN_doubleS: return sizeof(double); case FOREIGN_doubleS: return sizeof(double);
case FOREIGN_bool: return sizeof(int); case FOREIGN_bool: return sizeof(int);
case FOREIGN_string_ucs_4: return sizeof(mzchar*); case FOREIGN_string_ucs_4: return sizeof(mzchar*);
case FOREIGN_string_ucs_4_null: return sizeof(mzchar*);
case FOREIGN_string_utf_16: return sizeof(unsigned short*); case FOREIGN_string_utf_16: return sizeof(unsigned short*);
case FOREIGN_string_utf_16_null: return sizeof(unsigned short*);
case FOREIGN_bytes: return sizeof(char*); case FOREIGN_bytes: return sizeof(char*);
case FOREIGN_path: return sizeof(char*); case FOREIGN_path: return sizeof(char*);
case FOREIGN_symbol: return sizeof(char*); case FOREIGN_symbol: return sizeof(char*);
@ -1242,9 +1218,7 @@ static Scheme_Object *C2SCHEME(Scheme_Object *type, void *src,
case FOREIGN_doubleS: return scheme_make_double(REF_CTYPE(double)); case FOREIGN_doubleS: return scheme_make_double(REF_CTYPE(double));
case FOREIGN_bool: return (REF_CTYPE(int)?scheme_true:scheme_false); case FOREIGN_bool: return (REF_CTYPE(int)?scheme_true:scheme_false);
case FOREIGN_string_ucs_4: return scheme_make_char_string_without_copying(REF_CTYPE(mzchar*)); case FOREIGN_string_ucs_4: return scheme_make_char_string_without_copying(REF_CTYPE(mzchar*));
case FOREIGN_string_ucs_4_null: return scheme_make_char_string_without_copying(REF_CTYPE(mzchar*));
case FOREIGN_string_utf_16: return utf16_pointer_to_ucs4_string(REF_CTYPE(unsigned short*)); case FOREIGN_string_utf_16: return utf16_pointer_to_ucs4_string(REF_CTYPE(unsigned short*));
case FOREIGN_string_utf_16_null: return utf16_pointer_to_ucs4_string(REF_CTYPE(unsigned short*));
case FOREIGN_bytes: return (REF_CTYPE(char*)==NULL)?scheme_false:scheme_make_byte_string_without_copying(REF_CTYPE(char*)); case FOREIGN_bytes: return (REF_CTYPE(char*)==NULL)?scheme_false:scheme_make_byte_string_without_copying(REF_CTYPE(char*));
case FOREIGN_path: return (REF_CTYPE(char*)==NULL)?scheme_false:scheme_make_path_without_copying(REF_CTYPE(char*)); case FOREIGN_path: return (REF_CTYPE(char*)==NULL)?scheme_false:scheme_make_path_without_copying(REF_CTYPE(char*));
case FOREIGN_symbol: return scheme_intern_symbol(REF_CTYPE(char*)); case FOREIGN_symbol: return scheme_intern_symbol(REF_CTYPE(char*));
@ -1496,9 +1470,9 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, long delta,
delta += (sizeof(int)-sizeof(mzchar*)); delta += (sizeof(int)-sizeof(mzchar*));
} }
#endif #endif
if (SCHEME_CHAR_STRINGP(val)) { if (SCHEME_FALSEP_OR_CHAR_STRINGP(val)) {
mzchar* tmp; mzchar* tmp;
tmp = (mzchar*)(SCHEME_CHAR_STR_VAL(val)); tmp = (mzchar*)(ucs4_string_or_null_to_ucs4_pointer(val));
if (basetype_p == NULL ||tmp == NULL) { if (basetype_p == NULL ||tmp == NULL) {
(((mzchar**)W_OFFSET(dst,delta))[0]) = tmp; (((mzchar**)W_OFFSET(dst,delta))[0]) = tmp;
return NULL; return NULL;
@ -1510,54 +1484,12 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, long delta,
scheme_wrong_type("Scheme->C","string/ucs-4",0,1,&(val)); scheme_wrong_type("Scheme->C","string/ucs-4",0,1,&(val));
return NULL; /* hush the compiler */ return NULL; /* hush the compiler */
} }
case FOREIGN_string_ucs_4_null:
#ifdef SCHEME_BIG_ENDIAN
if (sizeof(mzchar*)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(mzchar*));
}
#endif
if (SCHEME_FALSEP_OR_CHAR_STRINGP(val)) {
mzchar* tmp;
tmp = (mzchar*)(ucs4_string_or_null_to_ucs4_pointer(val));
if (basetype_p == NULL ||tmp == NULL) {
(((mzchar**)W_OFFSET(dst,delta))[0]) = tmp;
return NULL;
} else {
*basetype_p = FOREIGN_string_ucs_4_null;
return tmp;
}
} else {
scheme_wrong_type("Scheme->C","string/ucs-4/null",0,1,&(val));
return NULL; /* hush the compiler */
}
case FOREIGN_string_utf_16: case FOREIGN_string_utf_16:
#ifdef SCHEME_BIG_ENDIAN #ifdef SCHEME_BIG_ENDIAN
if (sizeof(unsigned short*)<sizeof(int) && ret_loc) { if (sizeof(unsigned short*)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0; ((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(unsigned short*)); delta += (sizeof(int)-sizeof(unsigned short*));
} }
#endif
if (SCHEME_CHAR_STRINGP(val)) {
unsigned short* tmp;
tmp = (unsigned short*)(ucs4_string_to_utf16_pointer(val));
if (basetype_p == NULL ||tmp == NULL) {
(((unsigned short**)W_OFFSET(dst,delta))[0]) = tmp;
return NULL;
} else {
*basetype_p = FOREIGN_string_utf_16;
return tmp;
}
} else {
scheme_wrong_type("Scheme->C","string/utf-16",0,1,&(val));
return NULL; /* hush the compiler */
}
case FOREIGN_string_utf_16_null:
#ifdef SCHEME_BIG_ENDIAN
if (sizeof(unsigned short*)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(unsigned short*));
}
#endif #endif
if (SCHEME_FALSEP_OR_CHAR_STRINGP(val)) { if (SCHEME_FALSEP_OR_CHAR_STRINGP(val)) {
unsigned short* tmp; unsigned short* tmp;
@ -1566,11 +1498,11 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, long delta,
(((unsigned short**)W_OFFSET(dst,delta))[0]) = tmp; (((unsigned short**)W_OFFSET(dst,delta))[0]) = tmp;
return NULL; return NULL;
} else { } else {
*basetype_p = FOREIGN_string_utf_16_null; *basetype_p = FOREIGN_string_utf_16;
return tmp; return tmp;
} }
} else { } else {
scheme_wrong_type("Scheme->C","string/utf-16/null",0,1,&(val)); scheme_wrong_type("Scheme->C","string/utf-16",0,1,&(val));
return NULL; /* hush the compiler */ return NULL; /* hush the compiler */
} }
case FOREIGN_bytes: case FOREIGN_bytes:
@ -2986,13 +2918,6 @@ void scheme_init_foreign(Scheme_Env *env)
t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_pointer)); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_pointer));
t->c_to_scheme = ((Scheme_Object*)FOREIGN_string_ucs_4); t->c_to_scheme = ((Scheme_Object*)FOREIGN_string_ucs_4);
scheme_add_global("_string/ucs-4", (Scheme_Object*)t, menv); scheme_add_global("_string/ucs-4", (Scheme_Object*)t, menv);
s = scheme_intern_symbol("string/ucs-4/null");
t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct));
t->so.type = ctype_tag;
t->basetype = (s);
t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_pointer));
t->c_to_scheme = ((Scheme_Object*)FOREIGN_string_ucs_4_null);
scheme_add_global("_string/ucs-4/null", (Scheme_Object*)t, menv);
s = scheme_intern_symbol("string/utf-16"); s = scheme_intern_symbol("string/utf-16");
t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct));
t->so.type = ctype_tag; t->so.type = ctype_tag;
@ -3000,13 +2925,6 @@ void scheme_init_foreign(Scheme_Env *env)
t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_pointer)); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_pointer));
t->c_to_scheme = ((Scheme_Object*)FOREIGN_string_utf_16); t->c_to_scheme = ((Scheme_Object*)FOREIGN_string_utf_16);
scheme_add_global("_string/utf-16", (Scheme_Object*)t, menv); scheme_add_global("_string/utf-16", (Scheme_Object*)t, menv);
s = scheme_intern_symbol("string/utf-16/null");
t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct));
t->so.type = ctype_tag;
t->basetype = (s);
t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_pointer));
t->c_to_scheme = ((Scheme_Object*)FOREIGN_string_utf_16_null);
scheme_add_global("_string/utf-16/null", (Scheme_Object*)t, menv);
s = scheme_intern_symbol("bytes"); s = scheme_intern_symbol("bytes");
t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct));
t->so.type = ctype_tag; t->so.type = ctype_tag;

14
src/foreign/foreign.ssc
View File

@ -653,13 +653,6 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
) )
(defctype 'string/ucs-4 (defctype 'string/ucs-4
'ftype "pointer"
'ctype "mzchar*"
'pred "SCHEME_CHAR_STRINGP"
's->c "SCHEME_CHAR_STR_VAL"
'c->s "scheme_make_char_string_without_copying")
(defctype 'string/ucs-4/null
'ftype "pointer" 'ftype "pointer"
'ctype "mzchar*" 'ctype "mzchar*"
'pred "SCHEME_FALSEP_OR_CHAR_STRINGP" 'pred "SCHEME_FALSEP_OR_CHAR_STRINGP"
@ -667,13 +660,6 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
'c->s "scheme_make_char_string_without_copying") 'c->s "scheme_make_char_string_without_copying")
(defctype 'string/utf-16 (defctype 'string/utf-16
'ftype "pointer"
'ctype "unsigned short*"
'pred "SCHEME_CHAR_STRINGP"
's->c "ucs4_string_to_utf16_pointer"
'c->s "utf16_pointer_to_ucs4_string")
(defctype 'string/utf-16/null
'ftype "pointer" 'ftype "pointer"
'ctype "unsigned short*" 'ctype "unsigned short*"
'pred "SCHEME_FALSEP_OR_CHAR_STRINGP" 'pred "SCHEME_FALSEP_OR_CHAR_STRINGP"