intern arbitrary constants

[bpt/guile.git] / module / language / bytecode / spec.scm

diff --git a/module/language/bytecode/spec.scm b/module/language/bytecode/spec.scm
index c2a6d46..d368f6e 100644 (file)
--- a/module/language/bytecode/spec.scm
+++ b/module/language/bytecode/spec.scm
@@ -1,6 +1,6 @@
-;;; Guile Lowlevel Intermediate Language
+;;; Bytecode
 
-;; Copyright (C) 2001, 2009, 2010, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2013 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
@@ -20,20 +20,24 @@
 
 (define-module (language bytecode spec)
   #:use-module (system base language)
-  #:use-module (system base target)
-  #:use-module (system vm objcode)
+  #:use-module (system vm loader)
+  #:use-module (ice-9 binary-ports)
   #:export (bytecode))
 
-(define (compile-objcode x e opts)
-  (values (bytecode->objcode x (target-endianness)) e e))
-
-(define (decompile-objcode x e opts)
-  (values (objcode->bytecode x (target-endianness)) e))
+(define (bytecode->value x e opts)
+  (let ((thunk (load-thunk-from-memory x)))
+    (if (eq? e (current-module))
+        ;; save a cons in this case
+        (values (thunk) e e)
+        (save-module-excursion
+         (lambda ()
+           (set-current-module e)
+           (values (thunk) e e))))))
 
 (define-language bytecode
-  #:title      "Guile Bytecode Vectors"
-  #:reader     (lambda (port env) (read port))
-  #:printer    write
-  #:compilers   `((objcode . ,compile-objcode))
-  #:decompilers `((objcode . ,decompile-objcode))
-  )
+  #:title      "Bytecode"
+  #:compilers   `((value . ,bytecode->value))
+  #:printer    (lambda (x port)
+                  (put-bytevector port (car x)))
+  #:reader      get-bytevector-all
+  #:for-humans? #f)