From 7671528ef629cebe3fa6ba0020fb3bcaaa26e472 Mon Sep 17 00:00:00 2001 From: David Vazquez Date: Sun, 16 Dec 2012 15:49:44 +0000 Subject: [PATCH] Integrate the reader in lispstrack.lisp --- lispstrack.lisp | 113 +++++++++++++++++++++++++++++++++++++++++++++++++++++-- reader.lisp | 101 ------------------------------------------------- 2 files changed, 110 insertions(+), 104 deletions(-) delete mode 100644 reader.lisp diff --git a/lispstrack.lisp b/lispstrack.lisp index 5bfd7eb..6fdbab4 100644 --- a/lispstrack.lisp +++ b/lispstrack.lisp @@ -12,6 +12,114 @@ :initial-value "")) +;;;; READER + +;;; It is a basic Lisp reader. It does not use advanced stuff +;;; intentionally, because we want to use it to bootstrap a simple +;;; Lisp. The main entry point is the function `ls-read', which +;;; accepts a strings as argument and return the Lisp expression. +(defun make-string-stream (string) + (cons string 0)) + +(defun %peek-char (stream) + (if (streamp stream) + (peek-char nil stream nil) + (and (< (cdr stream) (length (car stream))) + (char (car stream) (cdr stream))))) + +(defun %read-char (stream) + (if (streamp stream) + (read-char stream nil) + (and (< (cdr stream) (length (car stream))) + (prog1 (char (car stream) (cdr stream)) + (incf (cdr stream)))))) + +(defun whitespacep (ch) + (or (char= ch #\space) (char= ch #\newline) (char= ch #\tab))) + +(defun skip-whitespaces (stream) + (loop for ch = (%peek-char stream) + while (and ch (whitespacep ch)) + do (%read-char stream))) + +(defun terminalp (ch) + (or (null ch) (whitespacep ch) (char= #\) ch))) + +(defun read-until (stream func) + (let ((string "")) + (loop for ch = (%peek-char stream) + until (funcall func ch) + do (setq string (concat string (string ch))) + do (%read-char stream)) + string)) + +(defun skip-whitespaces-and-comments (stream) + (let (ch) + (skip-whitespaces stream) + (setq ch (%peek-char stream)) + (while (and ch (eql ch #\;)) + (read-until stream (lambda (x) (eql x #\newline))) + (skip-whitespaces stream) + (setq ch (%peek-char stream))))) + +(defun %read-list (stream) + (skip-whitespaces-and-comments stream) + (let ((ch (%peek-char stream))) + (cond + ((char= ch #\)) + (%read-char stream) + nil) + ((char= ch #\.) + (%read-char stream) + (skip-whitespaces-and-comments stream) + (prog1 (ls-read stream) + (unless (char= (%read-char stream) #\)) + (error "')' was expected.")))) + (t + (cons (ls-read stream) (%read-list stream)))))) + +(defvar *eof* (make-symbol "EOF")) +(defun ls-read (stream) + (skip-whitespaces-and-comments stream) + (let ((ch (%peek-char stream))) + (cond + ((null ch) + *eof*) + ((char= ch #\() + (%read-char stream) + (%read-list stream)) + ((char= ch #\') + (%read-char stream) + (list 'quote (ls-read stream))) + ((char= ch #\`) + (%read-char stream) + (list 'backquote (ls-read stream))) + ((char= ch #\") + (%read-char stream) + (prog1 (read-until stream (lambda (ch) (char= ch #\"))) + (%read-char stream))) + ((char= ch #\,) + (%read-char stream) + (if (eql (%peek-char stream) #\@) + (progn (%read-char stream) (list 'unquote-splicing (ls-read stream))) + (list 'unquote (ls-read stream)))) + ((char= ch #\#) + (%read-char stream) + (ecase (%read-char stream) + (#\' + (list 'function (ls-read stream))))) + (t + (let ((string (read-until stream #'terminalp))) + (if (every #'digit-char-p string) + (parse-integer string) + (intern (string-upcase string)))))))) + +(defun ls-read-from-string (string) + (ls-read (make-string-stream string))) + + +;;;; Compiler + (let ((counter 0)) (defun make-var-binding (symbol) (cons symbol (format nil "v~d" (incf counter))))) @@ -271,17 +379,16 @@ code) (setq *literals* nil)))) - (defun ls-compile-file (filename output) (with-open-file (in filename) (with-open-file (out output :direction :output :if-exists :supersede) (loop - for x = (read in nil) while x + for x = (ls-read in) + until (eq x *eof*) for compilation = (ls-compile-toplevel x) when compilation do (write-line (concat compilation "; ") out))))) ;;; Testing - (defun compile-test () (ls-compile-file "test.lisp" "test.js")) diff --git a/reader.lisp b/reader.lisp deleted file mode 100644 index d361e94..0000000 --- a/reader.lisp +++ /dev/null @@ -1,101 +0,0 @@ -;;; To be integrated in lispstrack later - -;;; It is a basic Lisp reader. It does not use advanced stuff -;;; intentionally, because we want to use it to bootstrap a simple -;;; Lisp. The main entry point is the function `ls-read', which -;;; accepts a strings as argument and return the Lisp expression. - -(defun concat (s1 s2) - (concatenate 'string s1 s2)) - -(defun make-stream (string) - (cons string 0)) - -(defun %peek-char (stream) - (and (< (cdr stream) (length (car stream))) - (char (car stream) (cdr stream)))) - -(defun %read-char (stream) - (and (< (cdr stream) (length (car stream))) - (prog1 (char (car stream) (cdr stream)) - (incf (cdr stream))))) - -(defun whitespacep (ch) - (or (char= ch #\space) (char= ch #\newline) (char= ch #\tab))) - -(defun skip-whitespaces (stream) - (loop for ch = (%peek-char stream) - while (whitespacep ch) do (%read-char stream))) - -(defun terminalp (ch) - (or (null ch) (whitespacep ch) (char= #\) ch))) - -(defun read-until (stream func) - (let ((string "")) - (loop for ch = (%peek-char stream) - until (funcall func ch) - do (setq string (concat string (string ch))) - do (%read-char stream)) - string)) - -(defun skip-whitespaces-and-comments (stream) - (skip-whitespaces stream) - (when (char= (%peek-char stream) #\;) - (read-until stream (lambda (x) (eql x #\newline))) - (skip-whitespaces-and-comments stream))) - -(defun %read-list (stream) - (skip-whitespaces-and-comments stream) - (let ((ch (%peek-char stream))) - (cond - ((char= ch #\)) - (%read-char stream) - nil) - ((char= ch #\.) - (%read-char stream) - (skip-whitespaces-and-comments stream) - (prog1 (ls-read-1 stream) - (unless (char= (%read-char stream) #\)) - (error "')' was expected.")))) - (t - (cons (ls-read-1 stream) (%read-list stream)))))) - -(defun ls-read-1 (stream) - (let ((ch (%peek-char stream))) - (cond - ((char= ch #\() - (%read-char stream) - (%read-list stream)) - ((char= ch #\') - (%read-char stream) - (list 'quote (ls-read-1 stream))) - ((char= ch #\`) - (%read-char stream) - (list 'backquote (ls-read-1 stream))) - ((char= ch #\") - (%read-char stream) - (prog1 (read-until stream (lambda (ch) (char= ch #\"))) - (%read-char stream))) - ((char= ch #\;) - (read-until stream (lambda (ch) (or (null ch) (char= ch #\newline)))) - (%read-char stream) - (ls-read-1 stream)) - ((char= ch #\,) - (%read-char stream) - (if (eql (%peek-char stream) #\@) - (progn (%read-char stream) (list 'splicing (ls-read-1 stream))) - (list 'comma (ls-read-1 stream)))) - ((char= ch #\#) - (%read-char stream) - (ecase (%read-char stream) - (#\' - (list 'function (ls-read-1 stream))))) - (t - (let ((string (read-until stream #'terminalp))) - (if (every #'digit-char-p string) - (parse-integer string) - (intern (string-upcase string)))))))) - - -(defun ls-read-from-string (string) - (ls-read-1 (make-stream string))) -- 1.7.10.4