From 11eff826853a34bf0de205f13519659d4926d22c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 30 Oct 2013 21:08:38 +0100 Subject: [PATCH] Fix primitive reification for class-of, bytevector-u8-ref, etc * module/language/cps/reify-primitives.scm (primitive-module): Not all primitives are bound in (guile). --- module/language/cps/reify-primitives.scm | 30 +++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index 5c2725fed..2b1a1018a 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -44,8 +44,36 @@ ($primcall 'cached-module-box (module-sym name-sym public?-sym bound?-sym)))))))) +(define (primitive-module name) + (case name + ((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)) + ((class-of @slot-ref @slot-set!) '(oop goops)) + (else '(guile)))) + (define (primitive-ref name k) - (module-box #f '(guile) name #f #t + (module-box #f (primitive-module name) name #f #t (lambda (box) (build-cps-term ($continue k ($primcall 'box-ref (box)))))))