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/06/20 04:12:29 kevin Exp $
12 ;;;; This file, part of LML2, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; LML2 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 (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character))
24 (set-macro-character #\[
25 #'(lambda (stream char)
26 (declare (ignore char))
28 (curr-string (new-string))
31 (declare (type fixnum paren-level))
32 (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
36 ;; Starting top-level ,(
39 (setf curr-string (coerce curr-string `(simple-array character (*))))
41 (push `(lml2-princ ,curr-string) forms)
42 (setq curr-string (new-string))
44 (vector-push #\( curr-string)
45 (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
46 ((and (eql ch #\)) (zerop paren-level)))
48 (format *trace-output* "Syntax error reading #\]")
55 (vector-push-extend ch curr-string))
56 (vector-push-extend #\) curr-string)
57 (let ((eval-string (read-from-string curr-string))
60 `(let ((,res ,eval-string))
64 (setq curr-string (new-string)))
65 ;; read comma, then non #\( char
69 (vector-push-extend #\, curr-string) ;; push previous command
70 (vector-push-extend ch curr-string)))
71 ;; previous character is not a comma
76 (vector-push-extend ch curr-string)))))
79 (setf curr-string (coerce curr-string `(simple-array character (*))))
81 (push `(lml2-princ ,curr-string) forms)
82 `(progn ,@(nreverse forms)))))