This is the mail archive of the guile@cygnus.com mailing list for the guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: Serious eq? bug?


Wolfgang Hukriede <whukriede@ifm.uni-kiel.de> writes:

 > hjstein@bfr.co.il (Harvey J. Stein) wrote:
 > 
 > > That's annoying because case uses eq?
 > 
 > Cond is much nicer anyway. Doubt, I'd ever use "case".


The following would be more complex using cond.  It'd look ok with a
case-equal:

(define (usage)
  (displayl "Usage: extract.scm [options] file1.c file2.c ...
  Extracts documentation from specified C source code files.
  Documentation must be embedded according to SCWM conventions:
   - Functions declared with the SCWM_PROC macro will be documented.
     They can be immediately followed by comments of the form /**
     ... */, which will be assumed to document the preceeding
     SCWM_PROC.  Each SCWM_PROC should be followed by a FUNC_NAME
     define which matches the C function name given by the SCWM_PROC.
   - Comments of the form /** chapter_name : section_name ... */ will
     also be extracted.

  Options:
    -c, --check            Check documentation for reasonableness.
    -s file, --sgml file   Generate SGML and output to specified file.
    -p file, --proc file   Generate procedure listing and output to
                           specified file.
    -t file, --text file   Generate plain text output to specified
                           file.
    -a, --annotated-text   Output plain text with each line prefixed by
                           file:line_number:.
    -l, --ispell           Run ispell on documentation.  Currently
                           hangs when given full SCWM source code set.
    -h, -? --help          Display this info.

  If no flags are given, the default action is to check the files.
"))

(define (process-arg n func arg rest files actions)
  (cond ((= n 0)
	 (process-cmd-line rest files (cons (lambda (docs) (func docs)) actions)))
	((= n 1)
	 (cond ((null? rest)
		(displayl arg
			  " flag given without arguments.  Ignored.\n")
		(process-cmd-line rest files actions))
	       (else (process-cmd-line (cdr rest)
				       files
				       (cons (lambda (docs) (with-output-to-file (car rest)
							      (lambda () (func docs))))
					     actions)))))
	(else
	 (displayl "Internal error: process-arg only takes 0 or 1 as arg count\n"))))

(define (process-cmd-line args files actions)
  (call-with-current-continuation
   (lambda (ret)
     (cond ((null? args)
	    (if (null? files)
		(displayl "Error: You must specify at least one file.")
		(let ((docs (apply extract-docs-from-files (reverse files))))
		  (if (null? actions)
		      (check-docs docs)
		      (for-each (lambda (act)
				  (act docs))
				(reverse actions))))))
	   (else 
	    (case (string->symbol (car args))
		   ((-l --ispell)
		    (process-arg 0 ispell-text (car args) (cdr args) files actions))
		   ((-c --check)
		    (process-arg 0 check-docs (car args) (cdr args) files actions))
		   ((-s --sgml)
		    (process-arg 1
				 (lambda (d) (docs->sgml frontpiece d))
				 (car args) (cdr args) files actions))
		   ((-p --proc)
		    (process-arg 1 docs->proclist (car args) (cdr args) files actions))
		   ((-t --text)
		    (process-arg 1 docs->text (car args) (cdr args) files actions))
		   ((-a --annotated-text)
		    (process-arg 1 docs->annotated-text (car args) (cdr args) files actions))
		   ((-h -? --help)
		    (usage)
		    (ret '()))
		   (else
		    (process-cmd-line (cdr args) (cons (car args) files) actions))))))))

;;; Arg processing.
(cond ((or (null? (command-line))
	   (null? (cdr (command-line)))))
      ((null? (cddr (command-line)))
       (usage)
       (exit))
      (else 
       (process-cmd-line (cddr (command-line)) '() '())
       (exit)))

-- 
Harvey J. Stein
BFM Financial Research
hjstein@bfr.co.il