From 277166dbcd5ac368fb380fc7e90fc4868374a9c0 Mon Sep 17 00:00:00 2001 From: Luc Tielen Date: Fri, 6 Oct 2023 10:02:03 +0200 Subject: [PATCH 1/9] Add unit tests for LLVM vector --- eclair-lang.cabal | 1 + tests/eclair/Test/Eclair/LLVM/VectorSpec.hs | 222 ++++++++++++++++++++ 2 files changed, 223 insertions(+) create mode 100644 tests/eclair/Test/Eclair/LLVM/VectorSpec.hs diff --git a/eclair-lang.cabal b/eclair-lang.cabal index 0dec7c0..eae11f0 100644 --- a/eclair-lang.cabal +++ b/eclair-lang.cabal @@ -260,6 +260,7 @@ test-suite eclair-test Test.Eclair.LLVM.Allocator.Utils Test.Eclair.LLVM.BTreeSpec Test.Eclair.LLVM.HashSpec + Test.Eclair.LLVM.VectorSpec Test.Eclair.LSP.HandlersSpec Test.Eclair.LSP.JSONSpec Test.Eclair.RA.IndexSelectionSpec diff --git a/tests/eclair/Test/Eclair/LLVM/VectorSpec.hs b/tests/eclair/Test/Eclair/LLVM/VectorSpec.hs new file mode 100644 index 0000000..09e7cf8 --- /dev/null +++ b/tests/eclair/Test/Eclair/LLVM/VectorSpec.hs @@ -0,0 +1,222 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +module Test.Eclair.LLVM.VectorSpec + ( module Test.Eclair.LLVM.VectorSpec + ) where + +import Prelude hiding (void) +import qualified LLVM.C.API as LibLLVM +import Eclair.LLVM.Vector +import Eclair.LLVM.Codegen hiding (retVoid, nullPtr) +import Eclair.LLVM.Externals +import Foreign.LibFFI +import Foreign hiding (void) +import System.Posix.DynamicLinker +import Control.Exception +import System.Directory.Extra +import System.Process.Extra +import System.FilePath +import Test.Hspec + +type Value = Int + +data Bindings + = Bindings + { dynamicLib :: DL + , withVec :: (Ptr Vector -> IO ()) -> IO () + , bInit :: Ptr Vector -> IO () + , bDestroy :: Ptr Vector -> IO () + , bPush :: Ptr Vector -> Value -> IO Word32 + , bSize :: Ptr Vector -> IO Word64 + , bCapacity :: Ptr Vector -> IO Word64 + , bGetValue :: Ptr Vector -> Int -> IO Value + } + +spec :: Spec +spec = describe "Vector" $ aroundAll (setupAndTeardown testDir) $ parallel $ do + it "can be initialized and destroyed" $ \bindings -> + withVec bindings $ \v -> do + bInit bindings v + bDestroy bindings v + + it "can store multiple elements" $ \bindings -> do + withVec bindings $ \v -> do + bInit bindings v + idx1 <- bPush bindings v 42 + idx2 <- bPush bindings v 123 + value2 <- bGetValue bindings v 1 + value1 <- bGetValue bindings v 0 + bDestroy bindings v + idx1 `shouldBe` 0 + idx2 `shouldBe` 1 + value1 `shouldBe` 42 + value2 `shouldBe` 123 + + it "can store duplicate values" $ \bindings -> do + withVec bindings $ \v -> do + bInit bindings v + idx1 <- bPush bindings v 42 + idx2 <- bPush bindings v 42 + value1 <- bGetValue bindings v 0 + value2 <- bGetValue bindings v 1 + bDestroy bindings v + idx1 `shouldBe` 0 + idx2 `shouldBe` 1 + value1 `shouldBe` 42 + value2 `shouldBe` 42 + + it "keeps track of the number of elements inside" $ \bindings -> + withVec bindings $ \v -> do + bInit bindings v + + bSize bindings v >>= (`shouldBe` 0) + -- This vector allocates on initialization + bCapacity bindings v >>= (`shouldBe` 16) + + _ <- bPush bindings v 1 + bSize bindings v >>= (`shouldBe` 1) + bCapacity bindings v >>= (`shouldBe` 16) + _ <- bPush bindings v 2 + bSize bindings v >>= (`shouldBe` 2) + bCapacity bindings v >>= (`shouldBe` 16) + + for_ [0..13] $ bPush bindings v + bSize bindings v >>= (`shouldBe` 16) + bCapacity bindings v >>= (`shouldBe` 16) + + _ <- bPush bindings v 42 + bSize bindings v >>= (`shouldBe` 17) + bCapacity bindings v >>= (`shouldBe` 32) + + for_ [0..15] $ bPush bindings v + bSize bindings v >>= (`shouldBe` 33) + bCapacity bindings v >>= (`shouldBe` 64) + + bDestroy bindings v + + it "always keeps order of elements, even after resizing" $ \bindings -> + withVec bindings $ \v -> do + bInit bindings v + + -- This does several reallocations + for_ [0..99] $ bPush bindings v + bSize bindings v >>= (`shouldBe` 100) + bCapacity bindings v >>= (`shouldBe` 128) + + for_ [0..99] $ \i -> do + bGetValue bindings v i >>= (`shouldBe` i) + + bDestroy bindings v + +setupAndTeardown :: FilePath -> ActionWith Bindings -> IO () +setupAndTeardown dir = + bracket (setup dir) teardown + +setup :: FilePath -> IO Bindings +setup dir = do + createDirectoryIfMissing False dir + compileCode cgExternals cgTestCode dir + loadNativeCode dir + +teardown :: Bindings -> IO () +teardown = + dlclose . dynamicLib + +compileCode + :: ModuleBuilderT IO Externals + -> (Vector -> Operand -> Operand -> ModuleBuilderT IO ()) + -> FilePath -> IO () +compileCode cgExts cgHelperCode dir = do + ctx <- LibLLVM.mkContext + llvmMod <- LibLLVM.mkModule ctx "eclair" + td <- LibLLVM.getTargetData llvmMod + llvmIR <- runModuleBuilderT $ do + exts <- cgExts + let cfg = Config Nothing ctx td + vec <- instantiate "test" i32 $ runConfigT cfg $ + codegen exts Nothing -- TODO destructor + cgHelperCode vec (extMalloc exts) (extFree exts) + let llvmIRText = ppllvm llvmIR + writeFileText (llFile dir) llvmIRText + callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir] + +cgExternals :: ModuleBuilderT IO Externals +cgExternals = do + mallocFn <- extern "malloc" [i32] (ptr i8) + freeFn <- extern "free" [ptr i8] void + memcpyFn <- extern "llvm.memcpy.p0i8.p0i8.i64" [ptr i8, ptr i8, i64, i1] void + pure $ Externals mallocFn freeFn notUsed memcpyFn notUsed notUsed notUsed + +cgTestCode :: Vector -> Operand -> Operand -> ModuleBuilderT IO () +cgTestCode vec mallocFn freeFn = do + let vecTypes = vectorTypes vec + vecTy = tyVector vecTypes + valueTy = tyElement vecTypes + _ <- function "eclair_vector_new_test" [] (ptr vecTy) $ \[] -> + ret =<< call mallocFn [int32 24] + _ <- function "eclair_vector_delete_test" [(ptr vecTy, "vec")] void $ \[v] -> + call freeFn [v] + _ <- function "eclair_vector_capacity_test" [(ptr vecTy, "vec")] i32 $ \[v] -> do + capPtr <- gep v [int32 0, int32 2] + ret =<< load capPtr 0 + _ <- function "eclair_value_new_test" [(i32, "value")] (ptr valueTy) $ \[v] -> do + vPtr <- call mallocFn [int32 4] + store vPtr 0 v + ret vPtr + _ <- function "eclair_value_delete_test" [(ptr valueTy, "value")] void $ \[v] -> + call freeFn [v] + pass + +loadNativeCode :: FilePath -> IO Bindings +loadNativeCode dir = do + lib <- dlopen (soFile dir) [RTLD_LAZY] + fnNew <- dlsym lib "eclair_vector_new_test" + fnDelete <- dlsym lib "eclair_vector_delete_test" + fnValueNew <- dlsym lib "eclair_value_new_test" + fnValueDelete <- dlsym lib "eclair_value_delete_test" + fnInit <- dlsym lib "eclair_vector_init_test" + fnDestroy <- dlsym lib "eclair_vector_destroy_test" + fnPush <- dlsym lib "eclair_vector_push_test" + fnSize <- dlsym lib "eclair_vector_size_test" + fnCapacity <- dlsym lib "eclair_vector_capacity_test" + fnGetValue <- dlsym lib "eclair_vector_get_value_test" + pure $ Bindings + { dynamicLib = lib + , withVec = mkWithVec fnNew fnDelete + , bInit = mkInit fnInit + , bDestroy = mkDestroy fnDestroy + , bPush = mkPush fnValueNew fnValueDelete fnPush + , bSize = mkSize fnSize + , bCapacity = mkCapacity fnCapacity + , bGetValue = mkGetValue fnGetValue + } + where + mkNew fn = callFFI fn (retPtr retVoid) [] + mkDelete fn vec = callFFI fn retVoid [argPtr vec] + mkWithVec fnNew fnDelete = + bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete) + mkInit fn vec = callFFI fn retVoid [argPtr vec] + mkDestroy fn vec = callFFI fn retVoid [argPtr vec] + mkPush fnValueNew fnValueDelete fn vec value = + withValue fnValueNew fnValueDelete value $ \valuePtr -> + fromIntegral <$> callFFI fn retCUInt [argPtr vec, argPtr valuePtr] + mkSize fn vec = + fromIntegral <$> callFFI fn retCULong [argPtr vec] + mkCapacity fn vec = + fromIntegral <$> callFFI fn retCULong [argPtr vec] + mkGetValue fn vec idx = do + resultPtr <- callFFI fn (retPtr retCUInt) [argPtr vec, argCUInt $ fromIntegral idx] + fromIntegral <$> peek resultPtr + withValue fnNew fnDelete value = + bracket + (castPtr <$> callFFI fnNew (retPtr retCUChar) [argCUInt $ fromIntegral value]) + (\valuePtr -> callFFI fnDelete retVoid [argPtr valuePtr]) + +testDir :: FilePath +testDir = "/tmp/eclair-vector" + +llFile, soFile :: FilePath -> FilePath +llFile dir = dir "vector.ll" +soFile dir = dir "vector.so" + +notUsed :: a +notUsed = panic "Not used" From bc539257a149be7e6282b7af6f35ccbccb6ab5e0 Mon Sep 17 00:00:00 2001 From: Luc Tielen Date: Fri, 6 Oct 2023 10:52:10 +0200 Subject: [PATCH 2/9] Add unit tests for symbols in runtime --- eclair-lang.cabal | 1 + lib/Eclair/LLVM/Symbol.hs | 1 + tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs | 177 ++++++++++++++++++++ 3 files changed, 179 insertions(+) create mode 100644 tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs diff --git a/eclair-lang.cabal b/eclair-lang.cabal index 0dec7c0..d8c23b2 100644 --- a/eclair-lang.cabal +++ b/eclair-lang.cabal @@ -260,6 +260,7 @@ test-suite eclair-test Test.Eclair.LLVM.Allocator.Utils Test.Eclair.LLVM.BTreeSpec Test.Eclair.LLVM.HashSpec + Test.Eclair.LLVM.SymbolSpec Test.Eclair.LSP.HandlersSpec Test.Eclair.LSP.JSONSpec Test.Eclair.RA.IndexSelectionSpec diff --git a/lib/Eclair/LLVM/Symbol.hs b/lib/Eclair/LLVM/Symbol.hs index b45741e..4cb3d69 100644 --- a/lib/Eclair/LLVM/Symbol.hs +++ b/lib/Eclair/LLVM/Symbol.hs @@ -35,6 +35,7 @@ codegen exts = do generateTypes :: ModuleBuilder Type generateTypes = -- For now, only up to 4GB of strings are supported. + -- TODO consider strings with i8 and i16 as size also typedef "symbol_t" On [i32, ptr i8] generateFunctions :: ModuleCodegen Symbol diff --git a/tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs b/tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs new file mode 100644 index 0000000..904c395 --- /dev/null +++ b/tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs @@ -0,0 +1,177 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +module Test.Eclair.LLVM.SymbolSpec + ( module Test.Eclair.LLVM.SymbolSpec + ) where + +import Prelude hiding (void, Symbol) +import Control.Monad.Morph +import Control.Exception +import Eclair.LLVM.Symbol +import Eclair.LLVM.Codegen hiding (retVoid, nullPtr) +import Eclair.LLVM.Externals +import Foreign.LibFFI +import Foreign hiding (void, bit) +import System.Posix.DynamicLinker +import System.Directory.Extra +import System.Process.Extra +import System.FilePath +import Test.Hspec +import Foreign.C + +type I8 = CUChar + +data Bindings + = Bindings + { dynamicLib :: DL + , withSymbol :: (Ptr Symbol -> IO ()) -> IO () + , bInit :: Ptr Symbol -> String -> IO () + , bDestroy :: Ptr Symbol -> IO () + , bIsEqual :: Ptr Symbol -> Ptr Symbol -> IO Bool + , bLength :: Ptr Symbol -> IO Word32 + , bData :: Ptr Symbol -> IO String + } + +spec :: Spec +spec = describe "Symbol" $ aroundAll (setupAndTeardown testDir) $ parallel $ do + it "can be initialized and destroyed" $ \bindings -> + withSymbol bindings $ \s -> do + let str = "my example string" + len = fromIntegral $ length str + bInit bindings s str + bLength bindings s >>= (`shouldBe` len) + bData bindings s >>= (`shouldBe` str) + bDestroy bindings s + + it "is possible to compare 2 symbols" $ \bindings -> + withSymbol bindings $ \s1 -> do + withSymbol bindings $ \s2 -> do + bInit bindings s1 "abc" + bInit bindings s2 "1234" + + isEq1 <- bIsEqual bindings s1 s2 + isEq2 <- bIsEqual bindings s1 s1 + isEq3 <- bIsEqual bindings s2 s2 + + bDestroy bindings s1 + bDestroy bindings s2 + + isEq1 `shouldBe` False + isEq2 `shouldBe` True + isEq3 `shouldBe` True + + +setupAndTeardown :: FilePath -> ActionWith Bindings -> IO () +setupAndTeardown dir = + bracket (setup dir) teardown + +setup :: FilePath -> IO Bindings +setup dir = do + createDirectoryIfMissing False dir + compileCode cgExternals cgTestCode dir + loadNativeCode dir + +teardown :: Bindings -> IO () +teardown = + dlclose . dynamicLib + +compileCode + :: ModuleBuilderT IO Externals + -> (Symbol -> Externals -> ModuleBuilderT IO ()) + -> FilePath -> IO () +compileCode cgExts cgHelperCode dir = do + llvmIR <- runModuleBuilderT $ do + exts <- cgExts + symbol <- hoist intoIO $ codegen exts + cgHelperCode symbol exts + let llvmIRText = ppllvm llvmIR + writeFileText (llFile dir) llvmIRText + callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir] + +cgExternals :: ModuleBuilderT IO Externals +cgExternals = do + mallocFn <- extern "malloc" [i32] (ptr i8) + freeFn <- extern "free" [ptr i8] void + memcpyFn <- extern "memcpy" [ptr i8, ptr i8, i64] (ptr i8) + memcmpFn <- extern "memcmp" [ptr i8, ptr i8, i64] i32 + pure $ Externals mallocFn freeFn notUsed memcpyFn memcmpFn notUsed notUsed + +cgTestCode :: Symbol -> Externals -> ModuleBuilderT IO () +cgTestCode sym exts = do + let mallocFn = extMalloc exts + freeFn = extFree exts + memcpyFn = extMemcpy exts + symTy = tySymbol sym + _ <- function "eclair_symbol_new" [] (ptr symTy) $ \[] -> + ret =<< call mallocFn [int32 16] + _ <- function "eclair_symbol_delete" [(ptr symTy, "sym")] void $ \[s] -> + call freeFn [s] + let initArgs = [(ptr symTy, "sym"), (i32, "length"), (ptr i8, "data")] + _ <- function "eclair_symbol_init_helper" initArgs void $ \[s, len, str] -> do + -- Needed because "str" is freed afterwards + memory <- call mallocFn [len] + _ <- call memcpyFn [memory, str, len, bit 0] + _ <- call (symbolInit sym) [s, len, memory] + pass + let isEqArgs = [(ptr symTy, "sym1"), (ptr symTy, "sym2")] + _ <- function "eclair_symbol_is_equal_helper" isEqArgs i8 $ \[sym1, sym2] -> do + isEq <- call (symbolIsEqual sym) [sym1, sym2] + ret =<< isEq `zext` i8 + _ <- function "eclair_symbol_length" [(ptr symTy, "sym")] i32 $ \[s] -> do + lenPtr <- gep s [int32 0, int32 0] + ret =<< load lenPtr 0 + _ <- function "eclair_symbol_data" [(ptr symTy, "sym")] (ptr i8) $ \[s] -> do + lenPtr <- gep s [int32 0, int32 1] + ret =<< load lenPtr 0 + pass + +loadNativeCode :: FilePath -> IO Bindings +loadNativeCode dir = do + lib <- dlopen (soFile dir) [RTLD_LAZY] + fnNew <- dlsym lib "eclair_symbol_new" + fnDelete <- dlsym lib "eclair_symbol_delete" + fnInit <- dlsym lib "eclair_symbol_init_helper" + fnDestroy <- dlsym lib "eclair_symbol_destroy" + fnIsEqual <- dlsym lib "eclair_symbol_is_equal_helper" + fnLength <- dlsym lib "eclair_symbol_length" + fnData <- dlsym lib "eclair_symbol_data" + let getLength = mkLength fnLength + pure $ Bindings + { dynamicLib = lib + , withSymbol = mkWithSymbol fnNew fnDelete + , bInit = mkInit fnInit + , bDestroy = mkDestroy fnDestroy + , bIsEqual = mkIsEqual fnIsEqual + , bLength = getLength + , bData = mkData fnData getLength + } + where + mkNew fn = callFFI fn (retPtr retVoid) [] + mkDelete fn sym = callFFI fn retVoid [argPtr sym] + mkWithSymbol fnNew fnDelete = + bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete) + mkInit fn sym str = do + let len = fromIntegral $ length str + callFFI fn retVoid [argPtr sym, argCUInt len, argString str] + mkDestroy fn sym = callFFI fn retVoid [argPtr sym] + mkIsEqual fn sym1 sym2 = do + result <- callFFI fn retCUChar [argPtr sym1, argPtr sym2] + pure $ result == 1 + mkLength fn sym = do + fromIntegral <$> callFFI fn retCUInt [argPtr sym] + mkData fn getLength sym = do + len <- fromIntegral <$> getLength sym + strPtr <- callFFI fn (retPtr retCChar) [argPtr sym] + peekCAStringLen (strPtr, len) + +testDir :: FilePath +testDir = "/tmp/eclair-symbol" + +llFile, soFile :: FilePath -> FilePath +llFile dir = dir "symbol.ll" +soFile dir = dir "symbol.so" + +notUsed :: a +notUsed = panic "Not used" + +intoIO :: Identity a -> IO a +intoIO = pure . runIdentity From 761bb42e609531373a7b86cabac0d6b93417005d Mon Sep 17 00:00:00 2001 From: Luc Tielen Date: Sat, 7 Oct 2023 11:34:59 +0200 Subject: [PATCH 3/9] Add tests for runtime hashmap --- eclair-lang.cabal | 2 + lib/Eclair/LLVM/HashMap.hs | 1 - tests/eclair/Test/Eclair/LLVM/HashMapSpec.hs | 231 +++++++++++++++++++ tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs | 89 +------ tests/eclair/Test/Eclair/LLVM/SymbolUtils.hs | 110 +++++++++ 5 files changed, 344 insertions(+), 89 deletions(-) create mode 100644 tests/eclair/Test/Eclair/LLVM/HashMapSpec.hs create mode 100644 tests/eclair/Test/Eclair/LLVM/SymbolUtils.hs diff --git a/eclair-lang.cabal b/eclair-lang.cabal index 4fd2057..48997a8 100644 --- a/eclair-lang.cabal +++ b/eclair-lang.cabal @@ -259,8 +259,10 @@ test-suite eclair-test Test.Eclair.LLVM.Allocator.MallocSpec Test.Eclair.LLVM.Allocator.Utils Test.Eclair.LLVM.BTreeSpec + Test.Eclair.LLVM.HashMapSpec Test.Eclair.LLVM.HashSpec Test.Eclair.LLVM.SymbolSpec + Test.Eclair.LLVM.SymbolUtils Test.Eclair.LLVM.VectorSpec Test.Eclair.LSP.HandlersSpec Test.Eclair.LSP.JSONSpec diff --git a/lib/Eclair/LLVM/HashMap.hs b/lib/Eclair/LLVM/HashMap.hs index d41c237..04e9651 100644 --- a/lib/Eclair/LLVM/HashMap.hs +++ b/lib/Eclair/LLVM/HashMap.hs @@ -226,4 +226,3 @@ symbolOf = mkPath [int32 0] valueOf :: Path 'EntryIdx 'ValueIdx valueOf = mkPath [int32 1] - diff --git a/tests/eclair/Test/Eclair/LLVM/HashMapSpec.hs b/tests/eclair/Test/Eclair/LLVM/HashMapSpec.hs new file mode 100644 index 0000000..800b1d0 --- /dev/null +++ b/tests/eclair/Test/Eclair/LLVM/HashMapSpec.hs @@ -0,0 +1,231 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +module Test.Eclair.LLVM.HashMapSpec + ( module Test.Eclair.LLVM.HashMapSpec + ) where + +import Prelude hiding (void, HashMap, Symbol) +import Control.Exception +import Control.Monad.Morph +import qualified Test.Eclair.LLVM.SymbolUtils as S +import qualified LLVM.C.API as LibLLVM +import Eclair.LLVM.HashMap +import qualified Eclair.LLVM.Symbol as S +import Eclair.LLVM.Codegen hiding (retVoid, nullPtr) +import Eclair.LLVM.Externals +import Foreign.LibFFI +import Foreign hiding (void) +import System.Posix.DynamicLinker +import System.Directory.Extra +import System.Process.Extra +import System.FilePath +import Test.Hspec + +type Value = Word32 + +data Bindings + = Bindings + { dynamicLib :: DL + , symBindings :: S.Bindings + , withHashMap :: (Ptr HashMap -> IO ()) -> IO () + , bInit :: Ptr HashMap -> IO () + , bDestroy :: Ptr HashMap -> IO () + , bGetOrPut :: Ptr HashMap -> Ptr S.Symbol -> Value -> IO Value + , bLookup :: Ptr HashMap -> Ptr S.Symbol -> IO Value + , bContains :: Ptr HashMap -> Ptr S.Symbol -> IO Bool + } + +spec :: Spec +spec = describe "HashMap" $ aroundAll (setupAndTeardown testDir) $ parallel $ do + it "can be initialized and destroyed" $ \bindings -> + withHashMap bindings $ \hm -> do + bInit bindings hm + bDestroy bindings hm + + it "stores a new value if the requested key was not found" $ \bindings -> do + let sBindings = symBindings bindings + withHashMap bindings $ \hm -> do + bInit bindings hm + + withSym sBindings "abcd" $ \sym -> do + value1 <- bGetOrPut bindings hm sym 42 + value1 `shouldBe` 42 + + -- different symbol -> separate entry in the hashmap + withSym sBindings "abcdef" $ \sym' -> do + value3 <- bGetOrPut bindings hm sym' 34 + value3 `shouldBe` 34 + pass + + bDestroy bindings hm + + it "retrieves the old value if the requested key was found" $ \bindings -> do + let sBindings = symBindings bindings + withHashMap bindings $ \hm -> do + bInit bindings hm + + withSym sBindings "abcd" $ \sym -> do + value1 <- bGetOrPut bindings hm sym 42 + value1 `shouldBe` 42 + value2 <- bGetOrPut bindings hm sym 100 + value2 `shouldBe` 42 + + -- same symbol -> same entry in the hashmap + withSym sBindings "abcd" $ \sym' -> do + value4 <- bGetOrPut bindings hm sym' 34 + value4 `shouldBe` 42 + + bDestroy bindings hm + + it "is possible to lookup keys in the hashmap" $ \bindings -> do + let sBindings = symBindings bindings + withHashMap bindings $ \hm -> do + bInit bindings hm + + -- key found + withSym sBindings "abcd" $ \sym -> do + _ <- bGetOrPut bindings hm sym 42 + value <- bLookup bindings hm sym + value `shouldBe` 42 + + -- key not found + withSym sBindings "123" $ \sym -> do + value <- bLookup bindings hm sym + value `shouldBe` 0xffffffff + + bDestroy bindings hm + + it "is possible to check if a hashmap contains a key" $ \bindings -> do + let sBindings = symBindings bindings + withHashMap bindings $ \hm -> do + bInit bindings hm + + -- key found + withSym sBindings "abcd" $ \sym -> do + _ <- bGetOrPut bindings hm sym 42 + value <- bContains bindings hm sym + value `shouldBe` True + + -- key not found + withSym sBindings "123" $ \sym -> do + value <- bContains bindings hm sym + value `shouldBe` False + + bDestroy bindings hm + +-- TODO big hashmap test + test for colissions + +setupAndTeardown :: FilePath -> ActionWith Bindings -> IO () +setupAndTeardown dir = + bracket (setup dir) teardown + +setup :: FilePath -> IO Bindings +setup dir = do + createDirectoryIfMissing False dir + compileCode cgExternals cgTestCode dir + loadNativeCode dir + +teardown :: Bindings -> IO () +teardown = + dlclose . dynamicLib + +compileCode + :: ModuleBuilderT IO Externals + -> (S.Symbol -> HashMap -> Externals -> ModuleBuilderT IO ()) + -> FilePath -> IO () +compileCode cgExts cgHelperCode dir = do + ctx <- LibLLVM.mkContext + llvmMod <- LibLLVM.mkModule ctx "eclair" + td <- LibLLVM.getTargetData llvmMod + llvmIR <- runModuleBuilderT $ do + exts <- cgExts + let cfg = Config Nothing ctx td + sym <- hoist intoIO $ S.codegen exts + hm <- runConfigT cfg $ codegen sym exts + cgHelperCode sym hm exts + let llvmIRText = ppllvm llvmIR + writeFileText (llFile dir) llvmIRText + callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir] + +intoIO :: Identity a -> IO a +intoIO = pure . runIdentity + +cgExternals :: ModuleBuilderT IO Externals +cgExternals = do + mallocFn <- extern "malloc" [i32] (ptr i8) + freeFn <- extern "free" [ptr i8] void + memcpyFn <- extern "memcpy" [ptr i8, ptr i8, i64] (ptr i8) + memcmpFn <- extern "memcmp" [ptr i8, ptr i8, i64] i32 + pure $ Externals mallocFn freeFn notUsed memcpyFn memcmpFn notUsed notUsed + +cgTestCode :: S.Symbol -> HashMap -> Externals -> ModuleBuilderT IO () +cgTestCode sym hm exts = do + let hmTypes = hashMapTypes hm + hmTy = tyHashMap hmTypes + tySym = tyKey hmTypes + mallocFn = extMalloc exts + freeFn = extFree exts + + _ <- function "eclair_hashmap_new" [] (ptr hmTy) $ \[] -> + ret =<< call mallocFn [int32 $ 64 * 32] -- 64 vectors long + _ <- function "eclair_hashmap_delete" [(ptr hmTy, "hm")] void $ \[h] -> + call freeFn [h] + let args = [(ptr hmTy, "hashmap"), (ptr tySym, "symbol")] + _ <- function "eclair_hashmap_contains_helper" args i8 $ \[h, s] -> do + result <- call (hashMapContains hm) [h, s] + ret =<< result `zext` i8 + + S.cgTestCode sym exts + +loadNativeCode :: FilePath -> IO Bindings +loadNativeCode dir = do + lib <- dlopen (soFile dir) [RTLD_LAZY] + sBindings <- S.loadNativeCode' lib + fnNew <- dlsym lib "eclair_hashmap_new" + fnDelete <- dlsym lib "eclair_hashmap_delete" + fnInit <- dlsym lib "eclair_hashmap_init" + fnDestroy <- dlsym lib "eclair_hashmap_destroy" + fnGetOrPut <- dlsym lib "eclair_hashmap_get_or_put_value" + fnContains <- dlsym lib "eclair_hashmap_contains_helper" + fnLookup <- dlsym lib "eclair_hashmap_lookup" + pure $ Bindings + { dynamicLib = lib + , symBindings = sBindings + , withHashMap = mkWithHashMap fnNew fnDelete + , bInit = mkInit fnInit + , bDestroy = mkDestroy fnDestroy + , bGetOrPut = mkGetOrPut fnGetOrPut + , bContains = mkContains fnContains + , bLookup = mkLookup fnLookup + } + where + mkNew fn = callFFI fn (retPtr retVoid) [] + mkDelete fn hm = callFFI fn retVoid [argPtr hm] + mkWithHashMap fnNew fnDelete = + bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete) + mkInit fn hm = callFFI fn retVoid [argPtr hm] + mkDestroy fn hm = callFFI fn retVoid [argPtr hm] + mkGetOrPut fn hm sym value = + fromIntegral <$> callFFI fn retCUInt [argPtr hm, argPtr sym, argCUInt $ fromIntegral value] + mkContains fn hm sym = do + result <- callFFI fn retCUChar [argPtr hm, argPtr sym] + pure $ result == 1 + mkLookup fn hm sym = + fromIntegral <$> callFFI fn retCUInt [argPtr hm, argPtr sym] + +testDir :: FilePath +testDir = "/tmp/eclair-hashmap" + +llFile, soFile :: FilePath -> FilePath +llFile dir = dir "hashmap.ll" +soFile dir = dir "hashmap.so" + +notUsed :: a +notUsed = panic "Not used" + +withSym :: S.Bindings -> String -> (Ptr S.Symbol -> IO a) -> IO a +withSym bindings str f = do + S.withSymbol bindings $ \sym -> do + S.bInit bindings sym str + result <- f sym + S.bDestroy bindings sym + pure result diff --git a/tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs b/tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs index 904c395..32a5b0c 100644 --- a/tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs +++ b/tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs @@ -4,32 +4,17 @@ module Test.Eclair.LLVM.SymbolSpec ) where import Prelude hiding (void, Symbol) +import Test.Eclair.LLVM.SymbolUtils import Control.Monad.Morph import Control.Exception import Eclair.LLVM.Symbol import Eclair.LLVM.Codegen hiding (retVoid, nullPtr) import Eclair.LLVM.Externals -import Foreign.LibFFI -import Foreign hiding (void, bit) import System.Posix.DynamicLinker import System.Directory.Extra import System.Process.Extra -import System.FilePath import Test.Hspec -import Foreign.C -type I8 = CUChar - -data Bindings - = Bindings - { dynamicLib :: DL - , withSymbol :: (Ptr Symbol -> IO ()) -> IO () - , bInit :: Ptr Symbol -> String -> IO () - , bDestroy :: Ptr Symbol -> IO () - , bIsEqual :: Ptr Symbol -> Ptr Symbol -> IO Bool - , bLength :: Ptr Symbol -> IO Word32 - , bData :: Ptr Symbol -> IO String - } spec :: Spec spec = describe "Symbol" $ aroundAll (setupAndTeardown testDir) $ parallel $ do @@ -95,81 +80,9 @@ cgExternals = do memcmpFn <- extern "memcmp" [ptr i8, ptr i8, i64] i32 pure $ Externals mallocFn freeFn notUsed memcpyFn memcmpFn notUsed notUsed -cgTestCode :: Symbol -> Externals -> ModuleBuilderT IO () -cgTestCode sym exts = do - let mallocFn = extMalloc exts - freeFn = extFree exts - memcpyFn = extMemcpy exts - symTy = tySymbol sym - _ <- function "eclair_symbol_new" [] (ptr symTy) $ \[] -> - ret =<< call mallocFn [int32 16] - _ <- function "eclair_symbol_delete" [(ptr symTy, "sym")] void $ \[s] -> - call freeFn [s] - let initArgs = [(ptr symTy, "sym"), (i32, "length"), (ptr i8, "data")] - _ <- function "eclair_symbol_init_helper" initArgs void $ \[s, len, str] -> do - -- Needed because "str" is freed afterwards - memory <- call mallocFn [len] - _ <- call memcpyFn [memory, str, len, bit 0] - _ <- call (symbolInit sym) [s, len, memory] - pass - let isEqArgs = [(ptr symTy, "sym1"), (ptr symTy, "sym2")] - _ <- function "eclair_symbol_is_equal_helper" isEqArgs i8 $ \[sym1, sym2] -> do - isEq <- call (symbolIsEqual sym) [sym1, sym2] - ret =<< isEq `zext` i8 - _ <- function "eclair_symbol_length" [(ptr symTy, "sym")] i32 $ \[s] -> do - lenPtr <- gep s [int32 0, int32 0] - ret =<< load lenPtr 0 - _ <- function "eclair_symbol_data" [(ptr symTy, "sym")] (ptr i8) $ \[s] -> do - lenPtr <- gep s [int32 0, int32 1] - ret =<< load lenPtr 0 - pass - -loadNativeCode :: FilePath -> IO Bindings -loadNativeCode dir = do - lib <- dlopen (soFile dir) [RTLD_LAZY] - fnNew <- dlsym lib "eclair_symbol_new" - fnDelete <- dlsym lib "eclair_symbol_delete" - fnInit <- dlsym lib "eclair_symbol_init_helper" - fnDestroy <- dlsym lib "eclair_symbol_destroy" - fnIsEqual <- dlsym lib "eclair_symbol_is_equal_helper" - fnLength <- dlsym lib "eclair_symbol_length" - fnData <- dlsym lib "eclair_symbol_data" - let getLength = mkLength fnLength - pure $ Bindings - { dynamicLib = lib - , withSymbol = mkWithSymbol fnNew fnDelete - , bInit = mkInit fnInit - , bDestroy = mkDestroy fnDestroy - , bIsEqual = mkIsEqual fnIsEqual - , bLength = getLength - , bData = mkData fnData getLength - } - where - mkNew fn = callFFI fn (retPtr retVoid) [] - mkDelete fn sym = callFFI fn retVoid [argPtr sym] - mkWithSymbol fnNew fnDelete = - bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete) - mkInit fn sym str = do - let len = fromIntegral $ length str - callFFI fn retVoid [argPtr sym, argCUInt len, argString str] - mkDestroy fn sym = callFFI fn retVoid [argPtr sym] - mkIsEqual fn sym1 sym2 = do - result <- callFFI fn retCUChar [argPtr sym1, argPtr sym2] - pure $ result == 1 - mkLength fn sym = do - fromIntegral <$> callFFI fn retCUInt [argPtr sym] - mkData fn getLength sym = do - len <- fromIntegral <$> getLength sym - strPtr <- callFFI fn (retPtr retCChar) [argPtr sym] - peekCAStringLen (strPtr, len) - testDir :: FilePath testDir = "/tmp/eclair-symbol" -llFile, soFile :: FilePath -> FilePath -llFile dir = dir "symbol.ll" -soFile dir = dir "symbol.so" - notUsed :: a notUsed = panic "Not used" diff --git a/tests/eclair/Test/Eclair/LLVM/SymbolUtils.hs b/tests/eclair/Test/Eclair/LLVM/SymbolUtils.hs new file mode 100644 index 0000000..3d58d67 --- /dev/null +++ b/tests/eclair/Test/Eclair/LLVM/SymbolUtils.hs @@ -0,0 +1,110 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +module Test.Eclair.LLVM.SymbolUtils + ( Bindings(..) + , Symbol(..) + , cgTestCode + , loadNativeCode + , loadNativeCode' + , soFile + , llFile + ) where + +import Prelude hiding (void, Symbol) +import Control.Exception +import Eclair.LLVM.Symbol +import Eclair.LLVM.Codegen hiding (retVoid, nullPtr) +import Eclair.LLVM.Externals +import Foreign.LibFFI +import Foreign hiding (void, bit) +import System.Posix.DynamicLinker +import System.FilePath +import Foreign.C + +data Bindings + = Bindings + { dynamicLib :: DL + , withSymbol :: forall a. (Ptr Symbol -> IO a) -> IO a + , bInit :: Ptr Symbol -> String -> IO () + , bDestroy :: Ptr Symbol -> IO () + , bIsEqual :: Ptr Symbol -> Ptr Symbol -> IO Bool + , bLength :: Ptr Symbol -> IO Word32 + , bData :: Ptr Symbol -> IO String + } + +cgTestCode :: Symbol -> Externals -> ModuleBuilderT IO () +cgTestCode sym exts = do + let mallocFn = extMalloc exts + freeFn = extFree exts + memcpyFn = extMemcpy exts + symTy = tySymbol sym + _ <- function "eclair_symbol_new" [] (ptr symTy) $ \[] -> + ret =<< call mallocFn [int32 16] + _ <- function "eclair_symbol_delete" [(ptr symTy, "sym")] void $ \[s] -> + call freeFn [s] + let initArgs = [(ptr symTy, "sym"), (i32, "length"), (ptr i8, "data")] + _ <- function "eclair_symbol_init_helper" initArgs void $ \[s, len, str] -> do + -- Needed because "str" is freed afterwards + memory <- call mallocFn [len] + _ <- call memcpyFn [memory, str, len, bit 0] + _ <- call (symbolInit sym) [s, len, memory] + pass + let isEqArgs = [(ptr symTy, "sym1"), (ptr symTy, "sym2")] + _ <- function "eclair_symbol_is_equal_helper" isEqArgs i8 $ \[sym1, sym2] -> do + isEq <- call (symbolIsEqual sym) [sym1, sym2] + ret =<< isEq `zext` i8 + _ <- function "eclair_symbol_length" [(ptr symTy, "sym")] i32 $ \[s] -> do + lenPtr <- gep s [int32 0, int32 0] + ret =<< load lenPtr 0 + _ <- function "eclair_symbol_data" [(ptr symTy, "sym")] (ptr i8) $ \[s] -> do + lenPtr <- gep s [int32 0, int32 1] + ret =<< load lenPtr 0 + pass + +loadNativeCode :: FilePath -> IO Bindings +loadNativeCode dir = do + lib <- dlopen (soFile dir) [RTLD_LAZY] + loadNativeCode' lib + +loadNativeCode' :: DL -> IO Bindings +loadNativeCode' lib = do + fnNew <- dlsym lib "eclair_symbol_new" + fnDelete <- dlsym lib "eclair_symbol_delete" + fnInit <- dlsym lib "eclair_symbol_init_helper" + fnDestroy <- dlsym lib "eclair_symbol_destroy" + fnIsEqual <- dlsym lib "eclair_symbol_is_equal_helper" + fnLength <- dlsym lib "eclair_symbol_length" + fnData <- dlsym lib "eclair_symbol_data" + let getLength = mkLength fnLength + pure $ Bindings + { dynamicLib = lib + , withSymbol = mkWithSymbol fnNew fnDelete + , bInit = mkInit fnInit + , bDestroy = mkDestroy fnDestroy + , bIsEqual = mkIsEqual fnIsEqual + , bLength = getLength + , bData = mkData fnData getLength + } + where + mkNew fn = callFFI fn (retPtr retVoid) [] + mkDelete fn sym = callFFI fn retVoid [argPtr sym] + mkWithSymbol fnNew fnDelete = + bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete) + mkInit fn sym str = do + let len = fromIntegral $ length str + callFFI fn retVoid [argPtr sym, argCUInt len, argString str] + mkDestroy fn sym = callFFI fn retVoid [argPtr sym] + mkIsEqual fn sym1 sym2 = do + result <- callFFI fn retCUChar [argPtr sym1, argPtr sym2] + pure $ result == 1 + mkLength fn sym = do + fromIntegral <$> callFFI fn retCUInt [argPtr sym] + mkData fn getLength sym = do + len <- fromIntegral <$> getLength sym + strPtr <- callFFI fn (retPtr retCChar) [argPtr sym] + peekCAStringLen (strPtr, len) + +soFile :: FilePath -> FilePath +soFile dir = dir "symbol.so" + +llFile :: FilePath -> FilePath +llFile dir = dir "symbol.ll" From 645618eafae6e985d8915f1990b2299a31eb2b7c Mon Sep 17 00:00:00 2001 From: Krishna Padmasola Date: Sat, 7 Oct 2023 18:54:34 +0530 Subject: [PATCH 4/9] Add page allocator tests --- eclair-lang.cabal | 1 + lib/Eclair/LLVM/Allocator/Page.hs | 1 + .../Test/Eclair/LLVM/Allocator/MallocSpec.hs | 6 +- .../Test/Eclair/LLVM/Allocator/PageSpec.hs | 120 ++++++++++++++++++ .../Test/Eclair/LLVM/Allocator/Utils.hs | 6 +- 5 files changed, 130 insertions(+), 4 deletions(-) create mode 100644 tests/eclair/Test/Eclair/LLVM/Allocator/PageSpec.hs diff --git a/eclair-lang.cabal b/eclair-lang.cabal index 48997a8..f2b0a36 100644 --- a/eclair-lang.cabal +++ b/eclair-lang.cabal @@ -257,6 +257,7 @@ test-suite eclair-test Test.Eclair.ArgParserSpec Test.Eclair.JSONSpec Test.Eclair.LLVM.Allocator.MallocSpec + Test.Eclair.LLVM.Allocator.PageSpec Test.Eclair.LLVM.Allocator.Utils Test.Eclair.LLVM.BTreeSpec Test.Eclair.LLVM.HashMapSpec diff --git a/lib/Eclair/LLVM/Allocator/Page.hs b/lib/Eclair/LLVM/Allocator/Page.hs index d930dc4..9112f61 100644 --- a/lib/Eclair/LLVM/Allocator/Page.hs +++ b/lib/Eclair/LLVM/Allocator/Page.hs @@ -1,6 +1,7 @@ module Eclair.LLVM.Allocator.Page ( Page , allocator + , roundToNearestPageSize -- for testing only ) where import Eclair.LLVM.Allocator.Common diff --git a/tests/eclair/Test/Eclair/LLVM/Allocator/MallocSpec.hs b/tests/eclair/Test/Eclair/LLVM/Allocator/MallocSpec.hs index a9ffe30..95b7f97 100644 --- a/tests/eclair/Test/Eclair/LLVM/Allocator/MallocSpec.hs +++ b/tests/eclair/Test/Eclair/LLVM/Allocator/MallocSpec.hs @@ -59,8 +59,10 @@ cgExternals = do pure $ Externals mallocFn freeFn notUsed notUsed notUsed notUsed notUsed -- Helper test code for initializing and freeing a struct from native code: -cgTestCode :: Type -> Operand -> Operand -> ModuleBuilderT IO () -cgTestCode ty mallocFn freeFn = do +cgTestCode :: Type -> Externals -> ModuleBuilderT IO () +cgTestCode ty exts = do + let mallocFn = extMalloc exts + freeFn = extFree exts _ <- function "mallocator_new" [] (ptr ty) $ \[] -> ret =<< call mallocFn [int32 1] _ <- function "mallocator_delete" [(ptr ty, "allocator")] void $ \[alloc] -> diff --git a/tests/eclair/Test/Eclair/LLVM/Allocator/PageSpec.hs b/tests/eclair/Test/Eclair/LLVM/Allocator/PageSpec.hs new file mode 100644 index 0000000..045f8ea --- /dev/null +++ b/tests/eclair/Test/Eclair/LLVM/Allocator/PageSpec.hs @@ -0,0 +1,120 @@ +{-# OPTIONS_GHC -Wno-deprecations -Wno-incomplete-uni-patterns #-} +module Test.Eclair.LLVM.Allocator.PageSpec + ( module Test.Eclair.LLVM.Allocator.PageSpec + ) where + +import Prelude hiding (void) +import Control.Monad.Morph +import Eclair.LLVM.Allocator.Page +import Eclair.LLVM.Allocator.Common +import Test.Eclair.LLVM.Allocator.Utils +import Eclair.LLVM.Codegen hiding (retVoid) +import System.Directory.Extra +import System.Posix.DynamicLinker +import Test.Hspec +import Control.Exception (bracket) +import Foreign hiding (void) +import Foreign.LibFFI + +data PageAllocator + +spec :: Spec +spec = describe "PageAllocator" $ + aroundAll (setupAndTeardown testDir) $ parallel $ do + it "can be initialized and destroyed" $ \bindings -> + withAlloc bindings $ \obj -> do + fnInit bindings obj + fnDestroy bindings obj + + it "can allocate and free memory" $ \bindings -> do + let numBytes = 1 + value = 42 + withAlloc bindings $ \obj -> do + fnInit bindings obj + memory <- fnAlloc bindings obj numBytes + let memoryEnd = memory `plusPtr` 4095 + poke memory value + poke memoryEnd value + value' <- peek memory + valueEnd <- peek memoryEnd + fnFree bindings obj memory numBytes + fnDestroy bindings obj + value' `shouldBe` value + valueEnd `shouldBe` value + + it "rounds up to the nearest page size" $ \_ -> do + withNearestPageSize $ \roundFn -> do + result1 <- roundFn 1 + result2 <- roundFn 4096 + result3 <- roundFn 4097 + result4 <- roundFn 0 + result5 <- roundFn 12345678 + result1 `shouldBe` 4096 + result2 `shouldBe` 4096 + result3 `shouldBe` (4096 * 2) + result4 `shouldBe` 0 + result5 `shouldBe` 12349440 + +setupAndTeardown :: FilePath -> ActionWith (Bindings PageAllocator) -> IO () +setupAndTeardown dir = + bracket (setup dir) teardown + +setup :: FilePath -> IO (Bindings PageAllocator) +setup dir = do + createDirectoryIfMissing False dir + compileAllocatorCode allocator prefix cgExternals cgTestCode dir + loadNativeCode prefix dir + +teardown :: Bindings PageAllocator -> IO () +teardown = + dlclose . dynamicLib + +cgExternals :: ModuleBuilderT IO Externals +cgExternals = do + -- Need malloc and free to allocate the allocator itself + mallocFn <- extern "malloc" [i32] (ptr i8) + freeFn <- extern "free" [ptr i8] void + -- mmap [hint, numBytes', prot, flags, noFd, offset] + mmapFn <- extern "mmap" [ptr void, i64, i32, i32, i32, i32] (ptr void) + -- munmap [memory, len'] + munmapFn <- extern "munmap" [ptr void, i64] i32 + pure $ Externals mallocFn freeFn notUsed notUsed notUsed mmapFn munmapFn + +-- Helper test code for allocating and freeing a struct from native code: +cgTestCode :: Type -> Externals -> ModuleBuilderT IO () +cgTestCode ty exts = do + let mallocFn = extMalloc exts + freeFn = extFree exts + _ <- function "pageallocator_new" [] (ptr ty) $ \[] -> + ret =<< call mallocFn [int32 1] + _ <- function "pageallocator_delete" [(ptr ty, "allocator")] void $ \[alloc] -> + call freeFn [alloc] + let roundToNearestInstructions numBytes = + hoist (hoist intoIO) $ hoist (`evalStateT` exts) $ roundToNearestPageSize numBytes + _ <- function "nearest_page_size" [(i32, "num_bytes")] i32 $ \[num] -> + ret =<< roundToNearestInstructions num + pass + +withNearestPageSize :: ((Word32 -> IO Word32) -> IO ()) -> IO () +withNearestPageSize f = + bracket open close (\(_, roundFn) -> f roundFn) + where + open = do + dl <- dlopen (soFile testDir) [RTLD_LAZY] + roundingFn <- dlsym dl "nearest_page_size" + let roundFn numBytes = + fromIntegral <$> callFFI roundingFn retCUInt [argCUInt $ fromIntegral numBytes] + pure (dl, roundFn) + close = dlclose . fst + +prefix :: Text +prefix = "pageallocator" + +testDir :: FilePath +testDir = "/tmp/eclair-pageallocator" + +notUsed :: a +notUsed = panic "Not used" + +intoIO :: Identity a -> IO a +intoIO = pure . runIdentity diff --git a/tests/eclair/Test/Eclair/LLVM/Allocator/Utils.hs b/tests/eclair/Test/Eclair/LLVM/Allocator/Utils.hs index e0f836a..5337083 100644 --- a/tests/eclair/Test/Eclair/LLVM/Allocator/Utils.hs +++ b/tests/eclair/Test/Eclair/LLVM/Allocator/Utils.hs @@ -1,7 +1,9 @@ +{-# OPTIONS_GHC -Wno-deprecations #-} module Test.Eclair.LLVM.Allocator.Utils ( Bindings(..) , compileAllocatorCode , loadNativeCode + , soFile ) where import System.Process.Extra @@ -31,14 +33,14 @@ compileAllocatorCode :: Allocator a -> Text -> ModuleBuilderT IO Externals - -> (Type -> Operand -> Operand -> ModuleBuilderT IO ()) + -> (Type -> Externals -> ModuleBuilderT IO ()) -> FilePath -> IO () compileAllocatorCode allocator prefix cgExts cgHelperCode dir = do llvmIR <- runModuleBuilderT $ do exts <- cgExts let cgBlueprint = flip evalStateT exts $ cgAlloc prefix allocator blueprint <- hoist intoIO cgBlueprint - cgHelperCode (bpType blueprint) (extMalloc exts) (extFree exts) + cgHelperCode (bpType blueprint) exts let llvmIRText = ppllvm llvmIR writeFileText (llFile dir) llvmIRText callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir] From 194bc5dc9fba2c7bfd398b5f7a576b834bfdee7c Mon Sep 17 00:00:00 2001 From: Luc Tielen Date: Sun, 8 Oct 2023 12:08:32 +0200 Subject: [PATCH 5/9] Add symbol table tests --- eclair-lang.cabal | 1 + lib/Eclair/LLVM/Symbol.hs | 4 +- .../Test/Eclair/LLVM/SymbolTableSpec.hs | 257 ++++++++++++++++++ 3 files changed, 260 insertions(+), 2 deletions(-) create mode 100644 tests/eclair/Test/Eclair/LLVM/SymbolTableSpec.hs diff --git a/eclair-lang.cabal b/eclair-lang.cabal index 48997a8..13d758c 100644 --- a/eclair-lang.cabal +++ b/eclair-lang.cabal @@ -262,6 +262,7 @@ test-suite eclair-test Test.Eclair.LLVM.HashMapSpec Test.Eclair.LLVM.HashSpec Test.Eclair.LLVM.SymbolSpec + Test.Eclair.LLVM.SymbolTableSpec Test.Eclair.LLVM.SymbolUtils Test.Eclair.LLVM.VectorSpec Test.Eclair.LSP.HandlersSpec diff --git a/lib/Eclair/LLVM/Symbol.hs b/lib/Eclair/LLVM/Symbol.hs index 4cb3d69..881f834 100644 --- a/lib/Eclair/LLVM/Symbol.hs +++ b/lib/Eclair/LLVM/Symbol.hs @@ -90,8 +90,8 @@ mkSymbolIsEqual = do data1 <- deref dataOf symbol1 data2 <- deref dataOf symbol2 size1' <- zext size1 i64 - isDataEqual <- (`eq` bit 0) =<< call memcmpFn [data1, data2, size1'] - ret isDataEqual + result <- call memcmpFn [data1, data2, size1'] + ret =<< result `eq` bit 0 data Index = SymbolIdx diff --git a/tests/eclair/Test/Eclair/LLVM/SymbolTableSpec.hs b/tests/eclair/Test/Eclair/LLVM/SymbolTableSpec.hs new file mode 100644 index 0000000..0a97ecb --- /dev/null +++ b/tests/eclair/Test/Eclair/LLVM/SymbolTableSpec.hs @@ -0,0 +1,257 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +module Test.Eclair.LLVM.SymbolTableSpec + ( module Test.Eclair.LLVM.SymbolTableSpec + ) where + +import Prelude hiding (void, Symbol) +import qualified LLVM.C.API as LibLLVM +import qualified Test.Eclair.LLVM.SymbolUtils as S +import Control.Monad.Morph +import Control.Exception +import Eclair.LLVM.SymbolTable +import qualified Eclair.LLVM.Symbol as S +import qualified Eclair.LLVM.Vector as V +import qualified Eclair.LLVM.HashMap as HM +import Eclair.LLVM.Codegen hiding (retVoid, nullPtr) +import Eclair.LLVM.Externals +import System.Posix.DynamicLinker +import System.Directory.Extra +import System.Process.Extra +import System.FilePath +import Foreign hiding (void) +import Foreign.LibFFI +import Test.Hspec + + +type Symbol = S.Symbol +type Value = Word32 + +data Bindings + = Bindings + { dynamicLib :: DL + , symBindings :: S.Bindings + , withSymTab :: (Ptr SymbolTable -> IO ()) -> IO () + , bInit :: Ptr SymbolTable -> IO () + , bDestroy :: Ptr SymbolTable -> IO () + , bFindOrInsert :: Ptr SymbolTable -> Ptr Symbol -> IO Value + -- NOTE: no need to free returned symbol after lookup + , bLookupSymbol :: Ptr SymbolTable -> Value -> IO (Ptr Symbol) + , bContainsSymbol :: Ptr SymbolTable -> Ptr Symbol -> IO Bool + , bLookupIndex :: Ptr SymbolTable -> Ptr Symbol -> IO Value + , bContainsIndex :: Ptr SymbolTable -> Value -> IO Bool + } + +spec :: Spec +spec = describe "Symbol table" $ aroundAll (setupAndTeardown testDir) $ parallel $ do + it "can be initialized and destroyed" $ \bindings -> + withSymTab bindings $ \st -> do + bInit bindings st + bDestroy bindings st + + it "is possible to add symbols to the table" $ \bindings -> do + let sBindings = symBindings bindings + withSymTab bindings $ \st -> do + bInit bindings st + _ <- S.withSymbol sBindings $ \sym -> do + S.bInit sBindings sym "abcd" + idx <- bFindOrInsert bindings st sym + idx `shouldBe` 0 + idx' <- bFindOrInsert bindings st sym + idx' `shouldBe` 0 + -- Owned by symbol table now: + -- S.bDestroy sBindings sym + + _ <- S.withSymbol sBindings $ \sym -> do + S.bInit sBindings sym "123" + idx <- bFindOrInsert bindings st sym + idx `shouldBe` 1 + -- Owned by symbol table now: + -- S.bDestroy sBindings sym + + bDestroy bindings st + + it "is possible to check if the table contains a key" $ \bindings -> do + let sBindings = symBindings bindings + withSymTab bindings $ \st -> do + bInit bindings st + _ <- S.withSymbol sBindings $ \sym -> do + S.bInit sBindings sym "abcd" + result1 <- bContainsSymbol bindings st sym + _ <- bFindOrInsert bindings st sym + result2 <- bContainsSymbol bindings st sym + S.bDestroy sBindings sym + result1 `shouldBe` False + result2 `shouldBe` True + pass + + it "is possible to check if the table contains a value" $ \bindings -> do + let sBindings = symBindings bindings + withSymTab bindings $ \st -> do + bInit bindings st + _ <- S.withSymbol sBindings $ \sym -> do + S.bInit sBindings sym "abcd" + result1 <- bContainsIndex bindings st 0 + _ <- bFindOrInsert bindings st sym + result2 <- bContainsIndex bindings st 0 + S.bDestroy sBindings sym + result1 `shouldBe` False + result2 `shouldBe` True + pass + + it "is possible to lookup a key corresponding to a value" $ \bindings -> do + let sBindings = symBindings bindings + withSymTab bindings $ \st -> do + bInit bindings st + _ <- S.withSymbol sBindings $ \sym -> do + S.bInit sBindings sym "abcd" + -- NOTE: unsafe lookup, don't use it before symbol is inserted + -- sym1 <- bLookupSymbol bindings st 0 + idx <- bFindOrInsert bindings st sym + idx `shouldBe` 0 + print =<< bContainsSymbol bindings st sym + sym' <- bLookupSymbol bindings st idx + -- Owned by symbol table now: + -- S.bDestroy sBindings sym + result <- S.bIsEqual sBindings sym sym' + result `shouldBe` True + pass + pass + + it "is possible to lookup a value corresponding to a key" $ \bindings -> do + let sBindings = symBindings bindings + withSymTab bindings $ \st -> do + bInit bindings st + _ <- S.withSymbol sBindings $ \sym -> do + S.bInit sBindings sym "abcd" + -- NOTE: unsafe lookup, don't use it before symbol is inserted + idx1 <- bLookupIndex bindings st sym + _ <- bFindOrInsert bindings st sym + idx2 <- bLookupIndex bindings st sym + S.bDestroy sBindings sym + idx1 `shouldBe` 0xffffffff + idx2 `shouldBe` 0 + pass + +setupAndTeardown :: FilePath -> ActionWith Bindings -> IO () +setupAndTeardown dir = + bracket (setup dir) teardown + +setup :: FilePath -> IO Bindings +setup dir = do + createDirectoryIfMissing False dir + compileCode cgExternals cgTestCode dir + loadNativeCode dir + +teardown :: Bindings -> IO () +teardown = + dlclose . dynamicLib + +compileCode + :: ModuleBuilderT IO Externals + -> (Symbol -> SymbolTable -> Externals -> ModuleBuilderT IO ()) + -> FilePath -> IO () +compileCode cgExts cgHelperCode dir = do + ctx <- LibLLVM.mkContext + llvmMod <- LibLLVM.mkModule ctx "eclair" + td <- LibLLVM.getTargetData llvmMod + llvmIR <- runModuleBuilderT $ do + exts <- cgExts + symbol <- hoist intoIO $ S.codegen exts + let cfg = Config Nothing ctx td + symbolDestructor iterPtr = do + _ <- call (S.symbolDestroy symbol) [iterPtr] + pass + vec <- instantiate "test" (S.tySymbol symbol) $ runConfigT cfg $ V.codegen exts (Just symbolDestructor) + hm <- runConfigT cfg $ HM.codegen symbol exts + symTab <- hoist intoIO $ codegen (S.tySymbol symbol) vec hm + cgHelperCode symbol symTab exts + let llvmIRText = ppllvm llvmIR + writeFileText (llFile dir) llvmIRText + callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir] + +cgExternals :: ModuleBuilderT IO Externals +cgExternals = do + mallocFn <- extern "malloc" [i32] (ptr i8) + freeFn <- extern "free" [ptr i8] void + memcpyFn <- extern "memcpy" [ptr i8, ptr i8, i64] (ptr i8) + memcmpFn <- extern "memcmp" [ptr i8, ptr i8, i64] i32 + pure $ Externals mallocFn freeFn notUsed memcpyFn memcmpFn notUsed notUsed + +cgTestCode :: S.Symbol -> SymbolTable -> Externals -> ModuleBuilderT IO () +cgTestCode sym symTab exts = do + let mallocFn = extMalloc exts + freeFn = extFree exts + tySym = S.tySymbol sym + symTabTy = tySymbolTable symTab + _ <- function "eclair_symbol_table_new" [] (ptr symTabTy) $ \[] -> + ret =<< call mallocFn [int32 4096] + _ <- function "eclair_symbol_table_delete" [(ptr symTabTy, "hm")] void $ \[h] -> + call freeFn [h] + let args = [(ptr symTabTy, "symbol_table"), (ptr tySym, "symbol")] + _ <- function "eclair_symbol_table_contains_symbol_helper" args i8 $ \[st, s] -> do + result <- call (symbolTableContainsSymbol symTab) [st, s] + ret =<< result `zext` i8 + let args' = [(ptr symTabTy, "symbol_table"), (i32, "value")] + _ <- function "eclair_symbol_table_contains_index_helper" args' i8 $ \[st, v] -> do + result <- call (symbolTableContainsIndex symTab) [st, v] + ret =<< result `zext` i8 + + S.cgTestCode sym exts + +loadNativeCode :: FilePath -> IO Bindings +loadNativeCode dir = do + lib <- dlopen (soFile dir) [RTLD_LAZY] + sBindings <- S.loadNativeCode' lib + fnNew <- dlsym lib "eclair_symbol_table_new" + fnDelete <- dlsym lib "eclair_symbol_table_delete" + fnInit <- dlsym lib "eclair_symbol_table_init" + fnDestroy <- dlsym lib "eclair_symbol_table_destroy" + fnFindOrInsert <- dlsym lib "eclair_symbol_table_find_or_insert" + fnLookupSymbol <- dlsym lib "eclair_symbol_table_lookup_symbol" + fnContainsSymbol <- dlsym lib "eclair_symbol_table_contains_symbol_helper" + fnLookupIndex <- dlsym lib "eclair_symbol_table_lookup_index" + fnContainsIndex <- dlsym lib "eclair_symbol_table_contains_index_helper" + pure $ Bindings + { dynamicLib = lib + , symBindings = sBindings + , withSymTab = mkWithSymTab fnNew fnDelete + , bInit = mkInit fnInit + , bDestroy = mkDestroy fnDestroy + , bFindOrInsert = mkFindOrInsert fnFindOrInsert + , bLookupSymbol = mkLookupSymbol fnLookupSymbol + , bLookupIndex = mkLookupIndex fnLookupIndex + , bContainsSymbol = mkContainsSymbol fnContainsSymbol + , bContainsIndex = mkContainsIndex fnContainsIndex + } + where + mkNew fn = callFFI fn (retPtr retVoid) [] + mkDelete fn st = callFFI fn retVoid [argPtr st] + mkWithSymTab fnNew fnDelete = + bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete) + mkInit fn st = callFFI fn retVoid [argPtr st] + mkDestroy fn st = callFFI fn retVoid [argPtr st] + mkFindOrInsert fn st sym = + fromIntegral <$> callFFI fn retCUInt [argPtr st, argPtr sym] + mkLookupSymbol fn st value = + castPtr <$> callFFI fn (retPtr retVoid) [argPtr st, argCUInt $ fromIntegral value] + mkLookupIndex fn st sym = + fromIntegral <$> callFFI fn retCUInt [argPtr st, argPtr sym] + mkContainsSymbol fn st sym = do + result <- callFFI fn retCUChar [argPtr st, argPtr sym] + pure $ result == 1 + mkContainsIndex fn st value = do + result <- callFFI fn retCUChar [argPtr st, argCUInt $ fromIntegral value] + pure $ result == 1 + +testDir :: FilePath +testDir = "/tmp/eclair-symbol-table" + +notUsed :: a +notUsed = panic "Not used" + +intoIO :: Identity a -> IO a +intoIO = pure . runIdentity + +llFile, soFile :: FilePath -> FilePath +llFile dir = dir "symbol-table.ll" +soFile dir = dir "symbol-table.so" From 0722d33d4cc75be8a960fe05bd3735767e42a5f4 Mon Sep 17 00:00:00 2001 From: Krishna Padmasola Date: Sat, 14 Oct 2023 15:02:44 +0530 Subject: [PATCH 6/9] Build with GHC 9.6.2 --- cabal.project | 4 ++-- lib/Eclair/EIR/Lower.hs | 1 + lib/Eclair/EIR/Lower/API.hs | 1 + lib/Eclair/EIR/Lower/Externals.hs | 1 + lib/Eclair/LLVM/BTree.hs | 1 + lib/Eclair/LLVM/Config.hs | 1 + lib/Eclair/LLVM/Template.hs | 1 + lib/Eclair/Parser.hs | 4 ++-- 8 files changed, 10 insertions(+), 4 deletions(-) diff --git a/cabal.project b/cabal.project index 570fbb3..2196a71 100644 --- a/cabal.project +++ b/cabal.project @@ -3,12 +3,12 @@ packages: . source-repository-package type: git location: https://github.com/luc-tielen/llvm-codegen.git - tag: 497c7c0ffad5f3e4b6f4e74550a477e75b0beb23 + tag: 83b04cb576208ea74ddd62016e4fa03f0df138ac source-repository-package type: git location: https://github.com/luc-tielen/souffle-haskell.git - tag: bcd7e3c058c9036d8495cf114520663917b7ac81 + tag: e441c84f1d64890e31c92fbb278c074ae8bcaff5 source-repository-package type: git diff --git a/lib/Eclair/EIR/Lower.hs b/lib/Eclair/EIR/Lower.hs index 4a6db63..8aa1111 100644 --- a/lib/Eclair/EIR/Lower.hs +++ b/lib/Eclair/EIR/Lower.hs @@ -7,6 +7,7 @@ module Eclair.EIR.Lower import Prelude hiding (void) import qualified Prelude import qualified Relude (swap) +import Control.Monad.Fix import Control.Monad.Morph hiding (embed) import qualified Data.ByteString as BS import qualified Data.Map as M diff --git a/lib/Eclair/EIR/Lower/API.hs b/lib/Eclair/EIR/Lower/API.hs index 3929131..c15d359 100644 --- a/lib/Eclair/EIR/Lower/API.hs +++ b/lib/Eclair/EIR/Lower/API.hs @@ -8,6 +8,7 @@ module Eclair.EIR.Lower.API ) where import Prelude hiding (void) +import Control.Monad.Fix import Control.Monad.Morph import Data.Traversable (for) import Data.Maybe (fromJust) diff --git a/lib/Eclair/EIR/Lower/Externals.hs b/lib/Eclair/EIR/Lower/Externals.hs index 88c6415..e57d3b1 100644 --- a/lib/Eclair/EIR/Lower/Externals.hs +++ b/lib/Eclair/EIR/Lower/Externals.hs @@ -5,6 +5,7 @@ module Eclair.EIR.Lower.Externals ) where import Prelude hiding (void) +import Control.Monad.Fix import Eclair.EIR.Lower.Codegen import Eclair.LLVM.Codegen as LLVM import Eclair.Common.Config diff --git a/lib/Eclair/LLVM/BTree.hs b/lib/Eclair/LLVM/BTree.hs index 22a9bb7..ffca88a 100644 --- a/lib/Eclair/LLVM/BTree.hs +++ b/lib/Eclair/LLVM/BTree.hs @@ -9,6 +9,7 @@ module Eclair.LLVM.BTree ) where import Prelude hiding (void, swap) +import Control.Monad.Fix import Control.Monad.Morph import Eclair.LLVM.Codegen import Eclair.LLVM.Table diff --git a/lib/Eclair/LLVM/Config.hs b/lib/Eclair/LLVM/Config.hs index 5880ddf..bb12651 100644 --- a/lib/Eclair/LLVM/Config.hs +++ b/lib/Eclair/LLVM/Config.hs @@ -7,6 +7,7 @@ module Eclair.LLVM.Config import qualified LLVM.C.API as LibLLVM import LLVM.Codegen +import Control.Monad.Fix import Control.Monad.Morph import Foreign.ForeignPtr import Foreign.Ptr diff --git a/lib/Eclair/LLVM/Template.hs b/lib/Eclair/LLVM/Template.hs index 24c5086..a6ea999 100644 --- a/lib/Eclair/LLVM/Template.hs +++ b/lib/Eclair/LLVM/Template.hs @@ -14,6 +14,7 @@ module Eclair.LLVM.Template ) where +import Control.Monad.Fix import Control.Monad.Morph import LLVM.Codegen hiding (function, typedef) import qualified LLVM.Codegen as CG diff --git a/lib/Eclair/Parser.hs b/lib/Eclair/Parser.hs index ddf76f8..6b6296a 100644 --- a/lib/Eclair/Parser.hs +++ b/lib/Eclair/Parser.hs @@ -352,9 +352,9 @@ betweenParens = -- In case of error, keeps parsing up to and including 'endChar' withRecovery :: Char -> Parser a -> Parser (Maybe a) withRecovery endChar p = - P.withRecovery handleError $ map Just p + P.withRecovery handleErr $ map Just p where - handleError err = do + handleErr err = do P.registerParseError err _ <- P.takeWhileP Nothing (/= endChar) _ <- P.char endChar From 847a744a6da1aed0ccf079fde68cbf156af7f85a Mon Sep 17 00:00:00 2001 From: Luc Tielen Date: Sat, 14 Oct 2023 21:10:40 +0200 Subject: [PATCH 7/9] Cleanup MonadFix imports --- lib/Eclair/EIR/Lower.hs | 1 - lib/Eclair/EIR/Lower/API.hs | 1 - lib/Eclair/EIR/Lower/Externals.hs | 1 - lib/Eclair/LLVM/BTree.hs | 1 - lib/Eclair/LLVM/Config.hs | 1 - lib/Eclair/LLVM/Template.hs | 1 - lib/Prelude.hs | 2 ++ 7 files changed, 2 insertions(+), 6 deletions(-) diff --git a/lib/Eclair/EIR/Lower.hs b/lib/Eclair/EIR/Lower.hs index 8aa1111..4a6db63 100644 --- a/lib/Eclair/EIR/Lower.hs +++ b/lib/Eclair/EIR/Lower.hs @@ -7,7 +7,6 @@ module Eclair.EIR.Lower import Prelude hiding (void) import qualified Prelude import qualified Relude (swap) -import Control.Monad.Fix import Control.Monad.Morph hiding (embed) import qualified Data.ByteString as BS import qualified Data.Map as M diff --git a/lib/Eclair/EIR/Lower/API.hs b/lib/Eclair/EIR/Lower/API.hs index c15d359..3929131 100644 --- a/lib/Eclair/EIR/Lower/API.hs +++ b/lib/Eclair/EIR/Lower/API.hs @@ -8,7 +8,6 @@ module Eclair.EIR.Lower.API ) where import Prelude hiding (void) -import Control.Monad.Fix import Control.Monad.Morph import Data.Traversable (for) import Data.Maybe (fromJust) diff --git a/lib/Eclair/EIR/Lower/Externals.hs b/lib/Eclair/EIR/Lower/Externals.hs index e57d3b1..88c6415 100644 --- a/lib/Eclair/EIR/Lower/Externals.hs +++ b/lib/Eclair/EIR/Lower/Externals.hs @@ -5,7 +5,6 @@ module Eclair.EIR.Lower.Externals ) where import Prelude hiding (void) -import Control.Monad.Fix import Eclair.EIR.Lower.Codegen import Eclair.LLVM.Codegen as LLVM import Eclair.Common.Config diff --git a/lib/Eclair/LLVM/BTree.hs b/lib/Eclair/LLVM/BTree.hs index ffca88a..22a9bb7 100644 --- a/lib/Eclair/LLVM/BTree.hs +++ b/lib/Eclair/LLVM/BTree.hs @@ -9,7 +9,6 @@ module Eclair.LLVM.BTree ) where import Prelude hiding (void, swap) -import Control.Monad.Fix import Control.Monad.Morph import Eclair.LLVM.Codegen import Eclair.LLVM.Table diff --git a/lib/Eclair/LLVM/Config.hs b/lib/Eclair/LLVM/Config.hs index bb12651..5880ddf 100644 --- a/lib/Eclair/LLVM/Config.hs +++ b/lib/Eclair/LLVM/Config.hs @@ -7,7 +7,6 @@ module Eclair.LLVM.Config import qualified LLVM.C.API as LibLLVM import LLVM.Codegen -import Control.Monad.Fix import Control.Monad.Morph import Foreign.ForeignPtr import Foreign.Ptr diff --git a/lib/Eclair/LLVM/Template.hs b/lib/Eclair/LLVM/Template.hs index a6ea999..24c5086 100644 --- a/lib/Eclair/LLVM/Template.hs +++ b/lib/Eclair/LLVM/Template.hs @@ -14,7 +14,6 @@ module Eclair.LLVM.Template ) where -import Control.Monad.Fix import Control.Monad.Morph import LLVM.Codegen hiding (function, typedef) import qualified LLVM.Codegen as CG diff --git a/lib/Prelude.hs b/lib/Prelude.hs index 9868213..d924875 100644 --- a/lib/Prelude.hs +++ b/lib/Prelude.hs @@ -4,6 +4,7 @@ module Prelude , module Control.Monad.Writer.Strict , module Control.Monad.RWS.Strict , module Control.Monad.Except + , module Control.Monad.Fix , module Control.Category , module Control.Comonad , module Data.Functor.Foldable @@ -30,6 +31,7 @@ import Control.Concurrent.MVar (modifyMVar_) import Control.Monad.Writer.Strict hiding (pass) import Control.Monad.RWS.Strict hiding (pass) import Control.Monad.Except +import Control.Monad.Fix import Data.Functor.Foldable hiding (fold, unfold, refold, hoist) import Data.Functor.Foldable.TH import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) From 3f1916fda276a0af378b01ff0852f0622e234335 Mon Sep 17 00:00:00 2001 From: Krishna Padmasola Date: Sun, 5 Nov 2023 14:46:20 +0530 Subject: [PATCH 8/9] bump up upload-artifact github action version to v3 --- .github/workflows/build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 8643c6c..afa6e27 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -22,7 +22,7 @@ jobs: - name: Upload logs if: ${{ always() }} - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v3 with: name: eclair-lang-${{matrix.os}}.log path: eclair-lang-${{matrix.os}}.log From ad04a9a85f1880725c0b593e215b75f2d2682ad6 Mon Sep 17 00:00:00 2001 From: Krishna Padmasola Date: Sun, 5 Nov 2023 15:01:55 +0530 Subject: [PATCH 9/9] Update Dockerfile for ghc-9.6.3 --- Dockerfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Dockerfile b/Dockerfile index c0c5d9b..f715161 100644 --- a/Dockerfile +++ b/Dockerfile @@ -29,9 +29,9 @@ RUN echo 'tzdata tzdata/Areas select Europe' | debconf-set-selections \ && ln -s wasm-ld-$LLVM_VERSION wasm-ld \ && cd - \ && pip install lit==14.0.6 \ - # install ghcup, ghc-9.4.4 and cabal-3.8.1.0 + # install ghcup, ghc-9.6.3 and cabal-3.10.1.0 && curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | \ - BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_GHC_VERSION=9.4.4 BOOTSTRAP_HASKELL_CABAL_VERSION=3.8.1.0 \ + BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3 BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.1.0 \ BOOTSTRAP_HASKELL_INSTALL_STACK=1 BOOTSTRAP_HASKELL_INSTALL_HLS=1 BOOTSTRAP_HASKELL_ADJUST_BASHRC=P sh \ && source /root/.ghcup/env \ && cabal install cabal-fmt \