blob: c338aa7d0bf7be7f244e2887bbeca48ab7d6610f (
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
75
76
|
(import (scheme base)
(only (scheme file)
open-binary-output-file)
(only (scheme read)
read)
(only (csc compiler)
add-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)
(only (csc match)
match))
(define-flag *include* "include" (lambda (s) (cons s *include*)) '())
(define-flag *output* "output" string-copy "")
(define-flag *help* "help" bool-flag #f)
(define-flag *h* "h" 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.
--help,-h Print the usage message.
")
(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 (or *help* *h*)
(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))))
(add-library-search-dirs *include*)
(write-file *output* (compile (read-file input-file))))
(main)
|
