;;;; chicken-bind.scm - Standalone wrapper generator

(module chicken-bind ()

(import scheme (chicken port))
(import srfi-1)
(import bind-translator)
(import (chicken pathname) (chicken io) (chicken base) (chicken port))
(import (chicken irregex) (chicken process-context))
(import (chicken pretty-print))

(define (usage #!optional (status 0))
  (print #<<EOF
usage: chicken-bind [OPTION | FILENAME ...]

  -help              show this message
  -o FILENAME        where to write generated code to ("-" means stdout)
  -debug             generate additional debug output
  -export-constants  add toplevel definitions for constants
  -class-finalizers  use finalizers for class instances
  -mutable-fields    instance fields are mutable
  -rename FROM:TO    define renaming rule
  -rename-regex FROM:TO  define renaming rule for matching regular expression
  -prefix PREFIX     prefix to be used for names
  -full-specialization       specialize methods on all arguments
  -default-renaming PREFIX   use default renaming rules
  -follow-include    recursively process #include'd files
  -parse             just emit parsed "chunks" of tokens

Reads C/C++ files and generates Scheme wrapper code.
Specifying "-" as filename reads from stdin.
EOF
) (exit status) )

(define (main args)
  (let ((files '())
	(chunkify-only #f)
	(output #f))
    (let loop ((args args))
      (unless (null? args)
	(let ((arg (car args))
	      (rest (cdr args)))
	  (cond ((string=? "-debug" arg)
		 (set! debugging-chicken '(C X))
		 (loop rest))
		((string=? "-export-constants" arg)
		 (set-bind-options export-constants: #t)
		 (loop rest))
		((string=? "-mutable-fields" arg)
		 (set-bind-options mutable-fields: #t)
		 (loop rest))
		((string=? "-full-specialization" arg)
		 (set-bind-options full-specialization: #t)
		 (loop rest))
		((string=? "-follow-include" arg)
		 (set-bind-options follow-include: #t)
		 (loop rest))
		((string=? "-default-renaming" arg)
		 (unless (pair? rest) (usage 1))
		 (set-bind-options default-renaming: (car rest))
		 (loop (cdr rest)))
		((string=? "-prefix" arg)
		 (unless (pair? rest) (usage 1))
		 (set-bind-options prefix: (car rest))
		 (loop (cdr rest)))
		((or (string=? "-rename-regex" arg) (string=? "-rename" arg))
		 (unless (pair? rest) (usage 1))
		 (let ((m (irregex-match "([^:]+):(.+)" (cadr args))))
		   (if m
		       (set-renaming (cadr m) (caddr m) regex: (string=? "-rename-regex" arg))
		       (usage 1))))
		((string=? "-o" arg)
		 (when (null? rest) (usage 1))
		 (set! output (car rest))
		 (loop (cdr rest)))
		((string=? "-parse" arg)
		 (set! chunkify-only #t)
		 (loop rest))
		((member arg '("--help" "-help" "-h"))
		 (usage 0) )
		((and (> (string-length arg) 1)
		      (char=? #\- (string-ref arg 0)) )
		 (usage 1) )
		(else 
		 (set! files (cons arg files))
		 (loop rest))))))
    (when (null? files) (usage 1))
    (when (and output (not (string=? "-" output)))
      (set! output (open-output-file output)))
    (for-each
     (lambda (f)
       (define (read-from-file-or-stdin)
         (if (string=? f "-")
             (read-string #f (current-input-port))
             (call-with-input-file f (lambda (p) (read-string #f p)))))
       (define (process)
	 (print "\n;;; GENERATED BY CHICKEN-BIND FROM " f #\newline)
	 (pp `(begin
		,@(parse-easy-ffi (read-from-file-or-stdin)
                                  identity
                                  chunkify-only
                                  f)))
	 (print "\n;;; END OF FILE"))
       (cond ((equal? "-" output) (process))
	     ((port? output)
	      (with-output-to-port output process))
	     (else 
	      (with-output-to-file (pathname-replace-extension f "scm")
		process) ) ))
     (reverse files) ) ) )

(main (command-line-arguments))

)