[armedbear-cvs] r12325 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Jan  1 17:22:13 2010
New Revision: 12325

Log:
Create API for (SETF (STREAM-EXTERNAL-FORMAT ...) ...) from the lisp world.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Autoload.java
   trunk/abcl/src/org/armedbear/lisp/setf.lisp
   trunk/abcl/src/org/armedbear/lisp/stream_external_format.java

Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java	Fri Jan  1 17:22:13 2010
@@ -472,6 +472,7 @@
         autoload("stream-element-type", "stream_element_type");
         autoload("stream-error-stream", "StreamError");
         autoload("stream-external-format", "stream_external_format");
+        autoload("%set-stream-external-format", "stream_external_format");
         autoload("stringp", "StringFunctions");
         autoload("sxhash", "HashTableFunctions");
         autoload("sxhash", "HashTableFunctions");

Modified: trunk/abcl/src/org/armedbear/lisp/setf.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/setf.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/setf.lisp	Fri Jan  1 17:22:13 2010
@@ -238,3 +238,5 @@
 (defsetf readtable-case %set-readtable-case)
 
 (defsetf function-info %set-function-info)
+
+(defsetf stream-external-format %set-stream-external-format)
\ No newline at end of file

Modified: trunk/abcl/src/org/armedbear/lisp/stream_external_format.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/stream_external_format.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/stream_external_format.java	Fri Jan  1 17:22:13 2010
@@ -54,4 +54,17 @@
 
     private static final Primitive STREAM_EXTERNAL_FORMAT =
         new stream_external_format();
+
+    // DEFSETF-ed in 'setf.lisp'
+    private static final Primitive SET_STREAM_EXTERNAL_FORMAT =
+        new Primitive("%set-stream-external-format",
+                      PACKAGE_SYS, false, "stream external-format") {
+        @Override
+        public LispObject execute(LispObject stream, LispObject format) {
+            Stream s = checkStream(stream);
+            s.setExternalFormat(format);
+
+            return format;
+        }
+    };
 }