mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

Fix primitive reification for class-of, bytevector-u8-ref, etc

Browse source 
* module/language/cps/reify-primitives.scm (primitive-module): Not all
  primitives are bound in (guile).
This commit is contained in:
Andy Wingo 2013-10-30 21:08:38 +01:00
parent 4a39546bc4
commit 11eff82685
1 changed files with 29 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

30
module/language/cps/reify-primitives.scm
View file

@ -44,8 +44,36 @@
($primcall 'cached-module-box ($primcall 'cached-module-box
(module-sym name-sym public?-sym bound?-sym)))))))) (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) (define (primitive-ref name k)
(module-box #f '(guile) name #f #t (module-box #f (primitive-module name) name #f #t
(lambda (box) (lambda (box)
(build-cps-term (build-cps-term
($continue k ($primcall 'box-ref (box))))))) ($continue k ($primcall 'box-ref (box)))))))