X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=2%2Fread-macro.lisp;fp=2%2Fread-macro.lisp;h=0000000000000000000000000000000000000000;hb=d69fd6931095af586a7ba72e0586330a436f0803;hp=0e173ebdbbb66547d757907ba59f7b3e55ce26a5;hpb=ffe053ab486b6e503513cf57f5321c61bd38b9c2;p=lml.git diff --git a/2/read-macro.lisp b/2/read-macro.lisp deleted file mode 100644 index 0e173eb..0000000 --- a/2/read-macro.lisp +++ /dev/null @@ -1,80 +0,0 @@ -;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: read-macro.lisp -;;;; Purpose: Lisp Markup Language functions -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Aug 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg. -;;;; Rights of modification and redistribution are in the LICENSE file. -;;;; -;;;; ************************************************************************* - -(in-package #:lml2) - -(defun new-string () - (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character)) - -(set-macro-character #\[ - #'(lambda (stream char) - (declare (ignore char)) - (let ((forms '()) - (curr-string (new-string)) - (paren-level 0) - (got-comma nil)) - (declare (type fixnum paren-level)) - (do ((ch (read-char stream t nil t) (read-char stream t nil t))) - ((eql ch #\])) - (if got-comma - (if (eql ch #\() - ;; Starting top-level ,( - (progn - #+cmu - (setf curr-string (coerce curr-string `(simple-array character (*)))) - - (push `(lml2-princ ,curr-string) forms) - (setq curr-string (new-string)) - (setq got-comma nil) - (vector-push #\( curr-string) - (do ((ch (read-char stream t nil t) (read-char stream t nil t))) - ((and (eql ch #\)) (zerop paren-level))) - (when (eql ch #\]) - (format *trace-output* "Syntax error reading #\]") - (return nil)) - (case ch - (#\( - (incf paren-level)) - (#\) - (decf paren-level))) - (vector-push-extend ch curr-string)) - (vector-push-extend #\) curr-string) - (let ((eval-string (read-from-string curr-string)) - (res (gensym))) - (push - `(let ((,res ,eval-string)) - (when ,res - (lml2-princ ,res))) - forms)) - (setq curr-string (new-string))) - ;; read comma, then non #\( char - (progn - (unless (eql ch #\,) - (setq got-comma nil)) - (vector-push-extend #\, curr-string) ;; push previous command - (vector-push-extend ch curr-string))) - ;; previous character is not a comma - (if (eql ch #\,) - (setq got-comma t) - (progn - (setq got-comma nil) - (vector-push-extend ch curr-string))))) - - #+cmu - (setf curr-string (coerce curr-string `(simple-array character (*)))) - - (push `(lml2-princ ,curr-string) forms) - `(progn ,@(nreverse forms)))))