1 665c255d 2023-08-04 jrmu (defun make-sum (a1 a2)
 2 665c255d 2023-08-04 jrmu   (list a1 '+ a2))
 3 665c255d 2023-08-04 jrmu (defun make-product (m1 m2)
 4 665c255d 2023-08-04 jrmu   (list m1 '* m2))
 5 665c255d 2023-08-04 jrmu (defun sum? (x)
 6 665c255d 2023-08-04 jrmu   (and (consp x) (eql (cadr x) '+)))
 7 665c255d 2023-08-04 jrmu (defun addend (x)
 8 665c255d 2023-08-04 jrmu   (car x))
 9 665c255d 2023-08-04 jrmu (defun augend (s)
10 665c255d 2023-08-04 jrmu   (caddr s))
11 665c255d 2023-08-04 jrmu (defun product? (x)
12 665c255d 2023-08-04 jrmu   (and (consp x) (eql (cadr x) '*)))
13 665c255d 2023-08-04 jrmu (defun multiplier (s)
14 665c255d 2023-08-04 jrmu   (car s))
15 665c255d 2023-08-04 jrmu (defun multiplicand (s)
16 665c255d 2023-08-04 jrmu   (caddr s))
17 665c255d 2023-08-04 jrmu 
18 665c255d 2023-08-04 jrmu (defvar *stream* '() "Token stream")
19 665c255d 2023-08-04 jrmu (defun init-stream (stream)
20 665c255d 2023-08-04 jrmu   "Initialize the stream"
21 665c255d 2023-08-04 jrmu   (setq *stream* stream))
22 665c255d 2023-08-04 jrmu (defun next-token ()
23 665c255d 2023-08-04 jrmu   "Returns the next token of the stream"
24 665c255d 2023-08-04 jrmu   (car *stream*))
25 665c255d 2023-08-04 jrmu (defun scan ()
26 665c255d 2023-08-04 jrmu   (pop *stream*))
27 665c255d 2023-08-04 jrmu (defvar *stream-stack* '() "Stack of streams")
28 665c255d 2023-08-04 jrmu (defun push-stream (stream)
29 665c255d 2023-08-04 jrmu   "Push the current *stream* on stack, and set this tream as *stream*"
30 665c255d 2023-08-04 jrmu   (push *stream* *stream-stack*)
31 665c255d 2023-08-04 jrmu   (init-stream stream))
32 665c255d 2023-08-04 jrmu (defun pop-stream ()
33 665c255d 2023-08-04 jrmu   (init-stream (pop *stream-stack)))
34 665c255d 2023-08-04 jrmu (defun parse-factor ()
35 665c255d 2023-08-04 jrmu   (let ((tok (next-token)))
36 665c255d 2023-08-04 jrmu     (cond
37 665c255d 2023-08-04 jrmu       ((or (numberp tok) (sybolp tok))
38 665c255d 2023-08-04 jrmu        (scan)
39 665c255d 2023-08-04 jrmu        tok)
40 665c255d 2023-08-04 jrmu       ((listp tok)
41 665c255d 2023-08-04 jrmu        (push-strea tok)
42 665c255d 2023-08-04 jrmu        (let ((sum (parse-sum)))
43 665c255d 2023-08-04 jrmu 	 (pop-stream)
44 665c255d 2023-08-04 jrmu 	 (scan)
45 665c255d 2023-08-04 jrmu 	 sum))
46 665c255d 2023-08-04 jrmu       (t (error "Bad token in parse-atom -- ~A" tok)))))
47 665c255d 2023-08-04 jrmu (defun parse-term ()
48 665c255d 2023-08-04 jrmu   (let ((lfact (parse-factor)))
49 665c255d 2023-08-04 jrmu     (if (eq (next-token) '*)
50 665c255d 2023-08-04 jrmu 	(progn
51 665c255d 2023-08-04 jrmu 	  (scan)
52 665c255d 2023-08-04 jrmu 	  (let ((rterm (parse-term)))
53 665c255d 2023-08-04 jrmu 	    (list '* lfact rterm)))
54 665c255d 2023-08-04 jrmu 	lfact)))
55 665c255d 2023-08-04 jrmu (defun (parse-