Very basic string stream to support codegen

diff --git a/jscl.lisp b/jscl.lisp
index 9aab8e3..8818677 100644 (file)
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -32,6 +32,7 @@
     ("array"            :target)
     ("string"           :target)
     ("sequence"         :target)
+    ("stream"           :target)
     ("print"            :target)
     ("package"          :target)
     ("misc"             :target)

diff --git a/src/stream.lisp b/src/stream.lisp
new file mode 100644 (file)
index 0000000..bd72cf9
--- /dev/null
+++ b/src/stream.lisp
@@ -0,0 +1,47 @@
+;;; stream.lisp ---
+
+;; copyright (C) 2012, 2013 David Vazquez
+;; Copyright (C) 2012 Raimon Grau
+
+;; JSCL is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; JSCL is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; TODO: Use structures to represent streams, but we would need
+;;; inheritance.
+
+(defvar *standard-output*)
+
+(defun streamp (x)
+  (and (vectorp x) (eq (aref x 0) 'stream)))
+
+(defun make-string-output-stream ()
+  (let ((buffer (make-string 0)))
+    (vector 'stream
+            ;; write-char
+            (lambda (ch)
+              (vector-push-extend ch buffer))
+            'string-stream
+            buffer)))
+
+(defun get-output-stream-string (stream)
+  (eq (aref stream 2) 'string-stream)
+  (prog1 (aref stream 3)
+    (aset stream 3 (make-string 0))))
+
+(defun write-char (char &optional (stream *standard-output*))
+  (funcall (aref stream 1) char))
+
+(defmacro with-output-to-string ((var) &body body)
+  `(let ((,var (make-string-output-stream)))
+     ,@body
+     (get-output-stream-string ,var)))