reader.lisp

   1 ;;; To be integrated in lispstrack later
   2
   3 ;;; It is a basic Lisp reader. It does not use advanced stuff
   4 ;;; intentionally, because we want to use it to bootstrap a simple
   5 ;;; Lisp. The main entry point is the function `ls-read', which
   6 ;;; accepts a strings as argument and return the Lisp expression.
   7
   8 (defun concat (s1 s2)
   9   (concatenate 'string s1 s2))
  10
  11 (defun make-stream (string)
  12   (cons string 0))
  13
  14 (defun %peek-char (stream)
  15   (and (< (cdr stream) (length (car stream)))
  16        (char (car stream) (cdr stream))))
  17
  18 (defun %read-char (stream)
  19   (and (< (cdr stream) (length (car stream)))
  20        (prog1 (char (car stream) (cdr stream))
  21          (incf (cdr stream)))))
  22
  23 (defun whitespacep (ch)
  24   (or (char= ch #\space) (char= ch #\newline) (char= ch #\tab)))
  25
  26 (defun skip-whitespace (stream)
  27   (loop for ch = (%peek-char stream)
  28      while (whitespacep ch) do (%read-char stream)))
  29
  30 (defun terminalp (ch)
  31   (or (null ch) (whitespacep ch) (char= #\) ch)))
  32
  33 (defun read-until (stream func)
  34   (let ((string ""))
  35     (loop for ch = (%peek-char stream)
  36        until (funcall func ch)
  37        do (setq string (concat string (string ch)))
  38        do (%read-char stream))
  39     string))
  40
  41 (defun %read-delimited-list (stream last bq-level)
  42   (loop for ch = (prog2 (skip-whitespace stream)
  43                      (%peek-char stream))
  44      until (char= ch last)
  45      collect (ls-read-1 stream bq-level)
  46      finally (%read-char stream)))
  47
  48 (defun ls-read-1 (stream bq-level)
  49   (let ((ch (%peek-char stream)))
  50     (cond
  51       ((char= ch #\()
  52        (%read-char stream)
  53        (%read-delimited-list stream #\) bq-level))
  54       ((char= ch #\')
  55        (%read-char stream)
  56        (list 'quote (ls-read-1 stream bq-level)))
  57       ((char= ch #\`)
  58        (%read-char stream)
  59        (list 'backquote (ls-read-1 stream (1+ bq-level))))
  60       ((char= ch #\")
  61        (%read-char stream)
  62        (prog1 (read-until stream (lambda (ch) (char= ch #\")))
  63          (%read-char stream)))
  64       ((char= ch #\;)
  65        (read-until stream (lambda (ch) (or (null ch) (char= ch #\newline))))
  66        (%read-char stream)
  67        (ls-read-1 stream bq-level))
  68       ((char= ch #\,)
  69        (%read-char stream)
  70        (unless (plusp bq-level)
  71          (error "Comma not inside a backquote."))
  72        (list 'comma (ls-read-1 stream (1- bq-level))))
  73       (t
  74        (let ((string (read-until stream #'terminalp)))
  75          (if (every #'digit-char-p string)
  76              (parse-integer string)
  77              (intern (string-upcase string))))))))
  78
  79
  80 (defun ls-read (string)
  81   (ls-read-1 (make-stream string) 0))