{-# 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']]