{-# LANGUAGE TupleSections #-} -- Generates CmmSwitch.hs import qualified Data.Set as S import Data.Word import Data.List output :: Integer -> Integer output n = n`div`2 + 42 def :: Integer def = 1337 type Spec = (String, Bool, [Integer]) primtyp True = "Int#" primtyp False = "Word#" con True = "I#" con False = "W#" hash True = "#" hash False = "##" primLit s v = show v ++ hash s genSwitch :: Spec -> String genSwitch (name, signed, values) = unlines \$ [ "{-# NOINLINE " ++ name ++ " #-}" ] ++ [ name ++ " :: " ++ primtyp signed ++ " -> " ++ primtyp signed ] ++ [ name ++ " " ++ primLit signed v ++ " = " ++ primLit signed (output v) | v <- values] ++ [ name ++ " _ = " ++ primLit signed def ] genCheck :: Spec -> String genCheck (name, signed, values) = unlines \$ [ checkName name ++ " :: IO ()" , checkName name ++ " = forM_ [" ++ pairs ++ "] \$ \\(" ++ con signed ++ " i,o) -> do" , " let r = " ++ con signed ++ " (" ++ name ++ " i)" , " unless (r == o) \$ putStrLn \$ \"ERR: " ++ name ++ " (\" ++ show (" ++ con signed ++ " i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"" ] where f x | x `S.member` range = output x | otherwise = def range = S.fromList values checkValues = S.toList \$ S.fromList \$ [ v' | v <- values, v' <- [v-1,v,v+1], if signed then v' >= minS && v' <= maxS else v' >= minU && v' <= maxU ] pairs = intercalate ", " ["(" ++ show v ++ "," ++ show (f v) ++ ")" | v <- checkValues ] checkName :: String -> String checkName f = f ++ "_check" genMain :: [Spec] -> String genMain specs = unlines \$ "main = do" : [ " " ++ checkName n | (n,_,_) <- specs ] genMod :: [Spec] -> String genMod specs = unlines \$ "-- This file is generated from CmmSwitchGen!" : "{-# LANGUAGE MagicHash, NegativeLiterals #-}" : "import Control.Monad (unless, forM_)" : "import GHC.Exts" : map genSwitch specs ++ map genCheck specs ++ [ genMain specs ] main = putStrLn \$ genMod \$ zipWith (\n (s,v) -> (n,s,v)) names \$ signedChecks ++ unsignedChecks signedChecks :: [(Bool, [Integer])] signedChecks = map (True,) [ [1..10] , [0..10] , [1..3] , [1..4] , [1..5] , [-1..10] , [-10..10] , [-20.. -10]++[0..10] , [-20.. -10]++[1..10] , [minS,0,maxS] , [maxS-10 .. maxS] , [minS..minS+10]++[maxS-10 .. maxS] ] minU, maxU, minS, maxS :: Integer minU = 0 maxU = fromIntegral (maxBound :: Word) minS = fromIntegral (minBound :: Int) maxS = fromIntegral (maxBound :: Int) unsignedChecks :: [(Bool, [Integer])] unsignedChecks = map (False,) [ [0..10] , [1..10] , [0] , [0..1] , [0..2] , [0..3] , [0..4] , [1] , [1..2] , [1..3] , [1..4] , [1..5] , [minU,maxU] , [maxU-10 .. maxU] , [minU..minU+10]++[maxU-10 .. maxU] ] names :: [String] names = [ c1:c2:[] | c1 <- ['a'..'z'], c2 <- ['a'..'z']]