home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / winlisp.zip / LISPLIB.LZH / PARSER.WL < prev    next >
Lisp/Scheme  |  1989-09-22  |  3KB  |  74 lines
  1. ;;; A recursive-descent parser in Winlisp, adaptated from the one in Common
  2. ;;; Lisp given in the February 1988 Byte 
  3. ;;; ("How lisp has changed" by David S. Touretzky)
  4. ;;; ==============================================
  5.  
  6. (defvar *grammar* 
  7.   '((s          (np vp))
  8.     (np         (nprop) (pro) (art adjlist n) (art n))
  9.     (nprop      (john) (mary))
  10.     (pro        (he) (she) (it))
  11.     (art        (the) (a))
  12.     (adjlist    (adj adjlist) (adj))
  13.     (adj        (big) (little) (red) (tasty))
  14.     (n          (boy) (girl) (ball) (pizza) (stick))
  15.     (vp         (vi) (vt np) (vrel relc))
  16.     (vi         (laughed) (sang))
  17.     (vt         (threw) (kicked) (ate))
  18.     (vrel       (saw) (said) (thought))
  19.     (relc       (that s))))
  20.  
  21. (defun terminalp (x)
  22.    (not (assoc x *grammar*)))
  23.  
  24. (defun parse (input)
  25.    (car (parse-symbol 's input)))
  26.  
  27. (defun parse-symbol (sym input)
  28.    (if (terminalp sym) 
  29.        (parse-terminal sym input)
  30.        (parse-nonterminal sym input)))
  31.  
  32. (defun parse-terminal (sym input)
  33.    (if (eq sym (car input))
  34.        (cons (list sym) (cdr input))
  35.        ()))
  36.  
  37. ;;; in this function, we use the tree binding of the "let" function to bind
  38. ;;; result and remainder to the cons returned by "parse-rule"
  39. (defun parse-nonterminal (sym input)
  40.    (let ((rule-seg (cassoc sym *grammar*)))
  41.         (tag find-rule 
  42.              (while rule-seg
  43.                     (let (((result . remainder) 
  44.                            (parse-rule (nextl rule-seg) input ())))
  45.                          (if result
  46.                              (exit find-rule 
  47.                                    (cons (list (cons sym result))
  48.                                          remainder)))))))))
  49.  
  50. (defun parse-rule (rule-seg input earlier-parse)
  51.    (if (null rule-seg)
  52.        (cons earlier-parse input)
  53.        (let (((result . remainder) (parse-symbol (car rule-seg) input)))
  54.             (if result
  55.                 (parse-rule (cdr rule-seg) remainder
  56.                             (nconc earlier-parse result))))))
  57.  
  58.  
  59. ;;; now two examples of the parser use
  60. ;;; ==================================
  61. (parse '(the boy ate a tasty little pizza))
  62. ((s (np (art the) (n boy)) 
  63.     (vp (vt ate) 
  64.         (np (art a)
  65.             (adjlist (adj tasty) (adjlist (adj little))) 
  66.             (n pizza)))))
  67.  
  68. (parse '(john said that mary kicked the ball))
  69. ((s (np (nprop john))
  70.     (vp (vrel said)
  71.         (relc that 
  72.               (s (np (nprop mary))
  73.                  (vp (vt kicked) 
  74.                      (np (art the) (n ball))))))))