; -*- scheme -*-
;;; Generate sentences from a grammar in a file, which contains
;;; productions like:
;;; (bnp -> (article noun) (article adjective noun))

(import (chicken random) (chicken process-context))
;; Hash table import:
(import srfi-69) ; install systemwide with `chicken-install [-s] srfi-69`
(define random pseudo-random-integer)

(define usage "Usage: 6rammar kawaii.6r  # kawaii.6r contains the grammar")
(if (not (= 1 (length (command-line-arguments))))
    (begin (display usage (current-error-port))
           (newline (current-error-port))
           (exit 1)))

;; Read in the grammar from the file.
(define grammar (make-hash-table))
(define top-nonterminal 'empty-grammar)
(call-with-input-file (car (command-line-arguments))
  (lambda (port)
    (let loop ()
      (let ((rule (read port)))
        (if (not (eof-object? rule))
            (begin (set! top-nonterminal (car rule))
                   (set! (hash-table-ref grammar (car rule)) (cddr rule))
                   (loop)))))))

;; Choose a random item from a list (for example, of alternatives for
;; a nonterminal.)
(define (choose-from lst)
  (list-ref lst (random (length lst))))

;; Build up known expansions one at a time and holding them in a table.
(define known-expansions (make-hash-table))
(define nonterminals (hash-table-keys grammar))
;; Initialize each nonterminal to no known expansions.  (Chicken has for-each.)
(for-each (lambda (name) (set! (hash-table-ref known-expansions name) '()))
          nonterminals)

;; Generate a new known expansion to add to the table.
(define (attempt-expanding nonterminal)
  (bottom-up-expand-list (choose-from (hash-table-ref grammar nonterminal))))

;; Expand a sequence of names of terminals or nonterminals by
;; expanding each one and appending them.
(define (bottom-up-expand-list names)
  (if (null? names) '()
    ;; Sometimes it’s just a single symbol rather than a list:
    (if (not (pair? names)) (bottom-up-expand-name names)
        (let ((head-expansion (bottom-up-expand-name (car names)))
              (tail-expansion (bottom-up-expand-list (cdr names))))
          (if (and head-expansion tail-expansion)
              (append head-expansion tail-expansion)
              #f)))))

;; Given a name that might be a terminal or nonterminal, return as a
;; list an expansion into terminals from those that have been produced
;; so far, or #f if it’s a nonterminal with no known expansions.
(define (bottom-up-expand-name name)
  (if (not (hash-table-exists? known-expansions name)) (list name)
      (let ((expansions (hash-table-ref known-expansions name)))
        (if (null? expansions) #f
            (choose-from expansions)))))

;; Attempt to expand a nonterminal and then add it to the table of
;; known expansions.
(define (add-expansion nonterminal)
  (let ((expansion (attempt-expanding nonterminal)))
    (if expansion
        (set! (hash-table-ref known-expansions nonterminal)
              (cons expansion
                    (hash-table-ref known-expansions nonterminal))))))

;; Accumulate 100 sentences in order to get some variety.  The first
;; sentence produced is likely to be something like (a strawberry of a
;; strawberry held a strawberry of a strawberry).
(let loop ()
  (if (< (length (hash-table-ref known-expansions top-nonterminal)) 100)
      (begin (add-expansion (choose-from nonterminals))
             (loop))))

;; Report on how many productions have been carried out successfully.
(display `(,(apply + (map length (hash-table-values known-expansions)))
           total productions expanded in all))
(newline)

;; Finally, display the latest sentence produced.
(display (car (hash-table-ref known-expansions top-nonterminal)))
(newline)