diff options
author | Andy Wingo <wingo@pobox.com> | 2023-11-15 10:18:37 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-11-15 10:44:21 +0100 |
commit | d08cc4f6e23f427b6d13fb63c27a5c8076533e85 (patch) | |
tree | 7a289d36536a7ba1bb67857e601f7556366c7805 /libguile/intrinsics.c | |
parent | 437e5ac43d89fbab902003dfce4e6982f350ffb5 (diff) | |
download | guile-d08cc4f6e23f427b6d13fb63c27a5c8076533e85.tar.gz |
Allow string->utf8 to constant-fold
* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
(*primitive-accessors*): Add string->utf8, utf8->string, and
string-utf8-length.
(primitive-module): New public function, moved here from (language
tree-il compile-bytecode).
* module/language/tree-il/compile-bytecode.scm: Use primitive-module
from (language tree-il primitives).
* module/language/tree-il/peval.scm (peval): A bugfix: load primitives
from their proper module. Allows bytevector primitives to fold.
* module/language/cps/guile-vm/reify-primitives.scm:
* module/language/cps/effects-analysis.scm:
* module/language/cps/types.scm
* module/language/tree-il/primitives.scm:
* module/language/tree-il/cps-primitives.scm:
* module/language/tree-il/effects.scm (make-effects-analyzer):
Add string->utf8, utf8->string, and string-utf8-length.
* module/language/tree-il/compile-cps.scm (string->utf8)
(string-utf8-length, utf8->string): New custom lowerers, including type
checks and an unboxed result for string-utf8-length.
* module/system/vm/assembler.scm:
* libguile/intrinsics.h:
* libguile/intrinsics.c: Because string-utf8-length returns an unboxed
value, we need an intrinsic for it; go ahead and add an intrinsic for
string->utf8 and utf8->string too, as we will likely be able to use
these in the future.
Diffstat (limited to 'libguile/intrinsics.c')
-rw-r--r-- | libguile/intrinsics.c | 54 |
1 files changed, 33 insertions, 21 deletions
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index 837464709..99c044cbd 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -26,6 +26,7 @@ #include "alist.h" #include "atomics-internal.h" #include "boolean.h" +#include "bytevectors.h" #include "cache-internal.h" #include "extensions.h" #include "fluids.h" @@ -36,6 +37,7 @@ #include "keywords.h" #include "modules.h" #include "numbers.h" +#include "strings.h" #include "struct.h" #include "symbols.h" #include "threads.h" @@ -560,6 +562,26 @@ struct_set_x_immediate (SCM x, uint8_t idx, SCM z) scm_struct_set_x (x, scm_from_uint8 (idx), z); } +static uint64_t +string_utf8_length (SCM str) +{ + return scm_c_string_utf8_length (str); +} + +#if INDIRECT_INT64_INTRINSICS +static void +indirect_string_utf8_length (uint64_t *dst, SCM str) +{ + *dst = string_utf8_length (str); +} +#endif + +#if INDIRECT_INT64_INTRINSICS +#define INT64_INTRINSIC(name) indirect_##name +#else +#define INT64_INTRINSIC(name) name +#endif + void scm_bootstrap_intrinsics (void) { @@ -581,19 +603,11 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.symbol_to_keyword = scm_symbol_to_keyword; scm_vm_intrinsics.class_of = scm_class_of; scm_vm_intrinsics.scm_to_f64 = scm_to_double; -#if INDIRECT_INT64_INTRINSICS - scm_vm_intrinsics.scm_to_u64 = indirect_scm_to_uint64; - scm_vm_intrinsics.scm_to_u64_truncate = indirect_scm_to_uint64_truncate; - scm_vm_intrinsics.scm_to_s64 = indirect_scm_to_int64; - scm_vm_intrinsics.u64_to_scm = indirect_scm_from_uint64; - scm_vm_intrinsics.s64_to_scm = indirect_scm_from_int64; -#else - scm_vm_intrinsics.scm_to_u64 = scm_to_uint64; - scm_vm_intrinsics.scm_to_u64_truncate = scm_to_uint64_truncate; - scm_vm_intrinsics.scm_to_s64 = scm_to_int64; - scm_vm_intrinsics.u64_to_scm = scm_from_uint64; - scm_vm_intrinsics.s64_to_scm = scm_from_int64; -#endif + scm_vm_intrinsics.scm_to_u64 = INT64_INTRINSIC (scm_to_uint64); + scm_vm_intrinsics.scm_to_u64_truncate = INT64_INTRINSIC (scm_to_uint64_truncate); + scm_vm_intrinsics.scm_to_s64 = INT64_INTRINSIC (scm_to_int64); + scm_vm_intrinsics.u64_to_scm = INT64_INTRINSIC (scm_from_uint64); + scm_vm_intrinsics.s64_to_scm = INT64_INTRINSIC (scm_from_int64); scm_vm_intrinsics.logsub = logsub; scm_vm_intrinsics.wind = wind; scm_vm_intrinsics.unwind = unwind; @@ -603,13 +617,8 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.fluid_set_x = fluid_set_x; scm_vm_intrinsics.push_dynamic_state = push_dynamic_state; scm_vm_intrinsics.pop_dynamic_state = pop_dynamic_state; -#if INDIRECT_INT64_INTRINSICS - scm_vm_intrinsics.lsh = indirect_lsh; - scm_vm_intrinsics.rsh = indirect_rsh; -#else - scm_vm_intrinsics.lsh = lsh; - scm_vm_intrinsics.rsh = rsh; -#endif + scm_vm_intrinsics.lsh = INT64_INTRINSIC (lsh); + scm_vm_intrinsics.rsh = INT64_INTRINSIC (rsh); scm_vm_intrinsics.lsh_immediate = lsh_immediate; scm_vm_intrinsics.rsh_immediate = rsh_immediate; scm_vm_intrinsics.heap_numbers_equal_p = scm_i_heap_numbers_equal_p; @@ -659,6 +668,9 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.allocate_pointerless_words_with_freelist = allocate_pointerless_words_with_freelist; scm_vm_intrinsics.inexact = scm_exact_to_inexact; + scm_vm_intrinsics.string_to_utf8 = scm_string_to_utf8; + scm_vm_intrinsics.string_utf8_length = INT64_INTRINSIC (string_utf8_length); + scm_vm_intrinsics.utf8_to_string = scm_utf8_to_string; /* Intrinsics for the baseline compiler. */ scm_vm_intrinsics.car = scm_car; @@ -679,7 +691,7 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.struct_ref_immediate = struct_ref_immediate; scm_vm_intrinsics.struct_set_x_immediate = struct_set_x_immediate; scm_vm_intrinsics.symbol_to_string = scm_symbol_to_string; - + scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_intrinsics", (scm_t_extension_init_func)scm_init_intrinsics, |