From: David Vázquez Date: Thu, 20 Jun 2013 13:15:42 +0000 (+0200) Subject: Very basic string stream to support codegen X-Git-Url: http://repo.macrolet.net/gitweb/?p=jscl.git;a=commitdiff_plain;h=faff7941ef38373e7df4f041ced16e95271a476e Very basic string stream to support codegen --- diff --git a/jscl.lisp b/jscl.lisp index 9aab8e3..8818677 100644 --- 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 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 . + +;;; 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)))