From faff7941ef38373e7df4f041ced16e95271a476e Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Thu, 20 Jun 2013 15:15:42 +0200 Subject: [PATCH] Very basic string stream to support codegen --- jscl.lisp | 1 + src/stream.lisp | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+) create mode 100644 src/stream.lisp 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))) -- 1.7.10.4