;; extract documentation strings from gauche source
;;
;; process:
;; scan for several types of (function) definition:
;; - (define (fn args) "docstring" body)
;; - (define fn (lambda (args) "docstring" body))
;; - (define-method ...)
;; If types and variables can be documented, we'll need:
;; - (define-class ...)
;; - (define var value "docstring")
;;
;; Extract the `docstring' part if it is string?
;; Build a hashtable that contains (fn docstring) entries.
;; Other implementations subsequently store this hash in a dbm file
;; called DOC, e.g. in /usr/share/gauche/DOC.
;;
;; This works for .scm files, how to go about .c/.stub files?

(define (foo)
  "the answer to life, the universe, and everything"
  42)

(define (square x)
  "calculate the square of X"
  (* x x))

(define (roots a b c)
  "compute the roots of a*x^2 + b*x + c = 0"
  (let ((discriminant (sqrt (- (* b b) (* 4 a c)))))
    (values (/ (+ (- b) discriminant) (* 2 a))
            (/ (- (- b) discriminant) (* 2 a)))))

(define (file->sexp-list file . opts)
  (apply call-with-input-file file (pa$ port->list read) opts))

;; TODO discriminate between function and variable definitions
(define (gather-documentation . files)
  (let ((documentation '()))
    (dolist (file files)
      (dolist (sexp (file->sexp-list file))
        (let-optionals* sexp
            ((def-form #f)
             (lambda-list #f)
             (doc-string #f))
          (when (and (eq? def-form 'define)
                     (string? doc-string))
            (set! documentation (cons
                                 (cons (car lambda-list)
                                       (list (cdr lambda-list) doc-string))
                                 documentation))))))
    documentation))

;; ((symbol parameters documentation) ...)
(define documentation (gather-documentation "documentation.scm"))

;; TODO print emacs-like descriptions:
;; 'symbol' is a [function|variable] defined in 'filename'
;; (symbol p1 p2 p3)
;;
;; 'documentation'
(define (describe name)
  (let ((cell (assoc name documentation)))
    (if cell
        (format #t "(~s ~a): ~a\n"
                (car cell)
                (string-join (map symbol->string (cadr cell)) " ")
                (caddr cell))
        (format #t "No documentation for `~s'.\n" name))))

;; -----------------------------------------------------------------
(define-syntax unit-test
  (syntax-rules (=>)
    ((unit-test expr)
     (unit-test expr => #t))
    ((unit-test expr => result)
     (unless (equal? expr result)
       (format #t "failed: ~a => ~a, expected ~a\n" 'expr expr result)))))

(unit-test (assoc 'foo documentation) =>
           '(foo () "the answer to life, the universe, and everything"))
(unit-test (assoc 'square documentation) =>
           '(square (x) "calculate the square of X"))
(unit-test (assoc 'roots documentation) =>
           '(roots (a b c) "compute the roots of a*x^2 + b*x + c = 0"))