From: Ken Burgett Date: 2009-08-02T23:21:01+09:00 Subject: Re: RUBY vs COMMON LISP --0016368e24fcbdf3b20470295c97 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: quoted-printable This is a vapid, silly discussion. Use whatever language you wish, but please don't bore the rest of us with it. Once you work out self parsing to your satisfaction, count the number of angels that can dance on the head of a pin. 2009/8/2 I=F1aki Baz Castillo > El Domingo, 2 de Agosto de 2009, fft1976 escribi=F3: > > > (defstruct character-description > > > non-terminating-p > > > reader-macro > > > dispatching-macro-characters) > > > > > > (defstruct (simple-readtable (:constructor %make-simple-readtable)) > > > (default-character-description (make-character-description)) > > > (macro-characters (make-hash-table)) > > > (parse-token (function identity)) > > > (whitespaces #(#\space #\tab #\newline #\linefeed #\return #\page > > > #\vt))) > > > > > > (defun simple-get-macro-character (character &optional (readtable > > > *simple-readtable*)) (let ((description (or (gethash character > > > (simple-readtable-macro-characters readtable)) > > > (simple-readtable-default-character-description readtable)))) (values > > > (character-description-reader-macro description) > > > (character-description-non-terminating-p description)))) > > > > > > (defun simple-set-macro-character (character function &optional > > > non-terminating-p (readtable *simple-readtable*)) (setf (gethash > > > character (simple-readtable-macro-characters readtable)) > > > (make-character-description :non-terminating-p non-terminating-p > > > :reader-macro function)) > > > 't) > > > > > > (defun simple-get-dispatch-macro-character (character subchar > > > &optional (readtable > > > *simple-readtable*)) (setf subchar (char-upcase subchar)) > > > (let ((description (gethash character > > > (simple-readtable-macro-characters readtable)))) (unless (and > description > > > (character-description-dispatching-macro-characters > > > description)) (error "#\\~C is not a dispatching macro character" > > > character)) (gethash subchar > > > (character-description-dispatching-macro-characters description)))) > > > > > > (defun simple-set-dispatch-macro-character (character subchar functio= n > > > &optional (readtable > > > *simple-readtable*)) (setf subchar (char-upcase subchar)) > > > (let ((description (gethash character > > > (simple-readtable-macro-characters readtable)))) (when (or (null > > > description) > > > (null (character-description-dispatching-macro-characte= rs > > > description))) (setf (gethash character > > > (simple-readtable-macro-characters readtable)) > > > (make-character-description :non-terminating-p t > > > :reader-macro (function > > > simple-reader-dispatching-macro) :dispatching-macro-characters > > > (make-hash-table))))) (let ((description (gethash character > > > (simple-readtable-macro-characters readtable)))) (setf (gethash subch= ar > > > (character-description-dispatching-macro-characters description)) > > > function)) > > > 't) > > > > > > (defun simple-reader-dispatching-macro (character stream) > > > (let* ((subchar (read-char stream)) > > > (macro (simple-get-dispatch-macro-character character > > > subchar))) (assert macro () "~C~C is not a dispatching macro" charact= er > > > subchar) (funcall macro character subchar stream))) > > > > > > (defun simple-read-vector-dmacro (char subchar stream) > > > (declare (ignore char)) > > > (let ((contents (simple-read-list-macro subchar stream))) > > > (coerce contents 'vector))) > > > > > > (defvar *character-names* (list (cons "SPACE" (code-char 32)) > > > (cons "NEWLINE" (code-char 10)) > > > (cons "RETURN" (code-char 13)) > > > (cons "PAGE" (code-char 12)) > > > (cons "VT" (code-char 11)) > > > (cons "LINEFEED" (code-char 10)) > > > (cons "TAB" (code-char 9))) > > > "An a-list mapping character names to characters.") > > > > > > (defun simple-read-character-dmacro (char subchar stream) > > > (declare (ignore char subchar)) > > > (let ((object (read-char stream))) > > > (if (alpha-char-p (peek-char nil stream nil #\space)) > > > (loop > > > :with buffer =3D (make-array 8 :element-type 'character > > > :adjustable t :fill-pointer 1 :initial-element object) > > > :do (vector-push-extend (read-char stream) buffer) > > > :while (alpha-char-p (peek-char nil stream nil #\space)) > > > :finally (return (or (cdr (assoc (string-upcase buffer) > > > *character-names* :test (function string=3D))) (aref buffer 0)))) > > > object))) > > > > > > (defun simple-parse-token (buffer) > > > ;; We only deal with integers, keywords and symbols. > > > (or (ignore-errors (parse-integer buffer :junk-allowed nil)) > > > (if (char=3D #\: (aref buffer 0)) > > > (intern (string-upcase (subseq buffer (position #\: buffer > > > :test (function char/=3D)))) "KEYWORD") > > > ;; We don't deal with other packages in this simple > > > parse-token. (intern (string-upcase buffer))))) > > > > > > (defun simple-read-quote-macro (character stream) > > > (declare (ignore character)) > > > (list 'quote (simple-read stream))) > > > > > > (defun simple-read-list-macro (character stream) > > > (declare (ignore character)) > > > (loop > > > :until (char=3D #\) (peek-char t stream)) > > > :collect (simple-read stream) > > > :finally (read-char stream))) > > > > > > (defun simple-read-string-macro (character stream) > > > (handler-case > > > (loop > > > :with buffer =3D (make-array 8 :element-type 'character > > > :adjustable t :fill-pointer 0) :for ch =3D (read-char stream) > > > :until (char=3D character ch) > > > :do (vector-push-extend (if (char=3D #\\ ch) > > > (read-char stream) > > > ch) > > > buffer) > > > :finally (return (copy-seq buffer))))) > > > > > > (defun simple-read-comment-macro (character stream) > > > (declare (ignore character)) > > > (read-line stream) > > > (values)) > > > > > > (defun make-simple-readtable () > > > (let ((readtable > > > (%make-simple-readtable > > > :default-character-description (make-character-description > > > :non-terminating-p t) :parse-token (function simple-parse-token)))) > > > (simple-set-macro-character #\( (function simple-read-list-macro) > > > nil readtable) (simple-set-macro-character #\) nil > > > nil readtable) (simple-set-macro-character #\' (function > > > simple-read-quote-macro) nil readtable) (simple-set-macro-characte= r > > > #\" (function simple-read-string-macro) nil readtable) > > > (simple-set-macro-character #\; (function simple-read-comment-macro) > nil > > > readtable) (simple-set-dispatch-macro-character #\# #\\ (function > > > simple-read-character-dmacro) readtable) > > > (simple-set-dispatch-macro-character #\# #\( (function > > > simple-read-vector-dmacro) readtable) readtable)) > > > > > > (defparameter *simple-readtable* (make-simple-readtable)) > > > > > > (defun simple-read (&optional (stream *standard-input*) (eof-error-p = t) > > > eof-value) (peek-char t stream nil) > > > (let ((char (read-char stream nil nil))) > > > (cond > > > (char > > > (multiple-value-bind (macro non-terminating-p) > > > (simple-get-macro-character char) (if macro > > > (let ((object (multiple-value-list (funcall macro char > > > stream)))) (if object (first object) (simple-read stream eof-error-p > > > eof-value))) (loop > > > :with buffer =3D (make-array 8 :element-type 'charact= er > > > :adjustable t :fill-pointer 0) :for ch =3D (peek-char nil stream nil > > > #\space) > > > :initially (vector-push-extend char buffer) > > > :until (or (position ch (simple-readtable-whitespaces > > > *simple-readtable*)) (not (nth-value 1 (simple-get-macro-character > ch)))) > > > :do (vector-push-extend (read-char stream eof-error-p eof-value) > buffer) > > > :finally (return (funcall (simple-readtable-parse-token > > > *simple-readtable*) buffer)))))) > > > (eof-error-p (error 'end-of-file :stream stream)) > > > (t eof-value)))) > > > Is the above a language or a list of home tasks? > > -- > I=F1aki Baz Castillo > > --=20 Regards, Ken Seek wisdom through disbelief --0016368e24fcbdf3b20470295c97--