ghc-debug-stub 0.1.0.0 → 0.2.0.0
raw patch · 4 files changed
+8/−253 lines, 4 filesdep −containersdep −deepseqdep −ghc-debug-stubdep ~basedep ~ghc-debug-conventionPVP ok
version bump matches the API change (PVP)
Dependencies removed: containers, deepseq, ghc-debug-stub, unordered-containers
Dependency ranges changed: base, ghc-debug-convention
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−2
- LargeThunk.hs +0/−172
- Test.hs +0/−52
- ghc-debug-stub.cabal +2/−27
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for ghc-debug-stub -## 0.1.0.0 -- YYYY-mm-dd+## 0.2.0.0 -- 2021-12-06 -* First version. Released on an unsuspecting world.+* Second version++## 0.1.0.0 -- 2021-06-14++* First version
− LargeThunk.hs
@@ -1,172 +0,0 @@--{-# Language BangPatterns #-}-{-# Language DeriveAnyClass #-}-{-# Language DerivingStrategies #-}-{-# Language DuplicateRecordFields #-}-{-# LANGUAGE DeriveGeneric #-}-{-# Language GeneralizedNewtypeDeriving #-}-{-# Language LambdaCase #-}-{-# Language ParallelListComp #-}--import System.Environment (getArgs)-import Data.List (foldl', maximumBy, permutations, sortBy)-import Data.Function-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as M-import Control.DeepSeq-import GHC.Generics (Generic)--import GHC.Debug.Stub--import Debug.Trace--data MovieDB = MovieDB- { users :: !(Map UserID User)- , movies :: !(Map MovieID Movie)- , ratings :: ![Rating]- }- deriving stock (Generic)- deriving anyclass (NFData)--newtype UserID = UserID Int- deriving newtype (Eq,Ord,Num,Enum)- deriving stock (Generic)- deriving anyclass (NFData)--data User = User- { name :: !String- , trust :: !Double -- ^ How trusted this user is. In range [0,1]. Higher is more trustworthy.- }- deriving stock (Generic)- deriving anyclass (NFData)--newtype MovieID = MovieID Int- deriving newtype (Eq,Ord,Num,Enum)- deriving stock (Generic, Show)- deriving anyclass (NFData)--type Movie = String--data Rating = Rating- { user :: !UserID -- ^ Who rated this movie.- , movie :: !MovieID -- ^ Movie being rated.- , rating :: !Double -- ^ Rating In range [1,10]. Higher is better.- }- deriving stock (Generic)- deriving anyclass (NFData)--main :: IO ()-main = withGhcDebug $ do- -- Parse DB size from arguments- [nUsersStr, nMoviesStr, nRatingsStr] <- getArgs- let- nUsers = read nUsersStr- nMovies = read nMoviesStr- nRatings = read nRatingsStr-- -- Create the DB- putStrLn $ "Creating the DB with size ("- ++ show nUsers ++ " users,"- ++ show nMovies ++ " movies,"- ++ show nRatings ++ " ratings)"- let !movieDB = let- users = M.fromList- $ zip- [0..]- [ User name trust- | name <- take nUsers- $ fmap unwords- $ cycle- $ permutations ["abcdefghijklmnopqrstuvwxyz"]- | trust <- cycle [0.0, 0.1 .. 1.0]- ]-- movies = M.fromList- $ zip- [0..]- (take nMovies- $ fmap unwords- $ cycle- $ permutations ["The", "Cat", "In", "The", "Hat", "House", "Mouse", "Story", "Legend"]- )-- ratings = take nRatings- $ cycle- $ zipWith3- Rating- (cycle (M.keys users))- (cycle (M.keys movies))- (cycle [1.0, 1.01 .. 9])-- in force $ MovieDB- { users = users- , movies = movies- , ratings = ratings- }-- do- let msg = "DB created."- traceEventIO msg- putStrLn msg- putStrLn "Hit ENTER to continue."- _ <- getLine--- -- A single user's favorite movie.- do- let- (userIDA, userA) = M.assocs (users movieDB) !! 0- favoriteMovieID- = snd- $ maximumBy (compare `on` fst)- [ (rating, movieID)- | Rating userIDB movieID rating <- ratings movieDB- , userIDA == userIDB- ]-- putStrLn $ "User '" ++ name userA ++ "''s favorite movie: " ++ (movies movieDB M.! favoriteMovieID)-- -- Top rated movies- -- each rating is weighted by the user's trust score.- do- let- weight_movies = foldl' go M.empty (ratings movieDB)-- go :: Map MovieID (Double, Double) -> Rating -> Map MovieID (Double, Double)- go weights (Rating userID movieID score) = M.alter- (\case- Nothing -> Just (userTrust * score, userTrust)- Just (weightedScore, weight) -> let- weightedScore' = weightedScore + (userTrust * score)- weight' = weight + userTrust- in Just (weightedScore', weight')- )- movieID- weights- where- userTrust = trust ((users movieDB) M.! userID)-- saveClosures [Box weight_movies]- putStrLn "Pausing"- getLine-- -- (Movie ID, rating) sorted by rating.- let movieRatings :: [(MovieID, Double)]- movieRatings- = sortBy (compare `on` snd)- $ fmap (\(movieID, (weightedRating, weight)) -> (movieID, weightedRating / weight))- $ filter (\(_, (_, weight)) -> weight /= 0)- $ M.assocs weight_movies-- putStrLn "Top 10 movies:"- putStrLn $ unlines $ fmap show $ take 10 $ reverse $ movieRatings-- traceEventIO "Top 10 movies done."- putStrLn "Hit ENTER to continue."- _ <- getLine-- touch movieDB--{-# NOINLINE touch #-}-touch :: a -> IO ()-touch a = return ()
− Test.hs
@@ -1,52 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}--module Main where--import GHC.Debug.Stub-import Control.Concurrent-import System.Mem.StableName-import Foreign.StablePtr-import System.Mem-import qualified Data.Sequence-import qualified Data.HashMap.Strict-import qualified Data.Map as M---import qualified Data.Map.Strict as M--loop :: IO ()-loop = go 0- where- go 5 = pause >> go 11- go x = print x >> threadDelay 1000000 >> go (x + 1)- go 100 = return ()--data A = A Int deriving Show--v :: Int-v = 5-{-# NOINLINE v #-}--type TestMap = M.Map String Int---main :: IO ()-main = withGhcDebug $ do--- print "Enter Name"--- name <- getLine--- print "Enter Name"--- name2 <- getLine--- let !m = M.insert name (length name) (M.insert name2 (length name2) M.empty)-- --let !y = Data.Sequence.fromList [1..5]- let !y = [1..1000000]- print (length y)- performGC--- saveClosures [Box y]- saveClosures [Box y]- print "start"- loop- print y----
ghc-debug-stub.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: ghc-debug-stub-version: 0.1.0.0+version: 0.2.0.0 synopsis: Functions for instrumenting your application so the heap can be analysed with ghc-debug-common. description: Functions for instrumenting your application so the heap can@@ -20,10 +20,6 @@ Default: False Manual: True -flag testexes- Description: Build test executables- Default: False- library exposed-modules: GHC.Debug.Stub hs-source-dirs: src@@ -31,7 +27,7 @@ , directory ^>= 1.3 , filepath ^>= 1.4 , ghc-prim ^>= 0.8- , ghc-debug-convention ^>= 0.1+ , ghc-debug-convention ^>= 0.2 default-language: Haskell2010 cxx-sources: cbits/stub.cpp, cbits/socket.cpp, cbits/trace.cpp cxx-options: -std=gnu++11 -O3 -g3 -DTHREADED_RTS@@ -40,24 +36,3 @@ if flag(trace) cpp-options: -DTRACE -executable debug-test- if flag(testexes)- buildable: True- else- buildable: False- main-is: Test.hs- ghc-options: -threaded -g3 -O0 -finfo-table-map -fdistinct-constructor-tables- build-depends: base,- ghc-debug-stub, containers, unordered-containers- default-language: Haskell2010--executable large-thunk- if flag(testexes)- buildable: True- else- buildable: False- main-is: LargeThunk.hs- ghc-options: -threaded -g3 -O2 -finfo-table-map -fdistinct-constructor-tables -rtsopts- build-depends: base,- ghc-debug-stub, containers, deepseq- default-language: Haskell2010