source: project/release/5/bind/trunk/chicken-bind.scm @ 34025

Last change on this file since 34025 was 34025, checked in by felix winkelmann, 2 years ago

updated eggs with .egg files and changes from git repo, dropped .meta + .setup files, broke everything

File size: 3.3 KB
Line 
1;;;; chicken-bind.scm - Standalone wrapper generator
2
3
4(import scheme chicken)
5(import srfi-1)
6(import bind-translator)
7
8(define (usage #!optional (status 0))
9  (print #<<EOF
10usage: chicken-bind [OPTION | FILENAME ...]
11
12  -help              show this message
13  -o FILENAME        where to write generated code to ("-" means stdout)
14  -debug             generate additional debug output
15  -export-constants  add toplevel definitions for constants
16  -class-finalizers  use finalizers for class instances
17  -mutable-fields    instance fields are mutable
18  -rename FROM:TO    define renaming rule
19  -rename-regex FROM:TO  define renaming rule for matching regular expression
20  -prefix PREFIX     prefix to be used for names
21  -full-specialization       specialize methods on all arguments
22  -default-renaming PREFIX   use default renaming rules
23  -follow-include    recursively process #include'd files
24  -parse             just emit parsed "chunks" of tokens
25
26Reads C/C++ files and generates Scheme wrapper code.
27Specifying "-" as filename reads from stdin.
28EOF
29) (exit status) )
30
31(define (main args)
32  (let ((files '())
33        (chunkify-only #f)
34        (output #f))
35    (let loop ((args args))
36      (unless (null? args)
37        (let ((arg (car args))
38              (rest (cdr args)))
39          (cond ((string=? "-debug" arg)
40                 (set! debugging-chicken '(C X))
41                 (loop rest))
42                ((string=? "-export-constants" arg)
43                 (set-bind-options export-constants: #t)
44                 (loop rest))
45                ((string=? "-mutable-fields" arg)
46                 (set-bind-options mutable-fields: #t)
47                 (loop rest))
48                ((string=? "-full-specialization" arg)
49                 (set-bind-options full-specialization: #t)
50                 (loop rest))
51                ((string=? "-follow-include" arg)
52                 (set-bind-options follow-include: #t)
53                 (loop rest))
54                ((string=? "-default-renaming" arg)
55                 (unless (pair? rest) (usage 1))
56                 (set-bind-options default-renaming: (car rest))
57                 (loop (cdr rest)))
58                ((string=? "-prefix" arg)
59                 (unless (pair? rest) (usage 1))
60                 (set-bind-options prefix: (car rest))
61                 (loop (cdr rest)))
62                ((or (string=? "-rename-regex" arg) (string=? "-rename" arg))
63                 (unless (pair? rest) (usage 1))
64                 (let ((m (irregex-match "([^:]+):(.+)" (cadr args))))
65                   (if m
66                       (set-renaming (cadr m) (caddr m) regex: (string=? "-rename-regex" arg))
67                       (usage 1))))
68                ((string=? "-o" arg)
69                 (when (null? rest) (usage 1))
70                 (set! output (car rest))
71                 (loop (cdr rest)))
72                ((string=? "-parse" arg)
73                 (set! chunkify-only #t)
74                 (loop rest))
75                ((member arg '("--help" "-help" "-h"))
76                 (usage 0) )
77                ((and (> (string-length arg) 1)
78                      (char=? #\- (string-ref arg 0)) )
79                 (usage 1) )
80                (else
81                 (set! files (cons arg files))
82                 (loop rest))))))
83    (when (null? files) (usage 1))
84    (when (and output (not (string=? "-" output)))
85      (set! output (open-output-file output)))
86    (for-each
87     (lambda (f)
88       (define (process)
89         (print "\n;;; GENERATED BY CHICKEN-BIND FROM " f #\newline)
90         (pp `(begin
91                ,@(parse-easy-ffi
92                   (read-all
93                    (if (string=? f "-") 
94                        (current-input-port)
95                        f) )
96                   identity
97                   chunkify-only
98                   f)))
99         (print "\n;;; END OF FILE"))
100       (cond ((equal? "-" output) (process))
101             ((port? output)
102              (with-output-to-port output process))
103             (else
104              (with-output-to-file (pathname-replace-extension f "scm")
105                process) ) ))
106     (reverse files) ) ) )
107
108(main (command-line-arguments))
Note: See TracBrowser for help on using the repository browser.