From 99c86296c13901e3149881e0fb7be5e37ac701d3 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 5 Jan 2017 12:16:05 -0800 Subject: [PATCH] Add bytevector primitives to SF transformation rules. --- src/sf/gconst.scm | 4 ++++ src/sf/usiexp.scm | 10 +++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/src/sf/gconst.scm b/src/sf/gconst.scm index 1ab4cc148..01e2bf885 100644 --- 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 94ec9c8bf..de17f87aa 100644 --- 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 -- 2.25.1