projects
/
lml.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
0aef782
)
r2712: Auto commit for Debian build
author
Kevin M. Rosenberg
<kevin@rosenberg.net>
Mon, 16 Sep 2002 09:58:57 +0000
(09:58 +0000)
committer
Kevin M. Rosenberg
<kevin@rosenberg.net>
Mon, 16 Sep 2002 09:58:57 +0000
(09:58 +0000)
lml.cl
patch
|
blob
|
history
diff --git
a/lml.cl
b/lml.cl
index 6ad713cf9890c74339bdb98f80e1d7da6f14f730..ebf813af7c5e26c3ea2ffee3b15454ad4c21f17c 100644
(file)
--- a/
lml.cl
+++ b/
lml.cl
@@
-7,7
+7,7
@@
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: lml.cl,v 1.
8 2002/09/16 09:45:50
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
;;;;
;;;;
;;;; 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))
(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 #\]))
(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
(if (eql ch #\()
;; Starting top-level ,(
(progn
- (
lml-print curr-string
)
+ (
push `(lml-print ,curr-string) forms
)
(setf (fill-pointer curr-string) 0)
(setq got-comma nil)
(vector-push #\( curr-string)
(setf (fill-pointer curr-string) 0)
(setq got-comma nil)
(vector-push #\( curr-string)
@@
-223,9
+224,13
@@
(return nil))
(vector-push-extend ch curr-string))
(vector-push-extend #\) curr-string)
(return nil))
(vector-push-extend ch curr-string))
(vector-push-extend #\) curr-string)
- (let ((result (eval (read-from-string curr-string))))
- (when result
- (lml-print result)))
+ (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
(setf (fill-pointer curr-string) 0))
;; read comma, then non #\( char
(progn
@@
-239,7
+244,7
@@
(progn
(setq got-comma nil)
(vector-push-extend ch curr-string)))))
(progn
(setq got-comma nil)
(vector-push-extend ch curr-string)))))
- (
lml-print curr-string)
)
-
t
))
+ (
push `(lml-print ,curr-string) forms
)
+
`(progn ,(nreverse forms)))
))