blob: 1ac9267b1bf7a0633609fecfbc505ca08aad2d80 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
(import (scheme base)
(only (scheme read) read)
(prefix (scheme file) file.)
(prefix (scheme process-context) process-context.)
(prefix (csc compiler) compiler.))
(define (help)
(write-string "Usage: csc [-I path] [-o file] file.scheme" (current-error-port)))
(define (bad-usage)
(help)
(process-context.exit 1))
(define (read-program file)
(file.call-with-input-file file
(lambda (f)
(let loop ()
(define x (read f))
(if (eof-object? x)
'()
(cons x (loop)))))))
(define (write-file file bytes)
(call-with-port (file.open-binary-output-file file)
(lambda (w)
(write-bytevector bytes w))))
(define (main)
(define args (cdr (process-context.command-line)))
(define out "a.out")
(define library-paths '())
(let loop ()
(if (null? args)
(bad-usage)
(let ((arg (car args)))
(cond
((string=? "--" arg)
(set! args (cdr args))
#;break)
((or (string=? "" arg)
(string=? "-" arg)
(not (char=? #\- (string-ref arg 0))))
#;break)
(else
(set! args (cdr args))
(let ((opt (string-ref arg 1)))
(define (val)
(if (> (string-length arg) 2)
(string-copy arg 2)
(let ((val (car args)))
(set! args (cdr args))
val)))
(case opt
((#\I)
(set! library-paths (append library-paths (list (val)))))
((#\o)
(set! out (val)))
((#\h)
(help)
(process-context.exit 0))
(else (bad-usage))))
(loop))))))
(unless (= 1 (length args))
(bad-usage))
(write-file out
(compiler.compile (read-program (car args)) library-paths)))
(main)
|
