1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: read-macro.lisp
6 ;;;; Purpose: Lisp Markup Language functions
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Aug 2002
10 ;;;; $Id: read-macro.lisp,v 1.3 2003/06/17 17:50:45 kevin Exp $
12 ;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; LML users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the GNU General Public License v2
16 ;;;; (http://www.gnu.org/licenses/gpl.html)
17 ;;;; *************************************************************************
22 (set-macro-character #\[
23 #'(lambda (stream char)
24 (declare (ignore char))
26 (curr-string (new-string))
29 (declare (type fixnum paren-level))
30 (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
34 ;; Starting top-level ,(
37 (setf curr-string (coerce curr-string `(simple-array character (*))))
39 (push `(lml-princ ,curr-string) forms)
40 (setq curr-string (new-string))
42 (vector-push #\( curr-string)
43 (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
44 ((and (eql ch #\)) (zerop paren-level)))
46 (format *trace-output* "Syntax error reading #\]")
53 (vector-push-extend ch curr-string))
54 (vector-push-extend #\) curr-string)
55 (let ((eval-string (read-from-string curr-string))
58 `(let ((,res ,eval-string))
62 (setq curr-string (new-string)))
63 ;; read comma, then non #\( char
67 (vector-push-extend #\, curr-string) ;; push previous command
68 (vector-push-extend ch curr-string)))
69 ;; previous character is not a comma
74 (vector-push-extend ch curr-string)))))
77 (setf curr-string (coerce curr-string `(simple-array character (*))))
79 (push `(lml-princ ,curr-string) forms)
80 `(progn ,@(nreverse forms)))))