Add dodgy uname based host OS detection

diff --git a/codegen.scm b/codegen.scm
index 2d60c0aed64c22d3f1933544bf1a5df7101ce62c..7c1c3a150727c969a991021fd2c3470e221f573e 100644 (file)
--- a/codegen.scm
+++ b/codegen.scm
@@ -1,7 +1,8 @@
 (load "typecheck.scm")
 (load "ast.scm")
+(load "platform.scm")
 
-(define target 'darwin)
+(define target host-os)
 
 (define (emit . s)
   (begin

diff --git a/main.scm b/main.scm
index ce9241ac11537abaf0766e6876e138b24645efd3..e2e96b8355b68cd43967977259c67ab91f7a5e1e 100644 (file)
--- a/main.scm
+++ b/main.scm
@@ -1,9 +1,10 @@
 (load "codegen.scm")
+(load "platform.scm")
 
 ; returns (os filename)
 (define (parse-args)
   (define (parse-os x)
-    (if (null? x) 'darwin ; todo: replace this with the os
+    (if (null? x) host-os ; todo: replace this with the os
                                        ; it was compiled with
        (if
         (or (equal? (car x) "-t")

diff --git a/platform.scm b/platform.scm
new file mode 100644 (file)
index 0000000..bddc67d
--- /dev/null
+++ b/platform.scm
@@ -0,0 +1,22 @@
+(define (slurp ip)
+  (with-output-to-string
+    (lambda ()
+      (let f ()
+       (let ([c (read-char ip)])
+         (unless (eof-object? c)
+           (write-char c)
+           (f)))))))
+
+(define (trim s)
+  (if (<= (string-length s) 0)
+      s
+      (if (char-whitespace?
+          (string-ref s (- (string-length s) 1)))
+         (trim (substring s 0 (- (string-length s) 1)))
+         s)))
+
+(define host-os
+  (string->symbol
+   (string-downcase
+    (trim (slurp (car (process "uname")))))))
+

diff --git a/tests.scm b/tests.scm
index 65b99d9c5a3574e331228c21933528d1a3490e76..531efe23223d79a1242e50aae316cae953686d89 100644 (file)
--- a/tests.scm
+++ b/tests.scm
@@ -22,13 +22,13 @@
 (define (test-prog prog exit-code)
   (display prog)
   (newline)
-  (compile-to-binary prog "/tmp/test-prog" 'darwin)
+  (compile-to-binary prog "/tmp/test-prog" host-os)
   (test (system "/tmp/test-prog") exit-code))
 
 (define (test-prog-stdout prog output)
   (display prog)
   (newline)
-  (compile-to-binary prog "/tmp/test-prog" 'darwin)
+  (compile-to-binary prog "/tmp/test-prog" host-os)
   (system "/tmp/test-prog > /tmp/test-output.txt")
   (let ((str (read-file "/tmp/test-output.txt")))
     (test str output)))