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 /module/language/tree-il/compile-bytecode.scm | |
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 'module/language/tree-il/compile-bytecode.scm')
-rw-r--r-- | module/language/tree-il/compile-bytecode.scm | 44 |
1 files changed, 1 insertions, 43 deletions
diff --git a/module/language/tree-il/compile-bytecode.scm b/module/language/tree-il/compile-bytecode.scm index 2be2b1397..d98c40fe9 100644 --- a/module/language/tree-il/compile-bytecode.scm +++ b/module/language/tree-il/compile-bytecode.scm @@ -29,6 +29,7 @@ #:use-module (ice-9 match) #:use-module (language bytecode) #:use-module (language tree-il) + #:use-module ((language tree-il primitives) #:select (primitive-module)) #:use-module ((srfi srfi-1) #:select (filter-map fold lset-adjoin lset-union lset-difference)) @@ -348,49 +349,6 @@ (visit-immediate-tags define-immediate-type-predicate) (visit-heap-tags define-heap-type-predicate) -(define (primitive-module name) - (case name - ((bytevector? - bytevector-length - - bytevector-u8-ref bytevector-u8-set! - bytevector-s8-ref bytevector-s8-set! - - bytevector-u16-ref bytevector-u16-set! - bytevector-u16-native-ref bytevector-u16-native-set! - bytevector-s16-ref bytevector-s16-set! - bytevector-s16-native-ref bytevector-s16-native-set! - - bytevector-u32-ref bytevector-u32-set! - bytevector-u32-native-ref bytevector-u32-native-set! - bytevector-s32-ref bytevector-s32-set! - bytevector-s32-native-ref bytevector-s32-native-set! - - bytevector-u64-ref bytevector-u64-set! - bytevector-u64-native-ref bytevector-u64-native-set! - bytevector-s64-ref bytevector-s64-set! - bytevector-s64-native-ref bytevector-s64-native-set! - - bytevector-ieee-single-ref bytevector-ieee-single-set! - bytevector-ieee-single-native-ref bytevector-ieee-single-native-set! - bytevector-ieee-double-ref bytevector-ieee-double-set! - bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!) - '(rnrs bytevectors)) - ((atomic-box? - make-atomic-box atomic-box-ref atomic-box-set! - atomic-box-swap! atomic-box-compare-and-swap!) - '(ice-9 atomic)) - ((current-thread) '(ice-9 threads)) - ((class-of) '(oop goops)) - ((u8vector-ref - u8vector-set! s8vector-ref s8vector-set! - u16vector-ref u16vector-set! s16vector-ref s16vector-set! - u32vector-ref u32vector-set! s32vector-ref s32vector-set! - u64vector-ref u64vector-set! s64vector-ref s64vector-set! - f32vector-ref f32vector-set! f64vector-ref f64vector-set!) - '(srfi srfi-4)) - (else '(guile)))) - (define (canonicalize exp) (define (reify-primref src name) ;; some are builtin-ref |