@@ -16,11 +16,6 @@ module Booster.LLVM.Internal (
1616 KoreStringPatternAPI (.. ),
1717 KoreSymbolAPI (.. ),
1818 KoreSortAPI (.. ),
19- SomePtr (.. ),
20- somePtr ,
21- LlvmCall (.. ),
22- LlvmCallArg (.. ),
23- LlvmVar (.. ),
2419 LlvmError (.. ),
2520) where
2621
@@ -32,8 +27,7 @@ import Control.Monad.Extra (whenM)
3227import Control.Monad.IO.Class (MonadIO (.. ))
3328import Control.Monad.Trans.Reader (ReaderT (runReaderT ))
3429import Control.Monad.Trans.Reader qualified as Reader
35- import Data.Binary (Binary , get , put )
36- import Data.ByteString.Char8 (ByteString , pack )
30+ import Data.ByteString.Char8 (ByteString )
3731import Data.ByteString.Char8 qualified as BS
3832import Data.Data (Data )
3933import Data.HashMap.Strict (HashMap )
@@ -45,16 +39,12 @@ import Foreign.C qualified as C
4539import Foreign.C.Types (CSize (.. ))
4640import Foreign.Marshal (alloca )
4741import Foreign.Storable (peek )
48- import GHC.Generics (Generic )
4942import System.IO (hPutStrLn , stderr )
5043import System.Posix.DynamicLinker qualified as Linker
5144
5245import Booster.LLVM.TH (dynamicBindings )
5346import Booster.Pattern.Base
54- import Booster.Pattern.Binary
5547import Booster.Pattern.Util (sortOfTerm )
56- import Booster.Trace
57- import Booster.Trace qualified as Trace
5848
5949data KorePattern
6050data KoreSort
@@ -120,39 +110,6 @@ data API = API
120110newtype LLVM a = LLVM (ReaderT API IO a )
121111 deriving newtype (Functor , Applicative , Monad , MonadIO , MonadThrow , MonadCatch , MonadMask )
122112
123- newtype SomePtr = SomePtr ByteString
124- deriving newtype (Binary )
125-
126- somePtr :: Show a => a -> SomePtr
127- somePtr ptr = SomePtr $ pack $ show ptr
128-
129- data LlvmCallArg
130- = LlvmCallArgByteString ByteString
131- | LlvmCallArgWord Word
132- | LlvmCallArgPtr SomePtr
133- deriving (Generic )
134-
135- instance Binary LlvmCallArg
136-
137- data LlvmCall = LlvmCall
138- { ret :: Maybe (ByteString , SomePtr )
139- , call :: ByteString
140- , args :: [LlvmCallArg ]
141- }
142- instance CustomUserEvent LlvmCall where
143- encodeUserEvent (LlvmCall {ret, call, args}) = put ret <> put call <> put args
144- decodeUserEvent = LlvmCall <$> get <*> get <*> get
145- userEventTag _ = " LLVM "
146- eventType _ = LlvmCalls
147-
148- data LlvmVar = LlvmVar SomePtr Term
149-
150- instance CustomUserEvent LlvmVar where
151- encodeUserEvent (LlvmVar ptr trm) = put ptr <> encodeMagicHeaderAndVersion (Version 1 1 0 ) <> encodeTerm trm
152- decodeUserEvent = LlvmVar <$> get <*> decodeTerm' Nothing
153- userEventTag _ = " LLVMV"
154- eventType _ = LlvmCalls
155-
156113{- | Uses dlopen to load a .so/.dylib C library at runtime. For doucmentation of flags such as `RTL_LAZY`, consult e.g.
157114 https://man7.org/linux/man-pages/man3/dlopen.3.html
158115-}
@@ -173,30 +130,21 @@ mkAPI dlib = flip runReaderT dlib $ do
173130 BS. useAsCString name $
174131 newCompositePattern
175132 >=> newForeignPtr freePattern
176- >=> traceCall " kore_composite_pattern_new" [LlvmCallArgByteString name] " kore_pattern*"
177133
178134 addArgumentCompositePattern <- koreCompositePatternAddArgument
179135 let addArgumentPattern parent child =
180136 {-# SCC "LLVM.pattern.addArgument" #-}
181137 do
182138 withForeignPtr parent $ \ rawParent -> withForeignPtr child $ addArgumentCompositePattern rawParent
183139 finalizeForeignPtr child
184- Trace. traceIO $
185- LlvmCall
186- { call = " kore_composite_pattern_add_argument"
187- , args = [LlvmCallArgPtr $ somePtr parent, LlvmCallArgPtr $ somePtr child]
188- , ret = Nothing
189- }
190140 pure parent
191141
192142 newString <- koreStringPatternNewWithLen
193143 let string = KoreStringPatternAPI $ \ name ->
194144 {-# SCC "LLVM.pattern.string" #-}
195145 BS. useAsCStringLen name $ \ (rawStr, len) ->
196146 newString rawStr (fromIntegral len)
197- >>= ( newForeignPtr freePattern
198- >=> traceCall " kore_string_pattern_new_with_len" [LlvmCallArgByteString name] " kore_pattern*"
199- )
147+ >>= newForeignPtr freePattern
200148
201149 newToken <- korePatternNewTokenWithLen
202150 let token = KoreTokenPatternAPI $ \ name sort ->
@@ -205,18 +153,13 @@ mkAPI dlib = flip runReaderT dlib $ do
205153 withForeignPtr sort $
206154 newToken rawName (fromIntegral len)
207155 >=> newForeignPtr freePattern
208- >=> traceCall
209- " kore_pattern_new_token_with_len"
210- [LlvmCallArgByteString name, LlvmCallArgWord . fromIntegral $ len, LlvmCallArgPtr $ somePtr sort]
211- " kore_pattern*"
212156
213157 compositePatternFromSymbol <- koreCompositePatternFromSymbol
214158 let fromSymbol sym =
215159 {-# SCC "LLVM.pattern.fromSymbol" #-}
216160 withForeignPtr sym $
217161 compositePatternFromSymbol
218162 >=> newForeignPtr freePattern
219- >=> traceCall " kore_composite_pattern_from_symbol" [LlvmCallArgPtr $ somePtr sym] " kore_pattern*"
220163
221164 dumpPattern' <- korePatternDump
222165 let dumpPattern ptr =
@@ -246,19 +189,12 @@ mkAPI dlib = flip runReaderT dlib $ do
246189 BS. useAsCString name $
247190 newSymbol'
248191 >=> newForeignPtr freeSymbol
249- >=> traceCall " kore_symbol_new" [LlvmCallArgByteString name] " kore_symbol*"
250192
251193 addArgumentSymbol' <- koreSymbolAddFormalArgument
252194 let addArgumentSymbol sym sort =
253195 {-# SCC "LLVM.symbol.addArgument" #-}
254196 do
255197 withForeignPtr sym $ \ rawSym -> withForeignPtr sort $ addArgumentSymbol' rawSym
256- Trace. traceIO $
257- LlvmCall
258- { call = " kore_symbol_add_formal_argument"
259- , args = [LlvmCallArgPtr $ somePtr sym, LlvmCallArgPtr $ somePtr sort]
260- , ret = Nothing
261- }
262198 pure sym
263199
264200 symbolCache <- liftIO $ newIORef mempty
@@ -273,19 +209,12 @@ mkAPI dlib = flip runReaderT dlib $ do
273209 BS. useAsCString name $
274210 newSort'
275211 >=> newForeignPtr freeSort
276- >=> traceCall " kore_composite_sort_new" [LlvmCallArgByteString name] " kore_sort*"
277212
278213 addArgumentSort' <- koreCompositeSortAddArgument
279214 let addArgumentSort parent child =
280215 {-# SCC "LLVM.sort.addArgument" #-}
281216 do
282217 withForeignPtr parent $ \ rawParent -> withForeignPtr child $ addArgumentSort' rawParent
283- Trace. traceIO $
284- LlvmCall
285- { call = " kore_composite_sort_add_formal_argument"
286- , args = [LlvmCallArgPtr $ somePtr parent, LlvmCallArgPtr $ somePtr child]
287- , ret = Nothing
288- }
289218 pure parent
290219
291220 dumpSort' <- koreSortDump
@@ -314,12 +243,6 @@ mkAPI dlib = flip runReaderT dlib $ do
314243 let simplifyBool p =
315244 {-# SCC "LLVM.simplifyBool" #-}
316245 do
317- Trace. traceIO $
318- LlvmCall
319- { call = " kore_simplify_bool"
320- , args = [LlvmCallArgPtr $ somePtr p]
321- , ret = Nothing
322- }
323246 err <- newError
324247 withForeignPtr err $ \ errPtr ->
325248 withForeignPtr p $ \ pPtr -> do
@@ -341,17 +264,6 @@ mkAPI dlib = flip runReaderT dlib $ do
341264 alloca $ \ lenPtr ->
342265 alloca $ \ strPtr -> do
343266 simplify' errPtr patPtr sortPtr strPtr lenPtr
344- Trace. traceIO $
345- LlvmCall
346- { call = " kore_simplify"
347- , args =
348- [ LlvmCallArgPtr $ somePtr patPtr
349- , LlvmCallArgPtr $ somePtr sortPtr
350- , LlvmCallArgPtr $ somePtr strPtr
351- , LlvmCallArgPtr $ somePtr lenPtr
352- ]
353- , ret = Nothing
354- }
355267 success <- isSuccess errPtr
356268 if success
357269 then do
@@ -372,10 +284,6 @@ mkAPI dlib = flip runReaderT dlib $ do
372284
373285 mutex <- liftIO $ newMVar ()
374286 pure API {patt, symbol, sort, simplifyBool, simplify, collect, mutex}
375- where
376- traceCall call args retTy retPtr = do
377- Trace. traceIO $ LlvmCall {ret = Just (retTy, somePtr retPtr), call, args}
378- pure retPtr
379287
380288ask :: LLVM API
381289ask = LLVM Reader. ask
0 commit comments