summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-01-07 23:40:59 +0100
committerAndy Wingo <wingo@pobox.com>2010-01-07 23:40:59 +0100
commit6c498233a1c6a75fbfc81471b94bdc89306879c3 (patch)
treec7e22da38d1679c2bba708fccbb4c2b2340a02e3
parent27219b32c740ba55d88697829e05bf58120b86d9 (diff)
downloadguile-6c498233a1c6a75fbfc81471b94bdc89306879c3.tar.gz
inline srfi-4 vector accessors
* module/language/tree-il/primitives.scm (*interesting-primitive-names*): Inline srfi-4 vector accessors.
-rw-r--r--module/language/tree-il/primitives.scm66
1 files changed, 63 insertions, 3 deletions
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 83eab6f55..848aa8df9 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -1,6 +1,6 @@
;;; open-coding primitive procedures
-;; Copyright (C) 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -23,6 +23,7 @@
#:use-module (rnrs bytevector)
#:use-module (system base syntax)
#:use-module (language tree-il)
+ #:use-module (srfi srfi-4)
#:use-module (srfi srfi-16)
#:export (resolve-primitives! add-interesting-primitive!
expand-primitives! effect-free-primitive?))
@@ -61,26 +62,31 @@
bytevector-u8-ref bytevector-u8-set!
bytevector-s8-ref bytevector-s8-set!
-
+ u8vector-ref u8vector-set! s8vector-ref s8vector-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!
+ u16vector-ref u16vector-set! s16vector-ref s16vector-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!
+ u32vector-ref u32vector-set! s32vector-ref s32vector-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!
+ u64vector-ref u64vector-set! s64vector-ref s64vector-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!))
+ bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
+ f32vector-ref f32vector-set! f64vector-ref f64vector-set!))
(define (add-interesting-primitive! name)
(hashq-set! *interesting-primitive-vars*
@@ -301,3 +307,57 @@
;; swap args
(define-primitive-expander variable-set! (var val)
(variable-set val var))
+
+(define-primitive-expander u8vector-ref (vec i)
+ (bytevector-u8-ref vec i))
+(define-primitive-expander u8vector-set! (vec i x)
+ (bytevector-u8-set! vec i x))
+(define-primitive-expander s8vector-ref (vec i)
+ (bytevector-s8-ref vec i))
+(define-primitive-expander s8vector-set! (vec i x)
+ (bytevector-s8-set! vec i x))
+
+(define-primitive-expander u16vector-ref (vec i)
+ (bytevector-u16-native-ref vec (* i 2)))
+(define-primitive-expander u16vector-set! (vec i x)
+ (bytevector-u16-native-set! vec (* i 2) x))
+(define-primitive-expander s16vector-ref (vec i)
+ (bytevector-s16-native-ref vec (* i 2)))
+(define-primitive-expander s16vector-set! (vec i x)
+ (bytevector-s16-native-set! vec (* i 2) x))
+
+(define-primitive-expander u32vector-ref (vec i)
+ (bytevector-u32-native-ref vec (* i 4)))
+(define-primitive-expander u32vector-set! (vec i x)
+ (bytevector-u32-native-set! vec (* i 4) x))
+(define-primitive-expander s32vector-ref (vec i)
+ (bytevector-s32-native-ref vec (* i 4)))
+(define-primitive-expander s32vector-set! (vec i x)
+ (bytevector-s32-native-set! vec (* i 4) x))
+
+(define-primitive-expander u64vector-ref (vec i)
+ (bytevector-u64-native-ref vec (* i 8)))
+(define-primitive-expander u64vector-set! (vec i x)
+ (bytevector-u64-native-set! vec (* i 8) x))
+(define-primitive-expander s64vector-ref (vec i)
+ (bytevector-s64-native-ref vec (* i 8)))
+(define-primitive-expander s64vector-set! (vec i x)
+ (bytevector-s64-native-set! vec (* i 8) x))
+
+(define-primitive-expander f32vector-ref (vec i)
+ (bytevector-ieee-single-native-ref vec (* i 4)))
+(define-primitive-expander f32vector-set! (vec i x)
+ (bytevector-ieee-single-native-set! vec (* i 4) x))
+(define-primitive-expander f32vector-ref (vec i)
+ (bytevector-ieee-single-native-ref vec (* i 4)))
+(define-primitive-expander f32vector-set! (vec i x)
+ (bytevector-ieee-single-native-set! vec (* i 4) x))
+
+(define-primitive-expander f64vector-ref (vec i)
+ (bytevector-ieee-double-native-ref vec (* i 8)))
+(define-primitive-expander f64vector-set! (vec i x)
+ (bytevector-ieee-double-native-set! vec (* i 8) x))
+(define-primitive-expander f64vector-ref (vec i)
+ (bytevector-ieee-double-native-ref vec (* i 8)))
+(define-primitive-expander f64vector-set! (vec i x)
+ (bytevector-ieee-double-native-set! vec (* i 8) x))