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 +