(define (make-grammar-rules)
  (clear-assertions)
  (clear-rules)
  (remember-grammar-rules
   ;; Grammar
   '(:grule (NP ?agr) (VP ?agr) -> (S))
   '(:grule (NP ?agr) (VP ?agr) (PP) -> (S))
   '(:grule (Det ?agr) (N ?agr) -> (NP ?agr))
   '(:grule (Det ?agr) (N ?agr) (PP) -> (NP ?agr))
   '(:grule (V/tr ?agr) (NP ?any) -> (VP ?agr))
   '(:grule (V/tr ?agr) (NP ?any) (PP) -> (VP ?agr))
   '(:grule (V/itr ?agr) -> (VP ?agr))
   '(:grule (V/itr ?agr) (PP) -> (VP ?agr))
   '(:grule (P) (NP ?agr) -> (PP))
   ;; Lexicon
   '(:wrule he (NP sg3))
   '(:wrule saw (V/tr sg3))
   '(:wrule the (Det ?any))
   '(:wrule man (N sg3))
   '(:wrule hill (N sg3))
   '(:wrule telescope (N sg3))
   '(:wrule on (P))
   '(:wrule with (P))
   ;; Auxiliary
   '(r= if then (= ?x ?x))		; the IF part is empty. 
   ))

(define *verbose?* #f)

(define (parse input)
  (make-grammar-rules)
  (clear-assertions)
  (ask-top-level 
   `(S (? syn) ,input ())
   (lambda (bindings . assertions?)
     (if (not (null? assertions?))
	 (pretty-print (first assertions?)))
     (printf "Parsing for %a:\n" input)
     (pretty-print (lookup* '(? syn) bindings)))
   ))

(define (lookup* var bindings)
  (if (is-variable? var)
      (lookup* (lookup var bindings) bindings)
      (if (null? var)
	  '()
	  (if (pair? var)
	      (cons (lookup* (first var) bindings)
		    (lookup* (rest var) bindings))
	      var))))