;;; A recursive-descent parser in Winlisp, adaptated from the one in Common
;;; Lisp given in the February 1988 Byte 
;;; ("How lisp has changed" by David S. Touretzky)
;;; ==============================================

(defvar *grammar* 
  '((s          (np vp))
    (np         (nprop) (pro) (art adjlist n) (art n))
    (nprop      (john) (mary))
    (pro        (he) (she) (it))
    (art        (the) (a))
    (adjlist    (adj adjlist) (adj))
    (adj        (big) (little) (red) (tasty))
    (n          (boy) (girl) (ball) (pizza) (stick))
    (vp         (vi) (vt np) (vrel relc))
    (vi         (laughed) (sang))
    (vt         (threw) (kicked) (ate))
    (vrel       (saw) (said) (thought))
    (relc       (that s))))

(defun terminalp (x)
   (not (assoc x *grammar*)))

(defun parse (input)
   (car (parse-symbol 's input)))

(defun parse-symbol (sym input)
   (if (terminalp sym) 
       (parse-terminal sym input)
       (parse-nonterminal sym input)))

(defun parse-terminal (sym input)
   (if (eq sym (car input))
       (cons (list sym) (cdr input))
       ()))

;;; in this function, we use the tree binding of the "let" function to bind
;;; result and remainder to the cons returned by "parse-rule"
(defun parse-nonterminal (sym input)
   (let ((rule-seg (cassoc sym *grammar*)))
        (tag find-rule 
             (while rule-seg
                    (let (((result . remainder) 
                           (parse-rule (nextl rule-seg) input ())))
                         (if result
                             (exit find-rule 
                                   (cons (list (cons sym result))
                                         remainder)))))))))

(defun parse-rule (rule-seg input earlier-parse)
   (if (null rule-seg)
       (cons earlier-parse input)
       (let (((result . remainder) (parse-symbol (car rule-seg) input)))
            (if result
                (parse-rule (cdr rule-seg) remainder
                            (nconc earlier-parse result))))))


;;; now two examples of the parser use
;;; ==================================
(parse '(the boy ate a tasty little pizza))
((s (np (art the) (n boy)) 
    (vp (vt ate) 
        (np (art a)
            (adjlist (adj tasty) (adjlist (adj little))) 
            (n pizza)))))

(parse '(john said that mary kicked the ball))
((s (np (nprop john))
    (vp (vrel said)
        (relc that 
              (s (np (nprop mary))
                 (vp (vt kicked) 
                     (np (art the) (n ball))))))))