blob: a67a5110a6674f3844dad0cfd98cda89a637758f (
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
|
(import (scheme base)
(only (scheme read)
read)
(only (csc compiler)
*library-search-dirs*)
compile
(only (csc flag)
*args*
bool-flag
define-flag
parse-error-flag
parse-error-msg
parse-error?
parse-flags)
(only (csc format)
printf)
(only (csc loop)
loop))
(define-flag *include* "include" (lambda (s) (cons s include)) '())
(define-flag *output* "output" string-copy "")
(define-flag *help* "help" bool-flag #f)
(define *help-msg*
"Usage: csc [OPTION]... [FILE]
--include DIRECTORY Search in the given directory for libraries.
This flag can be passed more than once.
--output FILE Write output to the given file. The default is
to immediately execute.
")
(define (read-file f)
(call-with-input-file f
(lambda (p)
(loop for expr = (read p)
until (eof-object? expr)
collect expr))))
(define (write-file f bytes)
(call-with-port (open-binary-output-file f)
(lambda (p)
(write-bytevector bytes p))))
(define (main)
(guard (e ((parse-error? e)
(printf "Error: could not parse flag {}: {}\n{}" (parse-error-flag e) (parse-error-msg e) *help-msg*)
(exit 2)))
(parse-flags))
(when *help*
(printf "{}" *help-msg*)
(exit 0))
(when (string=? "" *output*)
(printf "For now, the option --output is required. In the future, we will be able to execute code directly.\n")
(exit 2))
(define input-file (match *args*
((file) file)
(_ (printf "Error: must pass exactly one file to csc.\n{}" *help-msg*)
(exit 2))))
(set! *library-search-dirs* *include*)
(write-file *output* (compile (read-file input-file))))
|
