diff --git a/bootstrap/1.2.7-read.lisp b/bootstrap/1.2.7-read.lisp new file mode 100644 index 0000000..5be7d2f --- /dev/null +++ b/bootstrap/1.2.7-read.lisp @@ -0,0 +1,188 @@ +;; TODO : ne gère pas les échappements "foo\"bar" etc. ni les #... + +(defun read (input-stream) + (let ((result-stack '()) + (result nil) + (char nil) + (stack '()) + (top-stack nil)) + (labels ((char-member (char chars) + (some (lambda (c) (char= char c)) chars)) + (pop-result () + (setq result (car result-stack)) + (setq result-stack (cdr result-stack))) + (push-val (val) + (push val result)) + (push-result () + (push result result-stack) + (setq result nil)) + (get-char () + (setq char (read-char input-stream nil nil)))) + (tagbody + start + (print 'start) + (get-char) + (push 'end stack) + (go read-any) + + read-any + (print 'read-any) + (push 'end-read-any stack) + read-any-loop + (print 'read-any-loop) + (print char) + (cond + ((not char) (go end-of-file)) + ((char= char #\() (go read-list)) + ((char= char #\)) (error "Paren mismatch.")) + ((char= char #\') (go read-quote)) + ((char= char #\;) (go read-comment)) + ((char= char #\") (go read-string)) + ((char= char #\#) (go read-sharp)) + ((char= char #\`) (go read-backquote)) + ((char= char #\,) (go read-unquote)) + ((char= char #\ ) (get-char) (go read-any-loop)) + ((char= char #\newline) (get-char) (go read-any-loop)) + (t (go read-symbol))) ;; \ and | and : fall into this. + end-read-any + (print 'end-read-any) + (go return) + + read-list + (print 'read-list) + (push-result) + read-list-loop + (print 'read-list-loop) + (get-char) + (push 'read-list-loop-2 stack) + (go read-any) + read-list-loop-2 + (print 'read-list-loop-2) + (unless (or (not char) (char= char #\))) + (go read-list-loop)) + (when (not char) + (error "EOF while reading a list")) + (push (reverse result) (car result-stack)) + (pop-result) + (go return) + + read-quote + (print 'read-quote) + (push-result) + (push-val 'quote) + (get-char) + (go read-quotes-content) + + read-quotes-content + (push 'end-read-quotes stack) + (go read-any) + end-read-quotes + (push (reverse result) (car result-stack)) + (pop-result) + (go return) + + read-comment + read-comment-loop + (get-char) + (unless (or (not char) (char= char #\newline)) + (go read-comment-loop)) + (unless (not char) + (get-char)) + (go return) + + read-string + (print 'read-symbol) + (get-char) + (push-result) + (go read-string-loop-start) + read-string-loop + (push-val char) + (get-char) + read-string-loop-start + (unless (or (not char) (char= char #\")) + (go read-string-loop)) + (when (not char) + (error "End of file while reading string.")) + (get-char) + (push (format nil "~{~a~}" (reverse result)) (car result-stack)) + (pop-result) + (go return) + + read-sharp + (error "niy") + + read-backquote + (print 'read-quote) + (push-result) + (push-val 'quasiquote) + (get-char) + (go read-quotes-content) + + read-unquote + (print 'read-quote) + (push-result) + (get-char) + (cond ((char= char #\@) + (get-char) + (push-val 'unquote-splice)) + ((char= char #\.) + (get-char) + (push-val 'unquote-destructive-splice)) + (t + (push-val 'unquote))) + (go read-quotes-content) + + read-symbol + (print 'read-symbol) + (push-result) + read-symbol-loop + (print 'read-symbol-loop) + (push-val char) + (get-char) + ;; Pas le # : '(a#(1 2)) => '(|a#| (1 2)), pas '(a #(1 2)) + (unless (or (not char) (char-member char '(#\( #\) #\' #\; #\" #\` #\, #\ #\newline))) + (go read-symbol-loop)) + (push (intern (format nil "~:@(~{~a~}~)" (reverse result))) (car result-stack)) + (pop-result) + (format t "stack : ~a" stack) + (go return) + + end-of-file + (print 'eof) + + return + (setq top-stack (car stack)) + (setq stack (cdr stack)) + (case top-stack + (start (go start)) + (read-any (go read-any)) + (end-read-any (go end-read-any)) + (read-list (go read-list)) + (read-list-loop (go read-list-loop)) + (read-list-loop-2 (go read-list-loop-2)) + (read-quote (go read-quote)) + (end-read-quotes (go end-read-quotes)) + (read-symbol (go read-symbol)) + (read-symbol-loop (go read-symbol-loop)) + (end-of-file (go end-of-file)) + (end (go end)) + (otherwise (error "bootstrap : read : Invalid return point on the stack : ~w" top-stack))) + end + (print 'end))) + (car result))) + +;; (my-read (make-string-input-stream "foo")) +;; (my-read (make-string-input-stream "'foo")) +;; (my-read (make-string-input-stream "(foo)")) +;; (my-read (make-string-input-stream "(foo bar)")) +;; (my-read (make-string-input-stream "(foo bar baz)")) +;; (my-read (make-string-input-stream "'(foo)")) +;; (my-read (make-string-input-stream "'(foo bar baz)")) + +;; (my-read (make-string-input-stream "`(,foo ,@bar ,.baz 'quux blop)")) + +;; (my-read (make-string-input-stream "'(foo bar;;quux +;; baz)")) + +;; (my-read (make-string-input-stream "'(foo bar;;quux aa +;; baz \"buz\" 'moo)")) diff --git a/bootstrap/core-meval.lisp b/bootstrap/core-meval.lisp index 82bd22e..0447288 100644 --- a/bootstrap/core-meval.lisp +++ b/bootstrap/core-meval.lisp @@ -1,2 +1,5 @@ (defvar fonctions-globales-importees '(car cdr cons)) ;; 15.1-conses + +(defvar constantes-globales-importees + '(nil t)) ;; 1.2.2 \ No newline at end of file