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.1 2003/04/27 17:53:16 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 ;;;; *************************************************************************
19 (declaim (optimize (debug 3) (speed 3) (safety 3) (compilation-speed 0)))
23 (set-macro-character #\[
24 #'(lambda (stream char)
25 (declare (ignore char))
27 (curr-string (new-string))
30 (declare (type fixnum paren-level))
31 (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
35 ;; Starting top-level ,(
38 (setf curr-string (coerce curr-string `(simple-array character (*))))
40 (push `(lml-princ ,curr-string) forms)
41 (setq curr-string (new-string))
43 (vector-push #\( curr-string)
44 (do ((ch (read-char stream t nil t) (Read-char stream t nil t)))
45 ((and (eql ch #\)) (zerop paren-level)))
47 (format *trace-output* "Syntax error reading #\]")
54 (vector-push-extend ch curr-string))
55 (vector-push-extend #\) curr-string)
56 (let ((eval-string (read-from-string curr-string))
59 `(let ((,res ,eval-string))
63 (setq curr-string (new-string)))
64 ;; read comma, then non #\( char
68 (vector-push-extend #\, curr-string) ;; push previous command
69 (vector-push-extend ch curr-string)))
70 ;; previous character is not a comma
75 (vector-push-extend ch curr-string)))))
78 (setf curr-string (coerce curr-string `(simple-array character (*))))
80 (push `(lml-princ ,curr-string) forms)
81 `(progn ,@(nreverse forms)))))