{-# LANGUAGE BangPatterns #-}
module Dragen
( dragenArbitrary
, Optimization.uniform
, Optimization.weighted
, Optimization.only
, Optimization.without
, Optimization.types
, Optimization.constructors
, Prediction.confirm
) where
import Language.Haskell.TH
import Reification
import TypeInfo
import Prediction
import Optimization
import Arbitrary
dragenArbitrary :: Name -> Size -> CostFunction -> DecsQ
dragenArbitrary target size cost = do
let putStrLnQ = runIO . putStrLn
putStrLnQ $ "\nReifiying: " ++ show target
targetEnv <- reifyNameEnv target
putStrLnQ $ "\nTypes involved with " ++ show target ++ ":"
putStrLnQ $ show (map tsig targetEnv)
let !freqMap = initMap targetEnv
!prediction = predict targetEnv size freqMap
!initCost = cost targetEnv size freqMap
putStrLnQ $ "\nInitial frequencies map:"
putStrLnQ $ showMap freqMap
putStrLnQ $ "\nPredicted distribution for the initial frequencies map:"
putStrLnQ $ showMap prediction
putStrLnQ $ "\nOptimizing the frequencies map:"
let !optimized = optimizeLS targetEnv size cost freqMap
!prediction' = predict targetEnv size optimized
!finalCost = cost targetEnv size optimized
putStrLnQ $ "\n\nOptimized frequencies map:"
putStrLnQ $ showMap optimized
putStrLnQ $ "\nPredicted distribution for the optimized frequencies map:"
putStrLnQ $ showMap prediction'
putStrLnQ $ "\nInitial cost: " ++ show initCost
putStrLnQ $ "Final cost: " ++ show finalCost
putStrLnQ $ "Optimization ratio: " ++ show (initCost / finalCost)
putStrLnQ $ "\nDeriving optimized generator..."
devArbitrary targetEnv optimized target