(define (make-grammar-rules)
  (clear-rules)
  (remember-grammar-rules
   ;; Grammar
   '((S) -> (NP ?agr) (VP ?agr))
   '((S) -> (NP ?agr) (VP ?agr) (PP))
   '((VP ?agr) -> (V ?agr) (PP))
   ;; Lexicon
   '((NP sg3) -> (he))
   '((PP) -> (he))
   '((VP sg3) -> (saw))
   '((V sg3) -> (saw))
   ))


(define (parse-s-backward input)
  (clear-assertions)
  (add-word-assertions 0 input)
  ;; This has to match the pattern of the full 
  (or (backchain `(S ?sem ?inv ?g0 ?g1 ?syn 0 ,(length input)))
      (backchain `(S ?syn 0 ,(length input))))
  (print-s-parses *assertions* (length input)))

(define (parse-backward)
  (if (and *rules* (not (null? *rules*)))
      (parse-loop parse-s-backward)
      (error "No rules, you need to make a grammar")))

(define (parse-s-forward input)
  (clear-assertions)
  (add-word-assertions 0 input)
  (chain)
  (print-s-parses *assertions* (length input)))

(define (parse-forward)
  (if (and *rules* (not (null? *rules*)))
      (parse-loop parse-s-forward)
      (error "No rules, you need to make a grammar")))

(define (parse-loop parse-action)
  (newline)
  (display* "Enter a sentence as a list, or (quit): ")
  (let ((input (read)))
    (cond ((equal? input '(quit))
	   (display* "Game over..."))
	  (else
	   (parse-action input)
	   ;; do it again
	   (parse-loop parse-action)))))

(define (add-word-assertions n words)
    (cond ((null? words) #f)
	  (else 
	   ;; every constituent has a "syntax feature", so we need to
	   ;; include one here, which is just the word again.
	   (remember-assertion `(,(first words) ,(first words) ,n ,(+ n 1)))
	   (add-word-assertions (+ n 1) (cdr words)))))

(define (print-s-parses assertions n)
  (if (null? assertions)
      #f
      (cond ((and (eq? 's (first (first assertions)))
		  (let ((l (length (first assertions))))
		    (equal? 0 (list-ref (first assertions) (- l 2)))
		    (equal? n (list-ref (first assertions) (- l 1)))))
	     (pp (first assertions))
	     (newline)
	     (cons (first assertions)
		   (print-s-parses (rest assertions) n)))
	    (else
	     (print-s-parses (rest assertions) n)))))

(define (get-s-parses assertions n)
  (if (null? assertions)
      '()
      (cond ((and (eq? 's (first (first assertions)))
		  (let ((l (length (first assertions))))
		    (equal? 0 (list-ref (first assertions) (- l 2)))
		    (equal? n (list-ref (first assertions) (- l 1)))))
	     (cons (first assertions)
		   (get-s-parses (rest assertions) n)))
	    (else
	     (get-s-parses (rest assertions) n)))))