aboutsummaryrefslogtreecommitdiffstats
path: root/csc.csc
diff options
context:
space:
mode:
Diffstat (limited to 'csc.csc')
-rw-r--r--csc.csc76
1 files changed, 76 insertions, 0 deletions
diff --git a/csc.csc b/csc.csc
new file mode 100644
index 0000000..9dae75f
--- /dev/null
+++ b/csc.csc
@@ -0,0 +1,76 @@
+(import (scheme base)
+ (only (scheme file)
+ open-binary-output-file)
+ (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)
+ (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))))
+ (set! *library-search-dirs* *include*)
+ (write-file *output* (compile (read-file input-file))))
+
+
+(main)