haskeem-0.7.4: gendoc.scm

; Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>

; This file is part of haskeem.
; haskeem is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.

; haskeem is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
; GNU General Public License for more details.

; You should have received a copy of the GNU General Public License
; along with haskeem; if not, write to the Free Software
; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

; $Id: gendoc.scm,v 1.7 2009-06-19 00:54:26 uwe Exp $

; A small documentation generator: it reads the file "haskeem.doc" and
; processes its contents into the desired format... currently just a
; sorted list to stdout

; Put this stuff first, so that we don't include the (in part large) stuff
; defined below

(define fp (open-output-file "/tmp/bindings.dat"))
(dump-bindings fp)
(close-port fp)

; How to sort doc items: first by section, then within each section by name.
; Sections are are identified by one of a couple of keywords:
; "form", "function", "macro", "primitive", "data", or "port"

(define (type-map type)
  (case type
    (("form") 1)
    (("function" "primitive") 2)
    (("macro") 3)
    (("data" "port") 4)
    (else 5)))

(define (doc-sort d1 d2)
  (let* ((t1 (symbol->string (caar d1)))
	 (t2 (symbol->string (caar d2)))
	 (m1 (type-map t1))
	 (m2 (type-map t2))
	 (n1 (symbol->string (cadar d1)))
	 (n2 (symbol->string (cadar d2))))
    (or (< m1 m2)
	(and (= m1 m2) (string<? t1 t2))
	(and (= m1 m2) (string=? t1 t2) (string<? n1 n2)))))

(define doc-data (list-sort doc-sort (read-all "haskeem.doc")))

(define (show item)
  (let ((sect (symbol->string (caar item)))
	(args (assv 'args item))
	(ret (assv 'return item)))
    (unless (string=? section sect)
	    (begin (set! section sect)
		   (write-string "\nSection " sect ":\n\n")))
    (write-string "    " (symbol->string (cadar item)) ": takes args ")
    (if args
	(display (cdr args))
	(write-string "<none>"))
    (write-string ", returns ")
    (if ret
	(display (cdr ret))
	(write-string "<nothing>"))
    (write-string #\linefeed)))

(define section)

(map show doc-data)

(define (find-in-doc docs name)
  (cond ((null? docs) '())
	((string=? name (symbol->string (cadaar docs))) (car docs))
	(else (find-in-doc (cdr docs) name))))

; Add this to the list, since we newly defined it above
; before dumping the bindings

(set! doc-data (cons '((port fp)) doc-data))

; TODO: check type of item against what's in doc-data

(define (check item)
  (unless (char-whitespace? (car (string->char item)))
	  (let* ((tmp (string-split-by char-whitespace? item))
		 (name (car tmp))
		 (info (cddr tmp))
		 (entry (find-in-doc doc-data name)))
	    (when (null? entry)
		  (write-string "    " name #\linefeed)))))

(define (do-lines fp)
  (let ((cur (read-line fp)))
    (when cur
	  (check cur)
	  (do-lines fp))))

(write-string "\nTo be checked:\n\n")

(set! fp (open-input-file "/tmp/bindings.dat"))
(do-lines fp)
(write-string #\newline)
(remove-file "/tmp/bindings.dat")