X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=lml.cl;h=ebf813af7c5e26c3ea2ffee3b15454ad4c21f17c;hb=46ab29f53744bd2e24360e108e1bf82d7ec676d1;hp=4f73fdb071206b0b592053669da37c8f35f64ca5;hpb=ce89c31a4ce6e52280e1a1f32ec9192c8b2bc9a2;p=lml.git diff --git a/lml.cl b/lml.cl index 4f73fdb..ebf813a 100644 --- a/lml.cl +++ b/lml.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Aug 2002 ;;;; -;;;; $Id: lml.cl,v 1.6 2002/09/16 09:36:27 kevin Exp $ +;;;; $Id: lml.cl,v 1.9 2002/09/16 09:58:57 kevin Exp $ ;;;; ;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -204,7 +204,8 @@ (set-macro-character #\[ #'(lambda (stream char) (declare (ignore char)) - (let ((curr-string (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character)) + (let ((forms '()) + (curr-string (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character)) (got-comma nil)) (do ((ch (read-char stream t nil t) (read-char stream t nil t))) ((eql ch #\])) @@ -212,7 +213,7 @@ (if (eql ch #\() ;; Starting top-level ,( (progn - (princ curr-string) + (push `(lml-print ,curr-string) forms) (setf (fill-pointer curr-string) 0) (setq got-comma nil) (vector-push #\( curr-string) @@ -223,7 +224,13 @@ (return nil)) (vector-push-extend ch curr-string)) (vector-push-extend #\) curr-string) - (princ (eval (read-from-string curr-string))) + (let ((eval-string (read-from-string curr-string)) + (result (gensym))) + (push + `(let ((,res ,eval-string)) + (when ,res + (lml-print ,res))) + forms)) (setf (fill-pointer curr-string) 0)) ;; read comma, then non #\( char (progn @@ -237,7 +244,7 @@ (progn (setq got-comma nil) (vector-push-extend ch curr-string))))) - (princ curr-string)) - t)) + (push `(lml-print ,curr-string) forms) + `(progn ,(nreverse forms)))))