From 8519507b78d723100bca15fe0332ff99890e77fa Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Mon, 29 Jul 2019 10:08:47 +0100
Subject: [PATCH] Add dodgy uname based host OS detection

---
 codegen.scm  |  3 ++-
 main.scm     |  3 ++-
 platform.scm | 22 ++++++++++++++++++++++
 tests.scm    |  4 ++--
 4 files changed, 28 insertions(+), 4 deletions(-)
 create mode 100644 platform.scm

diff --git a/codegen.scm b/codegen.scm
index 2d60c0a..7c1c3a1 100644
--- 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 ce9241a..e2e96b8 100644
--- 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
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 65b99d9..531efe2 100644
--- 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)))
-- 
2.30.2