From 4dc098de4c1cd780690de6cb3762c480d84fe066 Mon Sep 17 00:00:00 2001
From: Jacob Mitchell <jmitchell@member.fsf.org>
Date: Fri, 15 Feb 2019 15:03:58 -0800
Subject: [PATCH] Chez shebang: use "scheme-script" instead of "scheme
 --script"

The following shebang line doesn't work:

    #!/usr/bin/env scheme --script

It would work without the /usr/bin/env indirection, but whether env is
needed or not doing this instead consistently works:

    #!/usr/bin/env scheme-script

More context from the Chez User Guide:
http://cisco.github.io/ChezScheme/csug9.5/libraries.html#./libraries:h2
---
 src/Compiler/Scheme/Chez.idr     | 20 +++++++++++++-------
 tests/Main.idr                   |  9 ++++-----
 tests/blodwen/chez007/expected   |  6 ++++++
 tests/blodwen/chez007/hello.blod |  2 ++
 tests/blodwen/chez007/input      |  3 +++
 tests/blodwen/chez007/run        |  4 ++++
 6 files changed, 32 insertions(+), 12 deletions(-)
 create mode 100644 tests/blodwen/chez007/expected
 create mode 100644 tests/blodwen/chez007/hello.blod
 create mode 100644 tests/blodwen/chez007/input
 create mode 100755 tests/blodwen/chez007/run

diff --git a/src/Compiler/Scheme/Chez.idr b/src/Compiler/Scheme/Chez.idr
index 2db961f..7462e6b 100644
--- a/src/Compiler/Scheme/Chez.idr
+++ b/src/Compiler/Scheme/Chez.idr
@@ -23,11 +23,17 @@ firstExists : List String -> IO (Maybe String)
 firstExists [] = pure Nothing
 firstExists (x :: xs) = if !(exists x) then pure (Just x) else firstExists xs
 
-findChez : IO String
-findChez
+findBin : String -> List String -> IO String
+findBin name altNames
     = do e <- firstExists [p ++ x | p <- ["/usr/bin/", "/usr/local/bin/"],
-                                    x <- ["scheme", "chez", "chezscheme9.5"]]
-         maybe (pure "/usr/bin/env scheme") pure e
+                                    x <- (name :: altNames)]
+         maybe (pure ("/usr/bin/env " ++ name)) pure e
+
+findChez : IO String
+findChez = findBin "scheme" ["chez", "chezscheme9.5"]
+
+findChezScript : IO String
+findChezScript = findBin "scheme-script" []
 
 findLibs : List String -> List String
 findLibs = mapMaybe (isLib . trim)
@@ -46,8 +52,8 @@ escapeQuotes s = pack $ foldr escape [] $ unpack s
     escape c   cs = c :: cs
 
 schHeader : String -> List String -> String
-schHeader chez libs
-  = "#!" ++ chez ++ " --script\n\n" ++
+schHeader chezScript libs
+  = "#!" ++ chezScript ++ "\n\n" ++
     "(import (chezscheme))\n" ++
     "(case (machine-type)\n" ++
     "  [(i3le ti3le a6le ta6le) (load-shared-object \"libc.so.6\")]\n" ++
@@ -107,7 +113,7 @@ compileToSS c tm outfile
          compdefs <- traverse (getScheme chezExtPrim defs) ns
          let code = concat compdefs
          main <- schExp chezExtPrim 0 [] !(compileExp tags tm)
-         chez <- coreLift findChez
+         chez <- coreLift findChezScript
          support <- readDataFile "chez/support.ss"
          let scm = schHeader chez libs ++ support ++ code ++ main ++ schFooter
          Right () <- coreLift $ writeFile outfile scm
diff --git a/tests/Main.idr b/tests/Main.idr
index 3d94190..a0a7793 100644
--- a/tests/Main.idr
+++ b/tests/Main.idr
@@ -5,7 +5,7 @@ import System
 %default covering
 
 ttimpTests : List String
-ttimpTests 
+ttimpTests
     = ["test001", "test002", "test003", "test004", "test005",
        "test006", "test007", "test008", "test009",
        "case001",
@@ -21,7 +21,7 @@ blodwenTests
        "test021", "test022", "test023", "test024", "test025",
        "test026", "test027", "test028", "test029", "test030",
        "chez001", "chez002", "chez003", "chez004", "chez005",
-       "chez006",
+       "chez006", "chez007",
        "chicken001", "chicken002",
        "error001", "error002", "error003", "error004", "error005",
        "error006",
@@ -47,12 +47,12 @@ blodwenTests
        "with001"]
 
 chdir : String -> IO Bool
-chdir dir 
+chdir dir
     = do ok <- foreign FFI_C "chdir" (String -> IO Int) dir
          pure (ok == 0)
 
 fail : String -> IO ()
-fail err 
+fail err
     = do putStrLn err
          exitWith (ExitFailure 1)
 
@@ -82,4 +82,3 @@ main
          if (any not (ttimps ++ blods))
             then exitWith (ExitFailure 1)
             else exitWith ExitSuccess
-
diff --git a/tests/blodwen/chez007/expected b/tests/blodwen/chez007/expected
new file mode 100644
index 0000000..e41611c
--- /dev/null
+++ b/tests/blodwen/chez007/expected
@@ -0,0 +1,6 @@
+hello blodwen devs
+1/1: Building hello (hello.blod)
+Welcome to Blodwen. Good luck.
+Main> Main> hello written
+Main> Bye for now!
+hello blodwen devs
diff --git a/tests/blodwen/chez007/hello.blod b/tests/blodwen/chez007/hello.blod
new file mode 100644
index 0000000..1fa0dde
--- /dev/null
+++ b/tests/blodwen/chez007/hello.blod
@@ -0,0 +1,2 @@
+main : IO ()
+main = putStrLn "hello blodwen devs"
diff --git a/tests/blodwen/chez007/input b/tests/blodwen/chez007/input
new file mode 100644
index 0000000..2672752
--- /dev/null
+++ b/tests/blodwen/chez007/input
@@ -0,0 +1,3 @@
+:exec main
+:c hello main
+:q
diff --git a/tests/blodwen/chez007/run b/tests/blodwen/chez007/run
new file mode 100755
index 0000000..758153c
--- /dev/null
+++ b/tests/blodwen/chez007/run
@@ -0,0 +1,4 @@
+$1 hello.blod < input
+./hello.ss
+rm -rf build hello.ss
+