Add bytevector primitives to SF transformation rules.

diff --git a/src/sf/gconst.scm b/src/sf/gconst.scm
index 1ab4cc148260c9006602567c116a4aaf1b0f84e8..01e2bf885d7c1ddefea464be68232b5c3ffab25d 100644 (file)
--- a/src/sf/gconst.scm
+++ b/src/sf/gconst.scm
@@ -66,6 +66,10 @@ USA.
     (BIT-STRING? BIT-STRING?)
     (BIT-SUBSTRING-FIND-NEXT-SET-BIT BIT-SUBSTRING-FIND-NEXT-SET-BIT)
     (BIT-SUBSTRING-MOVE-RIGHT! BIT-SUBSTRING-MOVE-RIGHT!)
+    (BYTEVECTOR-LENGTH BYTEVECTOR-LENGTH)
+    (BYTEVECTOR-U8-REF BYTEVECTOR-U8-REF)
+    (BYTEVECTOR-U8-SET! BYTEVECTOR-U8-SET!)
+    (BYTEVECTOR? BYTEVECTOR?)
     (CAR CAR)
     (CDR CDR)
     (CELL-CONTENTS CELL-CONTENTS)

diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index 94ec9c8bfdc2e345aca274f15a0b3bf556f7ebc3..de17f87aa5eedc49044794dfdb74761d73b91382 100644 (file)
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -557,6 +557,13 @@ USA.
                        operands)
       #f))
 
+(define (make-bytevector-expansion expr operands block)
+  (if (and (pair? operands)
+          (null? (cdr operands)))
+      (make-combination expr block (ucode-primitive allocate-bytevector 1)
+                       operands)
+      #f))
+
 (define (not-expansion expr operands block)
   (if (and (pair? operands)
           (null? (cdr operands)))
@@ -749,6 +756,7 @@ USA.
            int:integer?
            intern
            list
+           make-bytevector
            make-string
            make-vector-8b
            ;; modulo   ; Compiler does not currently open-code it.
@@ -834,7 +842,7 @@ USA.
           exact-integer?-expansion
           intern-expansion
           list-expansion
-          make-string-expansion
+          make-bytevector-expansion
           make-string-expansion
           ;; modulo-expansion
           negative?-expansion