while first approach
[jscl.git] / 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-whitespaces (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 skip-whitespaces-and-comments (stream)
42   (skip-whitespaces stream)
43   (when (char= (%peek-char stream) #\;)
44     (read-until stream (lambda (x) (eql x #\newline)))
45     (skip-whitespaces-and-comments stream)))
46
47 (defun %read-list (stream)
48   (skip-whitespaces-and-comments stream)
49   (let ((ch (%peek-char stream)))
50     (cond
51       ((char= ch #\))
52        (%read-char stream)
53        nil)
54       ((char= ch #\.)
55        (%read-char stream)
56        (prog1 (ls-read-1 stream)
57          (skip-whitespaces-and-comments stream)
58          (unless (char= (%read-char stream) #\))
59            (error "')' was expected."))))
60       (t
61        (cons (ls-read-1 stream) (%read-list stream))))))
62
63 (defun ls-read-1 (stream)
64   (let ((ch (%peek-char stream)))
65     (cond
66       ((char= ch #\()
67        (%read-char stream)
68        (%read-list stream))
69       ((char= ch #\')
70        (%read-char stream)
71        (list 'quote (ls-read-1 stream)))
72       ((char= ch #\`)
73        (%read-char stream)
74        (list 'backquote (ls-read-1 stream)))
75       ((char= ch #\")
76        (%read-char stream)
77        (prog1 (read-until stream (lambda (ch) (char= ch #\")))
78          (%read-char stream)))
79       ((char= ch #\;)
80        (read-until stream (lambda (ch) (or (null ch) (char= ch #\newline))))
81        (%read-char stream)
82        (ls-read-1 stream))
83       ((char= ch #\,)
84        (%read-char stream)
85        (list 'comma (ls-read-1 stream)))
86       (t
87        (let ((string (read-until stream #'terminalp)))
88          (if (every #'digit-char-p string)
89              (parse-integer string)
90              (intern (string-upcase string))))))))
91
92
93 (defun ls-read-from-string (string)
94   (ls-read-1 (make-stream string)))