Initial commit!
This commit is contained in:
243
generate.hs
Normal file
243
generate.hs
Normal file
@@ -0,0 +1,243 @@
|
||||
import Control.Monad(foldM_,forM_,when)
|
||||
import Data.Bits(shiftL,shiftR)
|
||||
import Data.List(sort)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Numeric(showHex)
|
||||
import Prelude hiding (log)
|
||||
import System.Directory(createDirectoryIfMissing)
|
||||
import System.Environment(getArgs)
|
||||
import System.FilePath((</>))
|
||||
import System.IO(Handle,IOMode(WriteMode),hPutStrLn,withFile,hFlush,hPutStr,stderr)
|
||||
import System.Random(StdGen,newStdGen,random,split)
|
||||
|
||||
data Level = Base | DivMul | Barrett
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
bitSizes :: [Int]
|
||||
bitSizes = [192,256,384,512,576,1024,2048,3072,4096,7680,8192,15360]
|
||||
|
||||
numberOfTests :: Int
|
||||
numberOfTests = 1000
|
||||
|
||||
baseMap :: Map.Map Int Level
|
||||
baseMap = foldr (\ s m -> Map.insert s Barrett m) Map.empty bitSizes
|
||||
|
||||
smartInsert :: Int -> Level -> Map.Map Int Level -> Map.Map Int Level
|
||||
smartInsert size level map = Map.insertWith max size level map
|
||||
|
||||
generateNext :: Int -> Level -> Map.Map Int Level -> Map.Map Int Level
|
||||
generateNext size Base acc = acc
|
||||
generateNext size DivMul acc = smartInsert (size + 64) Base $
|
||||
smartInsert (size * 2) Base $
|
||||
acc
|
||||
generateNext size Barrett acc = smartInsert (size + 64) Base $
|
||||
smartInsert (size * 2) Base $
|
||||
smartInsert ( size + 64) DivMul $
|
||||
smartInsert ((size * 2) + 64) DivMul $
|
||||
acc
|
||||
|
||||
step :: Map.Map Int Level -> Map.Map Int Level
|
||||
step m = Map.foldrWithKey generateNext m m
|
||||
|
||||
fixpoint :: Map.Map Int Level -> Map.Map Int Level
|
||||
fixpoint m | m == m' = m
|
||||
| otherwise = fixpoint m'
|
||||
where m' = step m
|
||||
|
||||
finalMap :: Map.Map Int Level
|
||||
finalMap = fixpoint baseMap
|
||||
|
||||
conversions :: [Int] -> [(Int,Int)]
|
||||
conversions [] = []
|
||||
conversions (x:rest) = (map (\ y -> (x,y)) rest) ++ conversions rest
|
||||
|
||||
generateTestBlock :: Handle -> String -> IO ()
|
||||
generateTestBlock hndl name =
|
||||
do hPutStrLn hndl (" mod " ++ name ++ " {")
|
||||
hPutStrLn hndl (" use super::super::*;\n")
|
||||
hPutStrLn hndl (" use testing::run_test;\n")
|
||||
forM_ (sort (Map.toList finalMap)) $ \ (size, kind) ->
|
||||
when (kind >= Base) $
|
||||
hPutStrLn hndl (" generate_" ++ name ++
|
||||
"_tests!(U" ++ show size ++ ");")
|
||||
hPutStrLn hndl " }"
|
||||
|
||||
generateInvocs :: IO ()
|
||||
generateInvocs =
|
||||
withFile "src/unsigned/invoc.rs" WriteMode $ \ hndl ->
|
||||
do forM_ (sort (Map.toList finalMap)) $ \ item ->
|
||||
case item of
|
||||
(size, Base) ->
|
||||
hPutStrLn hndl ("generate_number!(U" ++ show size ++ ", " ++
|
||||
show (size `div` 64) ++ ");")
|
||||
(size, DivMul) ->
|
||||
hPutStrLn hndl ("generate_number!(U" ++ show size ++ ", " ++
|
||||
show (size `div` 64) ++ ", U" ++
|
||||
show (size + 64) ++ ", U" ++
|
||||
show (size * 2) ++ ");")
|
||||
(size, Barrett) ->
|
||||
hPutStrLn hndl ("generate_number!(U" ++ show size ++ ", " ++
|
||||
show (size `div` 64) ++ ", U" ++
|
||||
show (size + 64) ++ ", U" ++
|
||||
show (size * 2) ++ ", U" ++
|
||||
show ((size * 2) + 64) ++ ", BarrettU" ++
|
||||
show size ++ ");")
|
||||
hPutStrLn hndl ""
|
||||
forM_ (conversions (Map.keys finalMap)) $ \ (a,b) ->
|
||||
hPutStrLn hndl ("conversion_impls!(U" ++ show a ++ ", " ++
|
||||
"U" ++ show b ++ ");")
|
||||
hPutStrLn hndl "\n#[cfg(test)]"
|
||||
hPutStrLn hndl "mod tests {"
|
||||
generateTestBlock hndl "base"
|
||||
hPutStrLn hndl "}"
|
||||
|
||||
log :: String -> IO ()
|
||||
log str = hPutStr stderr str >> hFlush stderr
|
||||
|
||||
generateTests :: Level -> String -> a -> (Int -> a -> (Map.Map String String, a)) -> IO ()
|
||||
generateTests minLevel directory init runner =
|
||||
forM_ (sort (Map.toList finalMap)) $ \ (size, myLevel) ->
|
||||
when (myLevel >= minLevel) $
|
||||
do createDirectoryIfMissing True ("testdata" </> directory)
|
||||
log $ "Generating " ++ show size ++ "-bit " ++ directory ++ " tests "
|
||||
let dest = "testdata" </> directory </> ("U" ++ show size ++ ".tests")
|
||||
withFile dest WriteMode $ \ hndl ->
|
||||
foldM_ (writer hndl size runner) init [0..numberOfTests]
|
||||
log "done.\n"
|
||||
where
|
||||
writer :: Handle -> Int -> (Int -> a -> (Map.Map String String, a)) -> a -> Int -> IO a
|
||||
writer hndl size runner input _ =
|
||||
do let (output, acc) = runner size input
|
||||
forM_ (Map.toList output) $ \ (key, val) ->
|
||||
do hPutStrLn hndl (key ++ ": " ++ val)
|
||||
log "."
|
||||
return acc
|
||||
|
||||
type Database = (Map.Map String [Integer], StdGen)
|
||||
|
||||
emptyDatabase :: StdGen -> (Database, StdGen)
|
||||
emptyDatabase g0 =
|
||||
let (g, g') = split g0
|
||||
in ((Map.empty, g), g')
|
||||
|
||||
generateNum :: Database -> String -> Int -> (Integer, Database)
|
||||
generateNum (db, rng0) varname size =
|
||||
let (x, rng1) = random rng0
|
||||
x' = modulate x size
|
||||
before = Map.findWithDefault [] varname db
|
||||
in if length (filter (== x') before) < 10
|
||||
then (x', (Map.insert varname (x':before) db, rng1))
|
||||
else generateNum (db, rng1) varname size
|
||||
|
||||
modulate :: Integer -> Int -> Integer
|
||||
modulate x size = x `mod` (2 ^ size)
|
||||
|
||||
showX :: (Integral a, Show a) => a -> String
|
||||
showX x = showHex x ""
|
||||
|
||||
showB :: Bool -> String
|
||||
showB False = "0"
|
||||
showB True = "1"
|
||||
|
||||
base :: Integer
|
||||
base = 2 ^ (64 :: Integer)
|
||||
|
||||
barrett :: Integer -> Integer
|
||||
barrett m = (base ^ (2 * k)) `div` m
|
||||
where
|
||||
k = computeK m
|
||||
|
||||
computeK :: Integer -> Int
|
||||
computeK v = go 0 1
|
||||
where
|
||||
go k acc | v <= acc = k
|
||||
| otherwise = go (k + 1) (acc * base)
|
||||
|
||||
generateAllTheTests :: IO ()
|
||||
generateAllTheTests =
|
||||
do gen0 <- newStdGen
|
||||
let (db1, gen1) = emptyDatabase gen0
|
||||
generateTests DivMul "add" db1 $ \ size memory0 ->
|
||||
let (a, memory1) = generateNum memory0 "a" size
|
||||
(b, memory2) = generateNum memory1 "b" size
|
||||
c = modulate (a + b) size
|
||||
in (Map.fromList [("a", showX a), ("b", showX b), ("c", showX c)], memory2)
|
||||
let (db2, gen2) = emptyDatabase gen1
|
||||
generateTests Barrett "barrett_gen" db2 $ \ size memory0 ->
|
||||
let (m, memory1) = generateNum memory0 "m" size
|
||||
k = computeK m
|
||||
u = barrett m
|
||||
in (Map.fromList [("m", showX m), ("k", showX k), ("u", showX u)], memory1)
|
||||
let (db3, gen3) = emptyDatabase gen1
|
||||
generateTests Barrett "barrett_reduce" db3 $ \ size memory0 ->
|
||||
let (m, memory1) = generateNum memory0 "m" size
|
||||
(x, memory2) = generateNum memory1 "x" (min size (2 * k * 64))
|
||||
k = computeK m
|
||||
u = barrett m
|
||||
r = x `mod` m
|
||||
res = Map.fromList [("m", showX m), ("x", showX x),
|
||||
("k", showX k), ("u", showX u),
|
||||
("r", showX r)]
|
||||
in (res, memory2)
|
||||
let (db4, gen4) = emptyDatabase gen2
|
||||
generateTests Base "base" db4 $ \ size memory0 ->
|
||||
let (x, memory1) = generateNum memory0 "x" size
|
||||
(m, memory2) = generateNum memory1 "m" size
|
||||
m' = m `mod` (fromIntegral size `div` 64)
|
||||
r = x `mod` (2 ^ (64 * m'))
|
||||
res = Map.fromList [("x", showX x), ("z", showB (x == 0)),
|
||||
("e", showB (even x)), ("o", showB (odd x)),
|
||||
("m", showX m'), ("r", showX r)]
|
||||
in (res, memory2)
|
||||
let (db5, gen5) = emptyDatabase gen3
|
||||
generateTests Base "cmp" db5 $ \ size memory0 ->
|
||||
let (a, memory1) = generateNum memory0 "a" size
|
||||
(b, memory2) = generateNum memory1 "b" size
|
||||
res = Map.fromList [("a", showX a), ("b", showX b),
|
||||
("g", showB (a > b)), ("l", showB (a < b)),
|
||||
("e", showB (a == b))]
|
||||
in (res, memory2)
|
||||
let (db6, gen6) = emptyDatabase gen4
|
||||
generateTests DivMul "div" db6 $ \ size memory0 ->
|
||||
let (a, memory1) = generateNum memory0 "a" size
|
||||
(b, memory2) = generateNum memory1 "b" size
|
||||
res = Map.fromList [("a", showX a), ("b", showX b), ("c", showX (a `div` b))]
|
||||
in (res, memory2)
|
||||
let (db7, gen7) = emptyDatabase gen5
|
||||
generateTests DivMul "mul" db7 $ \ size memory0 ->
|
||||
let (a, memory1) = generateNum memory0 "a" size
|
||||
(b, memory2) = generateNum memory1 "b" size
|
||||
c = a * b
|
||||
d = modulate c size
|
||||
res = Map.fromList [("a", showX a), ("b", showX b),
|
||||
("c", showX c), ("d", showX d)]
|
||||
in (res, memory2)
|
||||
let (db8, gen8) = emptyDatabase gen6
|
||||
generateTests Base "shiftl" db8 $ \ size memory0 ->
|
||||
let (a, memory1) = generateNum memory0 "a" size
|
||||
(l, memory2) = generateNum memory1 "l" size
|
||||
l' = l `mod` fromIntegral (computeK a * 64)
|
||||
r = modulate (a `shiftL` fromIntegral l') size
|
||||
res = Map.fromList [("a", showX a), ("l", showX l'), ("r", showX r)]
|
||||
in (res, memory2)
|
||||
let (db9, gen9) = emptyDatabase gen6
|
||||
generateTests Base "shiftr" db9 $ \ size memory0 ->
|
||||
let (a, memory1) = generateNum memory0 "a" size
|
||||
(l, memory2) = generateNum memory1 "l" size
|
||||
l' = l `mod` fromIntegral (computeK a * 64)
|
||||
r = modulate (a `shiftR` fromIntegral l') size
|
||||
res = Map.fromList [("a", showX a), ("l", showX l'), ("r", showX r)]
|
||||
in (res, memory2)
|
||||
let (dbA, genA) = emptyDatabase gen7
|
||||
generateTests Base "sub" dbA $ \ size memory0 ->
|
||||
let (a, memory1) = generateNum memory0 "a" size
|
||||
(b, memory2) = generateNum memory1 "b" size
|
||||
c = modulate (a - b) size
|
||||
in (Map.fromList [("a", showX a), ("b", showX b), ("c", showX c)], memory2)
|
||||
|
||||
main :: IO ()
|
||||
main =
|
||||
do args <- getArgs
|
||||
let args' = if null args then ["invocs", "test"] else args
|
||||
when ("invocs" `elem` args') generateInvocs
|
||||
when ("tests" `elem` args') generateAllTheTests
|
||||
Reference in New Issue
Block a user