From 6a571e3d2822875d9cec94979013ba322c578c11 Mon Sep 17 00:00:00 2001 From: janmasrovira Date: Thu, 5 Jan 2023 17:48:26 +0100 Subject: [PATCH] Automatized benchmarks (#1673) --- .gitignore | 2 + Makefile | 4 + bench/Base.hs | 122 ++++++++++++ bench/Main.hs | 124 ++++++++++++ bench/Suites.hs | 28 +++ bench/Variants.hs | 251 ++++++++++++++++++++++++ cabal.hie.yaml | 3 + gnuplot/bars.gp | 39 ++++ package.yaml | 16 ++ src/Juvix/Prelude/Base.hs | 2 + src/Juvix/Prelude/Env.hs | 30 +++ src/Juvix/Prelude/Path.hs | 23 +++ test/BackendC/Base.hs | 6 +- test/Base.hs | 14 +- test/Runtime/Base.hs | 6 +- tests/benchmark/ackermann/c/ackermann.c | 19 +- 16 files changed, 663 insertions(+), 26 deletions(-) create mode 100644 bench/Base.hs create mode 100644 bench/Main.hs create mode 100644 bench/Suites.hs create mode 100644 bench/Variants.hs create mode 100644 gnuplot/bars.gp create mode 100644 src/Juvix/Prelude/Env.hs diff --git a/.gitignore b/.gitignore index 9e60f2cee..aaf2aa1a6 100644 --- a/.gitignore +++ b/.gitignore @@ -87,3 +87,5 @@ docs/org/README.org # Binary files (produced by `make check`) examples/milestone/HelloWorld/HelloWorld hie.yaml +/.shake/ +/.benchmark-results/ diff --git a/Makefile b/Makefile index 89dd4680a..85d870aec 100644 --- a/Makefile +++ b/Makefile @@ -234,3 +234,7 @@ test-shell : install changelog-updates : @github_changelog_generator @pandoc CHANGELOG.md --from markdown --to org -o UPDATES-FOR-CHANGELOG.org + +.PHONY : bench +bench: runtime submodules + @stack bench diff --git a/bench/Base.hs b/bench/Base.hs new file mode 100644 index 000000000..50770d9f2 --- /dev/null +++ b/bench/Base.hs @@ -0,0 +1,122 @@ +module Base where + +import Data.Colour +import Data.Colour.SRGB +import Development.Shake hiding (()) +import Juvix.Extra.Paths +import Juvix.Prelude +import Prelude (Show (show)) + +root :: Path Abs Dir +root = relToProject $(mkRelDir "tests/benchmark") + +resultsDir :: Path Abs Dir +resultsDir = relToProject $(mkRelDir ".benchmark-results") + +resultDirs :: [Path Abs Dir] +resultDirs = [binDir, plotDir, csvDir] + +binDir :: Path Abs Dir +binDir = resultsDir $(mkRelDir "bin") + +plotDir :: Path Abs Dir +plotDir = resultsDir $(mkRelDir "plot") + +csvDir :: Path Abs Dir +csvDir = resultsDir $(mkRelDir "csv") + +-- | e.g. 0xf0f8ff (format supported by gnuplot) +showColour :: Colour Double -> Text +showColour = pack . ("0x" <>) . dropExact 1 . sRGB24show + +data Lang + = Ocaml + | Haskell + | C + | Juvix + | Runtime + | Core + deriving stock (Eq) + +instance Show Lang where + show = \case + Ocaml -> "ocaml" + Haskell -> "haskell" + C -> "c" + Juvix -> "juvix" + Runtime -> "runtime" + Core -> "core" + +langPath :: Lang -> Path Rel Dir +langPath = relDir . Prelude.show + +langFile :: Lang -> Path Rel File +langFile = relFile . Prelude.show + +langExtension :: Lang -> String +langExtension = \case + Ocaml -> ".ml" + Haskell -> ".hs" + C -> ".c" + Juvix -> ".juvix" + Runtime -> ".c" + Core -> ".jvc" + +data Variant = Variant + { _variantTitle :: Maybe String, + _variantLanguage :: Lang, + _variantExtensions :: [String], + _variantColor :: Colour Double, + _variantRun :: Path Abs File -> IO (), + _variantBuild :: BuildArgs -> Action () + } + +data BuildArgs = BuildArgs + { _buildSrc :: Path Abs File, + _buildOutDir :: Path Abs Dir + } + +data Suite = Suite + { _suiteTitle :: String, + _suiteVariants :: [Variant] + } + +makeLenses ''Suite +makeLenses ''BuildArgs +makeLenses ''Variant + +gnuplotFile :: Path Abs File +gnuplotFile = relToProject $(mkRelFile "gnuplot/bars.gp") + +suitePlotFile :: Suite -> Path Abs File +suitePlotFile s = plotDir suiteBaseFile s + +suitePdfFile :: Suite -> Path Abs File +suitePdfFile s = addExtension' ".pdf" (suitePlotFile s) + +suiteSvgFile :: Suite -> Path Abs File +suiteSvgFile s = addExtension' ".svg" (suitePlotFile s) + +suiteCsvFile :: Suite -> Path Abs File +suiteCsvFile s = addExtension' ".csv" (csvDir suiteBaseFile s) + +suiteSrcDir :: Suite -> Path Abs Dir +suiteSrcDir s = root relDir (s ^. suiteTitle) + +suiteBaseFile :: Suite -> Path Rel File +suiteBaseFile s = relFile (s ^. suiteTitle) + +variantSrcDir :: Suite -> Variant -> Path Abs Dir +variantSrcDir s v = suiteSrcDir s langPath (v ^. variantLanguage) + +suitePath :: Suite -> Path Rel Dir +suitePath s = relDir (s ^. suiteTitle) + +variantBinDir :: Suite -> Variant -> Path Abs Dir +variantBinDir s v = binDir suitePath s langPath (v ^. variantLanguage) + +variantBinFile :: Suite -> Variant -> Path Abs File +variantBinFile s v = variantBinDir s v addExtensions' (v ^. variantExtensions) (suiteBaseFile s) + +binFile :: BuildArgs -> [String] -> Path Abs File +binFile args ext = args ^. buildOutDir replaceExtensions' ext (filename (args ^. buildSrc)) diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 index 000000000..d329095c6 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,124 @@ +module Main where + +import Base +import Criterion.Main +import Criterion.Main.Options hiding (config) +import Criterion.Types +import Data.Text qualified as Text +import Development.Shake hiding (()) +import Juvix.Prelude.Base +import Juvix.Prelude.Path as Path hiding (doesFileExist, (-<.>)) +import Juvix.Prelude.Path qualified as Path +import Statistics.Types +import Suites + +main :: IO () +main = shakeArgs opts compileRules + where + opts :: ShakeOptions + opts = shakeOptions + +compileRules :: Rules () +compileRules = do + phony "clean" $ do + putInfo ("Deleting " <> toFilePath resultsDir) + removePathForcibly resultsDir + forM_ suites suiteRules + +suiteRules :: Suite -> Rules () +suiteRules s = do + forM_ (s ^. suiteVariants) (variantRules s) + csvRules s + plotRules s + +multiRecipe :: [Path Abs File] -> Action () -> Rules () +multiRecipe out howto = map toFilePath out &%> const howto + +recipe :: Path Abs File -> Action () -> Rules () +recipe out howto = toFilePath out %> const howto + +variantRules :: Suite -> Variant -> Rules () +variantRules s v = do + action $ do + whenM + (doesFileExist (toFilePath srcFile)) + (need [toFilePath exeFile]) + + recipe exeFile $ do + need [toFilePath srcFile] + ensureDir outDir + (v ^. variantBuild) args + where + args :: BuildArgs + args = + BuildArgs + { _buildSrc = srcFile, + _buildOutDir = outDir + } + lang :: Lang + lang = v ^. variantLanguage + srcFile :: Path Abs File + srcFile = + addExtension' + (langExtension lang) + (suiteSrcDir s langPath lang suiteBaseFile s) + exeFile :: Path Abs File + exeFile = outDir replaceExtensions' (v ^. variantExtensions) (filename srcFile) + outDir :: Path Abs Dir + outDir = variantBinDir s v + +plotRules :: Suite -> Rules () +plotRules s = do + let csv :: Path Abs File = suiteCsvFile s + svg :: Path Abs File = suiteSvgFile s + out :: Path Abs File = suitePlotFile s + want [toFilePath svg] + multiRecipe [svg] $ do + need [toFilePath csv, toFilePath gnuplotFile] + ensureDir (parent svg) + command_ + [] + "gnuplot" + ( gpArg "name" (s ^. suiteTitle) + ++ gpArg "outfile" (toFilePath out) + ++ gpArg "csvfile" (toFilePath csv) + ++ [toFilePath gnuplotFile] + ) + where + gpArg :: String -> String -> [String] + gpArg arg val = ["-e", arg <> "='" <> val <> "'"] + +csvRules :: Suite -> Rules () +csvRules s = + recipe csv $ do + need [toFilePath (variantBinFile s v) | v <- s ^. suiteVariants] + ensureDir (parent csv) + whenM (Path.doesFileExist csv) (removeFile csv) + liftIO (runMode (Run (config s) Glob []) (fromSuite s) >> addColorColumn) + where + csv :: Path Abs File = suiteCsvFile s + addColorColumn :: IO () + addColorColumn = do + header :| rows <- nonEmpty' . Text.lines <$> readFile (toFilePath csv) + let rows' = + [ showColour (v ^. variantColor) <> "," <> r + | (v, r) <- zipExact (s ^. suiteVariants) rows + ] + header' = "Color," <> header + writeFile (toFilePath csv) (Text.unlines (header' : rows')) + +fromSuite :: Suite -> [Benchmark] +fromSuite s = map go (s ^. suiteVariants) + where + go :: Variant -> Benchmark + go v = bench title (nfIO ((v ^. variantRun) (variantBinFile s v))) + where + title :: String + title = show (v ^. variantLanguage) <> maybe "" (" " <>) (v ^. variantTitle) + +config :: Suite -> Config +config s = + defaultConfig + { csvFile = Just (toFilePath (suiteCsvFile s)), + confInterval = cl90 + } diff --git a/bench/Suites.hs b/bench/Suites.hs new file mode 100644 index 000000000..8de669525 --- /dev/null +++ b/bench/Suites.hs @@ -0,0 +1,28 @@ +module Suites where + +import Base +import Juvix.Prelude +import Variants + +suites :: [Suite] +suites = + map + defaultSuite + [ "mergesort", + "fibonacci", + "maybe" + ] + <> [ Suite suiteName (allVariantsExcept [C] [CoreEval]) + | suiteName <- ["fold", "mapfold"] + ] + <> [Suite "mapfun" (allVariantsExcept [C] [CoreEval, JuvixExe, JuvixWasm])] + <> [ Suite suiteName (allVariantsExcept [] [CoreEval, JuvixExe, JuvixWasm]) + | suiteName <- ["ackermann", "combinations", "cps", "prime"] + ] + +defaultSuite :: String -> Suite +defaultSuite title = + Suite + { _suiteTitle = title, + _suiteVariants = defaultVariants + } diff --git a/bench/Variants.hs b/bench/Variants.hs new file mode 100644 index 000000000..33d4b5efe --- /dev/null +++ b/bench/Variants.hs @@ -0,0 +1,251 @@ +module Variants where + +import Base +import Data.Colour +import Data.Colour.Palette.BrewerSet +import Development.Shake hiding (()) +import Juvix.Prelude +import Juvix.Prelude.Env +import System.Process + +allVariantsExcept :: [Lang] -> [VariantId] -> [Variant] +allVariantsExcept ls vs = + filter + (\v -> (v ^. variantLanguage) `notElem` ls) + (map getVariant (filter (`notElem` vs) allElements)) + +allVariants :: [Variant] +allVariants = map getVariant allElements + +defaultVariants :: [Variant] +defaultVariants = allVariantsExcept [] [CoreEval] + +data VariantId + = OcamlExe + | OcamlByte + | HaskellExe + | HaskellStrict + | JuvixExe + | JuvixWasm + | ClangExe + | ClangWasm + | RuntimeExe + | RuntimeWasm + | CoreEval + deriving stock (Bounded, Enum, Eq, Ord) + +getVariantIx :: VariantId -> Int +getVariantIx = fromEnum + +-- | Note that only 12 colors are available +getVariantColor :: VariantId -> Colour Double +getVariantColor v + | i < 12 = brewerSet Paired 12 !! i + | otherwise = error "not enough colors. Please extend the palette" + where + i :: Int + i = getVariantIx v + +getVariant :: VariantId -> Variant +getVariant = \case + OcamlExe -> ocamlExe + OcamlByte -> ocamlByteExe + HaskellExe -> haskellExe + HaskellStrict -> haskellStrictExe + JuvixExe -> juvixExe + JuvixWasm -> juvixWasm + ClangExe -> clangExe + ClangWasm -> clangWasm + RuntimeExe -> runtimeExe + RuntimeWasm -> runtimeWasm + CoreEval -> coreEval + +defaultExt :: [String] +defaultExt = [".exe"] + +runWasm :: Path Abs File -> IO () +runWasm p = void (readProcess "wasmer" [toFilePath p, "--disable-cache"] "") + +runExe :: Path Abs File -> IO () +runExe p = void (readProcess (toFilePath p) [] "") + +outOptions :: BuildArgs -> [String] -> [String] +outOptions args ext = ["-o", toFilePath (binFile args ext)] + +commonOptions :: BuildArgs -> [String] -> [String] +commonOptions args ext = toFilePath (args ^. buildSrc) : outOptions args ext + +ocamlExe :: Variant +ocamlExe = + Variant + { _variantTitle = Nothing, + _variantLanguage = Ocaml, + _variantExtensions = ext, + _variantColor = getVariantColor OcamlExe, + _variantRun = runExe, + _variantBuild = \args -> + command_ [] "ocamlopt" ("-O2" : commonOptions args ext) + } + where + ext :: [String] + ext = defaultExt + +ocamlByteExe :: Variant +ocamlByteExe = + Variant + { _variantTitle = Just "byte", + _variantLanguage = Ocaml, + _variantExtensions = ext, + _variantColor = getVariantColor OcamlByte, + _variantRun = runExe, + _variantBuild = \args -> + command_ [] "ocamlc" (commonOptions args ext) + } + where + ext :: [String] + ext = ".byte" : defaultExt + +haskellCommon :: [String] +haskellCommon = ["-O2", "-no-keep-hi-files", "-no-keep-o-files"] + +haskellExe :: Variant +haskellExe = + Variant + { _variantTitle = Nothing, + _variantLanguage = Haskell, + _variantExtensions = ext, + _variantColor = getVariantColor HaskellExe, + _variantRun = runExe, + _variantBuild = \args -> + command_ [] "ghc" (haskellCommon ++ commonOptions args ext) + } + where + ext :: [String] + ext = defaultExt + +haskellStrictExe :: Variant +haskellStrictExe = + Variant + { _variantTitle = Just "strict", + _variantLanguage = Haskell, + _variantExtensions = ext, + _variantColor = getVariantColor HaskellStrict, + _variantRun = runExe, + _variantBuild = \args -> + command_ [] "ghc" (haskellCommon ++ ["-XStrict"] ++ commonOptions args ext) + } + where + ext :: [String] + ext = ".strict" : defaultExt + +juvixExe :: Variant +juvixExe = + Variant + { _variantTitle = Nothing, + _variantLanguage = Juvix, + _variantExtensions = ext, + _variantColor = getVariantColor JuvixExe, + _variantRun = runExe, + _variantBuild = \args -> + command_ [] "juvix" (juvixCommon ++ commonOptions args ext) + } + where + ext :: [String] + ext = defaultExt + +juvixCommon :: [String] +juvixCommon = ["compile"] + +juvixWasm :: Variant +juvixWasm = + Variant + { _variantTitle = Just "wasm", + _variantLanguage = Juvix, + _variantExtensions = ext, + _variantColor = getVariantColor JuvixWasm, + _variantRun = runWasm, + _variantBuild = \args -> + command_ [] "juvix" (juvixCommon ++ ["--target=wasm"] ++ commonOptions args ext) + } + where + ext :: [String] + ext = [".wasm"] + +runtimeCommon :: [String] +runtimeCommon = ["dev", "runtime", "compile"] + +runtimeExe :: Variant +runtimeExe = + Variant + { _variantTitle = Nothing, + _variantLanguage = Runtime, + _variantExtensions = ext, + _variantColor = getVariantColor RuntimeExe, + _variantRun = runExe, + _variantBuild = \args -> + command_ [] "juvix" (runtimeCommon ++ commonOptions args ext) + } + where + ext :: [String] + ext = defaultExt + +runtimeWasm :: Variant +runtimeWasm = + Variant + { _variantTitle = Just "wasm", + _variantLanguage = Runtime, + _variantExtensions = ext, + _variantColor = getVariantColor RuntimeWasm, + _variantRun = runWasm, + _variantBuild = \args -> + command_ [] "juvix" (runtimeCommon ++ ["--target=wasm32-wasi"] ++ commonOptions args ext) + } + where + ext :: [String] + ext = [".wasm"] + +clangExe :: Variant +clangExe = + Variant + { _variantTitle = Nothing, + _variantLanguage = C, + _variantExtensions = ext, + _variantColor = getVariantColor ClangExe, + _variantRun = runExe, + _variantBuild = \args -> + command_ [] "clang" ("-O3" : commonOptions args ext) + } + where + ext :: [String] + ext = defaultExt + +clangWasm :: Variant +clangWasm = + Variant + { _variantTitle = Just "wasm", + _variantLanguage = C, + _variantExtensions = ext, + _variantColor = getVariantColor ClangWasm, + _variantRun = runWasm, + _variantBuild = \args -> do + wasipath <- getWasiSysrootPathStr + command_ [] "clang" (["-Os", "-nodefaultlibs", "--sysroot", wasipath, "-lc", "--target=wasm32-wasi"] ++ commonOptions args ext) + } + where + ext :: [String] + ext = [".wasm"] + +coreEval :: Variant +coreEval = + Variant + { _variantTitle = Nothing, + _variantLanguage = Core, + _variantExtensions = ext, + _variantColor = getVariantColor CoreEval, + _variantRun = \src -> void (readProcess "juvix" ["dev", "core", "eval", toFilePath src] ""), + _variantBuild = \args -> + command_ [] "cp" (map toFilePath [args ^. buildSrc, binFile args ext]) + } + where + ext :: [String] + ext = [langExtension Core] diff --git a/cabal.hie.yaml b/cabal.hie.yaml index da79588ba..5c4ee7ab1 100644 --- a/cabal.hie.yaml +++ b/cabal.hie.yaml @@ -8,3 +8,6 @@ cradle: - path: "./test" component: "test:juvix-test" + + - path: "./bench" + component: "bench:juvix-bench" diff --git a/gnuplot/bars.gp b/gnuplot/bars.gp new file mode 100644 index 000000000..2c04e59e7 --- /dev/null +++ b/gnuplot/bars.gp @@ -0,0 +1,39 @@ +# arguments: name outfile csvfile +# usage: gnuplot -e "name='the title'" -e "outfile='out'" -e "csvfile='data.csv'" bars.gp + +meanCol = 'Mean' +colorCol = 'Color' +stddevCol = 'Stddev' +targets = meanCol . ' ' . stddevCol +set terminal svg enhanced mouse size 800, 1100 +set output outfile.'.svg' +set multiplot layout 2, 1 title ('suite '.name) font ",24" +set key outside +set tmargin 3 +set style data histogram +set datafile separator "," +set boxwidth 2 +set xtic rotate by -20 scale 0 font ",16" +set ytic scale 0 font ",16" +set grid y +set ylabel "execution time (s)" font ", 20" +set style fill solid +unset key +set yrange [0 : *] +set offsets graph 0,0.5 + +set title meanCol font ",20" +plot csvfile \ + using meanCol:colorCol:xtic(2) notitle linecolor rgbcolor variable, \ + '' using 0:meanCol:(sprintf("%1.4f",column(meanCol))) with labels font ",13" center offset 0, 0.4 title meanCol, \ + + +set title "Standard deviation" font ",20" +unset ylabel + +f(x) = column(stddevCol)*100/column(meanCol) +plot csvfile \ + using (f('')):colorCol:xtic(2) notitle linecolor rgbcolor variable, \ + '' using ($0 - 1):(f('')):(sprintf("%1.2f%",(f('')))) with labels font ",13" center offset 0, 0.4 notitle + +unset multiplot diff --git a/package.yaml b/package.yaml index b81670056..f5e32a081 100644 --- a/package.yaml +++ b/package.yaml @@ -72,6 +72,13 @@ dependencies: - Diff == 0.4.* - pretty-show == 1.10.* +# benchmarks +- criterion == 1.5.* +- statistics == 0.16.* +- shake == 0.19.* +- colour == 2.3.* +- palette == 0.3.* + ghc-options: # Warnings - -Weverything @@ -134,3 +141,12 @@ tests: - juvix verbatim: default-language: GHC2021 + +benchmarks: + juvix-bench: + main: Main.hs + source-dirs: bench + dependencies: + - juvix + verbatim: + default-language: GHC2021 diff --git a/src/Juvix/Prelude/Base.hs b/src/Juvix/Prelude/Base.hs index 32adf88bd..75148fcb8 100644 --- a/src/Juvix/Prelude/Base.hs +++ b/src/Juvix/Prelude/Base.hs @@ -32,6 +32,7 @@ module Juvix.Prelude.Base module Data.Monoid, module Data.Ord, module Data.Semigroup, + module Prelude, module Data.Singletons, module Data.Singletons.Sigma, module Data.Singletons.TH, @@ -178,6 +179,7 @@ import System.IO hiding import System.IO.Error import Text.Show (Show) import Text.Show qualified as Show +import Prelude (Double) -------------------------------------------------------------------------------- diff --git a/src/Juvix/Prelude/Env.hs b/src/Juvix/Prelude/Env.hs new file mode 100644 index 000000000..358df8b66 --- /dev/null +++ b/src/Juvix/Prelude/Env.hs @@ -0,0 +1,30 @@ +module Juvix.Prelude.Env where + +import Juvix.Prelude.Base +import Juvix.Prelude.Path +import System.Environment + +-- | Environment variables relevant to Juvix +data EnvVar + = EnvWasiSysrootPath + deriving stock (Show, Eq) + +envVarString :: EnvVar -> String +envVarString = \case + EnvWasiSysrootPath -> "WASI_SYSROOT_PATH" + +envVarHint :: EnvVar -> Maybe String +envVarHint = \case + EnvWasiSysrootPath -> Just "Set to the location of the wasi-clib sysroot" + +getEnvVar :: MonadIO m => EnvVar -> m String +getEnvVar var = fromMaybeM (error (pack msg)) (liftIO (lookupEnv (envVarString var))) + where + msg :: String + msg = "Missing environment variable " <> envVarString var <> maybe "" (". " <>) (envVarHint var) + +getWasiSysrootPathStr :: MonadIO m => m String +getWasiSysrootPathStr = getEnvVar EnvWasiSysrootPath + +getWasiSysrootPath :: MonadIO m => m (Path Abs Dir) +getWasiSysrootPath = absDir <$> getEnvVar EnvWasiSysrootPath diff --git a/src/Juvix/Prelude/Path.hs b/src/Juvix/Prelude/Path.hs index 00d2ff394..24c9e88b1 100644 --- a/src/Juvix/Prelude/Path.hs +++ b/src/Juvix/Prelude/Path.hs @@ -69,15 +69,38 @@ someBaseToAbs root = \case Rel r -> root r Abs a -> a +removeExtensions :: Path b File -> Path b File +removeExtensions p = maybe p removeExtensions (removeExtension p) + removeExtension :: Path b File -> Maybe (Path b File) removeExtension = fmap fst . splitExtension removeExtension' :: Path b File -> Path b File removeExtension' = fst . fromJust . splitExtension +addExtensions :: MonadThrow m => [String] -> Path b File -> m (Path b File) +addExtensions ext p = case ext of + [] -> return p + (e : es) -> addExtension e p >>= addExtensions es + +replaceExtensions :: MonadThrow m => [String] -> Path b File -> m (Path b File) +replaceExtensions ext = addExtensions ext . removeExtensions + +replaceExtensions' :: [String] -> Path b File -> Path b File +replaceExtensions' ext = fromJust . replaceExtensions ext + +addExtensions' :: [String] -> Path b File -> Path b File +addExtensions' ext = fromJust . addExtensions ext + +addExtension' :: String -> Path b File -> Path b File +addExtension' ext = fromJust . addExtension ext + replaceExtension' :: String -> Path b File -> Path b File replaceExtension' ext = fromJust . replaceExtension ext +dirnameToFile :: Path x Dir -> Path Rel File +dirnameToFile = relFile . dropTrailingPathSeparator . toFilePath . dirname + parents :: Path Abs a -> NonEmpty (Path Abs Dir) parents = go [] . parent where diff --git a/test/BackendC/Base.hs b/test/BackendC/Base.hs index 4a3f85640..93ee568d5 100644 --- a/test/BackendC/Base.hs +++ b/test/BackendC/Base.hs @@ -59,11 +59,7 @@ wasiClangAssertion stdlibMode mainFile expectedFile stdinText step = do assertCmdExists $(mkRelFile "wasmer") step "Lookup WASI_SYSROOT_PATH" - sysrootPath <- - absDir - <$> assertEnvVar - "Env var WASI_SYSROOT_PATH missing. Set to the location of the wasi-clib sysroot" - "WASI_SYSROOT_PATH" + sysrootPath <- getWasiSysrootPath root <- getCurrentDir step "C Generation" diff --git a/test/Base.hs b/test/Base.hs index acc5d29dc..4ddb7fe13 100644 --- a/test/Base.hs +++ b/test/Base.hs @@ -4,6 +4,7 @@ module Base module Juvix.Prelude, module Base, module Juvix.Extra.Paths, + module Juvix.Prelude.Env, ) where @@ -12,7 +13,7 @@ import Data.Algorithm.Diff import Data.Algorithm.DiffOutput import Juvix.Extra.Paths import Juvix.Prelude -import System.Environment (lookupEnv) +import Juvix.Prelude.Env import Test.Tasty import Test.Tasty.HUnit import Text.Show.Pretty hiding (Html) @@ -34,10 +35,14 @@ newtype WASMInfo = WASMInfo makeLenses ''TestDescr -data StdlibMode = StdlibInclude | StdlibExclude +data StdlibMode + = StdlibInclude + | StdlibExclude deriving stock (Show, Eq) -data CompileMode = WASI StdlibMode | WASM WASMInfo +data CompileMode + = WASI StdlibMode + | WASM WASMInfo mkTest :: TestDescr -> TestTree mkTest TestDescr {..} = case _testAssertion of @@ -60,6 +65,3 @@ assertCmdExists cmd = assertBool ("Command: " <> toFilePath cmd <> " is not present on $PATH") . isJust =<< findExecutable cmd - -assertEnvVar :: String -> String -> IO String -assertEnvVar msg varName = fromMaybeM (assertFailure msg) (lookupEnv varName) diff --git a/test/Runtime/Base.hs b/test/Runtime/Base.hs index 729164c2b..4634bf980 100644 --- a/test/Runtime/Base.hs +++ b/test/Runtime/Base.hs @@ -31,11 +31,7 @@ clangAssertion inputFile expectedFile stdinText step = do assertCmdExists $(mkRelFile "wasmer") step "Lookup WASI_SYSROOT_PATH" - sysrootPath :: Path Abs Dir <- - absDir - <$> assertEnvVar - "Env var WASI_SYSROOT_PATH missing. Set to the location of the wasi-clib sysroot" - "WASI_SYSROOT_PATH" + sysrootPath :: Path Abs Dir <- getWasiSysrootPath expected <- TIO.readFile (toFilePath expectedFile) diff --git a/tests/benchmark/ackermann/c/ackermann.c b/tests/benchmark/ackermann/c/ackermann.c index e476ee7b8..e643dda7e 100644 --- a/tests/benchmark/ackermann/c/ackermann.c +++ b/tests/benchmark/ackermann/c/ackermann.c @@ -2,17 +2,16 @@ #include #include +#include -typedef uintptr_t uint; - -typedef uint (*fun_t)(uint,uint); +typedef uintptr_t (*fun_t)(uintptr_t,uintptr_t); typedef struct{ - uint arg; + uintptr_t arg; fun_t f; } closure_t; -static uint iter(closure_t *cl, int n, uint x) { +static uintptr_t iter(closure_t *cl, int n, uintptr_t x) { while (n > 0) { x = cl->f(cl->arg, x); --n; @@ -20,18 +19,18 @@ static uint iter(closure_t *cl, int n, uint x) { return x; } -static uint step_2(uint f, uint n) { +static uintptr_t step_2(uintptr_t f, uintptr_t n) { return iter((closure_t*)f, n + 1, 1); } -static uint step(uint dummy, uint x) { +static uintptr_t step(uintptr_t dummy, uintptr_t x) { closure_t *cl = malloc(sizeof(closure_t)); cl->arg = x; cl->f = (fun_t)step_2; - return (uint)cl; + return (uintptr_t)cl; } -static uint plus(uint x, uint y) { +static uintptr_t plus(uintptr_t x, uintptr_t y) { return x + y; } @@ -42,7 +41,7 @@ static int ackermann(int m, int n) { closure_t *mystep = malloc(sizeof(closure_t)); mystep->arg = 0; mystep->f = step; - closure_t *cl = (closure_t *)iter(mystep, m, (uint)plus_one); + closure_t *cl = (closure_t *)iter(mystep, m, (uintptr_t)plus_one); return cl->f(cl->arg, n); }