Generate multiple modules, instead of one.
This commit is contained in:
@@ -1,5 +1,4 @@
|
|||||||
import Data.Bits hiding (bit)
|
import Data.Bits hiding (bit)
|
||||||
import Debug.Trace
|
|
||||||
import GHC.Integer.GMP.Internals
|
import GHC.Integer.GMP.Internals
|
||||||
import qualified Karatsuba
|
import qualified Karatsuba
|
||||||
import Numeric
|
import Numeric
|
||||||
|
|||||||
@@ -182,17 +182,24 @@ declareUnsafeMulOperators bitsize _ =
|
|||||||
-- -----------------------------------------------------------------------------
|
-- -----------------------------------------------------------------------------
|
||||||
|
|
||||||
generateMultiplier :: Bool -> Word -> String -> String -> [Stmt Span]
|
generateMultiplier :: Bool -> Word -> String -> String -> [Stmt Span]
|
||||||
generateMultiplier fullmul size inName outName =
|
generateMultiplier fullmul size inName outName = readIns ++ operations ++ writeOuts
|
||||||
let readIns = map (load "self" "x") [0..size-1] ++
|
|
||||||
map (load inName "y") [0..size-1]
|
|
||||||
instructions = releaseUnnecessary outVars (generateInstructions size)
|
|
||||||
outDigits | fullmul = 2 * size
|
|
||||||
| otherwise = size
|
|
||||||
outVars = map (("res" ++) . show) [0..outDigits-1]
|
|
||||||
operations = map translateInstruction instructions
|
|
||||||
writeOuts = map (store "res") [0..outDigits-1]
|
|
||||||
in readIns ++ operations ++ writeOuts
|
|
||||||
where
|
where
|
||||||
|
outDigits | fullmul = size * 2
|
||||||
|
| otherwise = size
|
||||||
|
--
|
||||||
|
outVars = map (("res" ++) . show) [0..outDigits-1]
|
||||||
|
instructionData = generateInstructions size
|
||||||
|
instrOutputs = take (fromIntegral outDigits) (idOutput instructionData)
|
||||||
|
instructions = releaseUnnecessary instrOutputs (idInstructions instructionData)
|
||||||
|
--
|
||||||
|
readIns = map (load "self" "x") [0..size-1] ++ map (load inName "y") [0..size-1]
|
||||||
|
writeOuts = map (store "res") [0..outDigits-1]
|
||||||
|
--
|
||||||
|
env = zip (idInput1 instructionData) (map (\ i -> "x" ++ show i) [0..size-1]) ++
|
||||||
|
zip (idInput2 instructionData) (map (\ i -> "y" ++ show i) [0..size-1]) ++
|
||||||
|
zip (idOutput instructionData) outVars
|
||||||
|
operations = map (translateInstruction env) instructions
|
||||||
|
--
|
||||||
load rhs vname i =
|
load rhs vname i =
|
||||||
let liti = toLit i
|
let liti = toLit i
|
||||||
vec = mkIdent rhs
|
vec = mkIdent rhs
|
||||||
@@ -204,92 +211,101 @@ generateMultiplier fullmul size inName outName =
|
|||||||
var = mkIdent (vname ++ show i)
|
var = mkIdent (vname ++ show i)
|
||||||
in [stmt| $$vec.value[$$(liti)] = $$var; |]
|
in [stmt| $$vec.value[$$(liti)] = $$var; |]
|
||||||
|
|
||||||
translateInstruction :: Instruction -> Stmt Span
|
translateInstruction :: [(Variable, String)] -> Instruction -> Stmt Span
|
||||||
translateInstruction instr = undefined
|
translateInstruction env instr =
|
||||||
-- case instr of
|
case instr of
|
||||||
-- Add outname args ->
|
Add outname args ->
|
||||||
-- let outid = mkIdent outname
|
let outid = mkIdentO outname
|
||||||
-- args' = map (\x -> [expr| $$x |]) (map mkIdent args)
|
args' = map (\x -> [expr| $$x |]) (map mkIdentI args)
|
||||||
-- adds = foldl (\ x y -> [expr| $$(x) + $$(y) |])
|
adds = foldl (\ x y -> [expr| $$(x) + $$(y) |])
|
||||||
-- (head args')
|
(head args')
|
||||||
-- (tail args')
|
(tail args')
|
||||||
-- in [stmt| let $$outid: u128 = $$(adds); |]
|
in [stmt| let $$outid: u128 = $$(adds); |]
|
||||||
-- CastDown outname arg ->
|
CastDown outname arg ->
|
||||||
-- let outid = mkIdent outname
|
let outid = mkIdentO outname
|
||||||
-- inid = mkIdent arg
|
inid = mkIdentI arg
|
||||||
-- in [stmt| let $$outid: u64 = $$inid as u64; |]
|
in [stmt| let $$outid: u64 = $$inid as u64; |]
|
||||||
-- CastUp outname arg ->
|
CastUp outname arg ->
|
||||||
-- let outid = mkIdent outname
|
let outid = mkIdentO outname
|
||||||
-- inid = mkIdent arg
|
inid = mkIdentI arg
|
||||||
-- in [stmt| let $$outid: u128 = $$inid as u128; |]
|
in [stmt| let $$outid: u128 = $$inid as u128; |]
|
||||||
-- Complement outname arg ->
|
Complement outname arg ->
|
||||||
-- let outid = mkIdent outname
|
let outid = mkIdentO outname
|
||||||
-- inid = mkIdent arg
|
inid = mkIdentI arg
|
||||||
-- in [stmt| let $$outid: u64 = !$$inid; |]
|
in [stmt| let $$outid: u64 = !$$inid; |]
|
||||||
-- Declare64 outname arg ->
|
Declare64 outname _ | Just inName <- lookup outname env ->
|
||||||
-- let outid = mkIdent outname
|
let outid = mkIdent (variableName outname)
|
||||||
-- val = toLit (fromIntegral arg)
|
inid = mkIdent inName
|
||||||
-- in [stmt| let $$outid: u64 = $$(val); |]
|
in [stmt| let $$outid: u64 = $$inid; |]
|
||||||
-- Declare128 outname arg ->
|
Declare64 outname arg ->
|
||||||
-- let outid = mkIdent outname
|
let outid = mkIdentO outname
|
||||||
-- val = toLit (fromIntegral arg)
|
val = toLit (fromIntegral arg)
|
||||||
-- in [stmt| let $$outid: u128 = $$(val); |]
|
in [stmt| let $$outid: u64 = $$(val); |]
|
||||||
-- Mask outname arg mask ->
|
Declare128 outname arg ->
|
||||||
-- let outid = mkIdent outname
|
let outid = mkIdentO outname
|
||||||
-- inid = mkIdent arg
|
val = toLit (fromIntegral arg)
|
||||||
-- val = toLit (fromIntegral mask)
|
in [stmt| let $$outid: u128 = $$(val); |]
|
||||||
-- in [stmt| let $$outid: u128 = $$inid & $$(val); |]
|
Mask outname arg mask ->
|
||||||
-- Multiply outname args ->
|
let outid = mkIdentO outname
|
||||||
-- let outid = mkIdent outname
|
inid = mkIdentI arg
|
||||||
-- args' = map (\x -> [expr| $$x |]) (map mkIdent args)
|
val = toLit (fromIntegral mask)
|
||||||
-- muls = foldl (\ x y -> [expr| $$(x) * $$(y) |])
|
in [stmt| let $$outid: u128 = $$inid & $$(val); |]
|
||||||
-- (head args')
|
Multiply outname args ->
|
||||||
-- (tail args')
|
let outid = mkIdentO outname
|
||||||
-- in [stmt| let $$outid: u128 = $$(muls); |]
|
args' = map (\x -> [expr| $$x |]) (map mkIdentI args)
|
||||||
-- ShiftR outname arg amt ->
|
muls = foldl (\ x y -> [expr| $$(x) * $$(y) |])
|
||||||
-- let outid = mkIdent outname
|
(head args')
|
||||||
-- inid = mkIdent arg
|
(tail args')
|
||||||
-- val = toLit (fromIntegral amt)
|
in [stmt| let $$outid: u128 = $$(muls); |]
|
||||||
-- in [stmt| let $$outid: u128 = $$inid >> $$(val); |]
|
ShiftR outname arg amt ->
|
||||||
|
let outid = mkIdentO outname
|
||||||
|
inid = mkIdentI arg
|
||||||
|
val = toLit (fromIntegral amt)
|
||||||
|
in [stmt| let $$outid: u128 = $$inid >> $$(val); |]
|
||||||
|
where
|
||||||
|
mkIdentO :: Variable -> Ident
|
||||||
|
mkIdentO v | Just x <- lookup v env = mkIdent x
|
||||||
|
| otherwise = mkIdent (variableName v)
|
||||||
|
mkIdentI :: Variable -> Ident
|
||||||
|
mkIdentI = mkIdent . variableName
|
||||||
|
|
||||||
releaseUnnecessary :: [String] -> [Instruction] -> [Instruction]
|
releaseUnnecessary :: [Variable] -> [Instruction] -> [Instruction]
|
||||||
releaseUnnecessary outkeys instrs = undefined
|
releaseUnnecessary outkeys instrs = go (Set.fromList outkeys) [] rInstrs
|
||||||
-- go (Set.fromList outkeys) [] rInstrs
|
where
|
||||||
-- where
|
rInstrs = reverse instrs
|
||||||
-- rInstrs = reverse instrs
|
|
||||||
-- --
|
|
||||||
-- go _ acc [] = acc
|
|
||||||
-- go required acc (cur:rest)
|
|
||||||
-- | outVar cur `Set.member` required =
|
|
||||||
-- go (foldl' (flip Set.insert) required (inVars cur)) (cur:acc) rest
|
|
||||||
-- | otherwise =
|
|
||||||
-- go required acc rest
|
|
||||||
--
|
--
|
||||||
--outVar :: Instruction -> String
|
go _ acc [] = acc
|
||||||
--outVar instr =
|
go required acc (cur:rest)
|
||||||
-- case instr of
|
| outVar cur `Set.member` required =
|
||||||
-- Add outname _ -> outname
|
go (foldl' (flip Set.insert) required (inVars cur)) (cur:acc) rest
|
||||||
-- CastDown outname _ -> outname
|
| otherwise =
|
||||||
-- CastUp outname _ -> outname
|
go required acc rest
|
||||||
-- Complement outname _ -> outname
|
|
||||||
-- Declare64 outname _ -> outname
|
outVar :: Instruction -> Variable
|
||||||
-- Declare128 outname _ -> outname
|
outVar instr =
|
||||||
-- Mask outname _ _ -> outname
|
case instr of
|
||||||
-- Multiply outname _ -> outname
|
Add outname _ -> outname
|
||||||
-- ShiftR outname _ _ -> outname
|
CastDown outname _ -> outname
|
||||||
--
|
CastUp outname _ -> outname
|
||||||
--inVars :: Instruction -> [String]
|
Complement outname _ -> outname
|
||||||
--inVars instr =
|
Declare64 outname _ -> outname
|
||||||
-- case instr of
|
Declare128 outname _ -> outname
|
||||||
-- Add _ args -> args
|
Mask outname _ _ -> outname
|
||||||
-- CastDown _ arg -> [arg]
|
Multiply outname _ -> outname
|
||||||
-- CastUp _ arg -> [arg]
|
ShiftR outname _ _ -> outname
|
||||||
-- Complement _ arg -> [arg]
|
|
||||||
-- Declare64 _ _ -> []
|
inVars :: Instruction -> [Variable]
|
||||||
-- Declare128 _ _ -> []
|
inVars instr =
|
||||||
-- Mask _ arg _ -> [arg]
|
case instr of
|
||||||
-- Multiply _ args -> args
|
Add _ args -> args
|
||||||
-- ShiftR _ arg _ -> [arg]
|
CastDown _ arg -> [arg]
|
||||||
|
CastUp _ arg -> [arg]
|
||||||
|
Complement _ arg -> [arg]
|
||||||
|
Declare64 _ _ -> []
|
||||||
|
Declare128 _ _ -> []
|
||||||
|
Mask _ arg _ -> [arg]
|
||||||
|
Multiply _ args -> args
|
||||||
|
ShiftR _ arg _ -> [arg]
|
||||||
|
|
||||||
-- -----------------------------------------------------------------------------
|
-- -----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|||||||
@@ -10,12 +10,12 @@ module RustModule(
|
|||||||
|
|
||||||
import Control.Monad(forM_, unless)
|
import Control.Monad(forM_, unless)
|
||||||
import Data.Char(toUpper)
|
import Data.Char(toUpper)
|
||||||
import Data.List(isPrefixOf, partition)
|
import Data.List(partition)
|
||||||
import Data.Map.Strict(Map)
|
import Data.Map.Strict(Map)
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Data.Maybe(mapMaybe)
|
import Data.Maybe(mapMaybe)
|
||||||
import Language.Rust.Data.Ident(mkIdent)
|
import Language.Rust.Data.Ident(mkIdent)
|
||||||
import Language.Rust.Data.Position(Span, spanOf)
|
import Language.Rust.Data.Position(Position(NoPosition), Span(Span))
|
||||||
import Language.Rust.Pretty(writeSourceFile)
|
import Language.Rust.Pretty(writeSourceFile)
|
||||||
import Language.Rust.Quote(item, sourceFile)
|
import Language.Rust.Quote(item, sourceFile)
|
||||||
import Language.Rust.Syntax(Item(..), SourceFile(..), Visibility(..))
|
import Language.Rust.Syntax(Item(..), SourceFile(..), Visibility(..))
|
||||||
@@ -64,21 +64,18 @@ generateTasks :: RandomGen g => g -> [RustModule] -> [Word] -> [Task]
|
|||||||
generateTasks rng modules sizes = allTheFiles
|
generateTasks rng modules sizes = allTheFiles
|
||||||
where
|
where
|
||||||
allTheFiles = implementationsAndTests ++
|
allTheFiles = implementationsAndTests ++
|
||||||
[lump "src/signed", lump "src/unsigned"]
|
[lump "i" "src/signed.rs", lump "u" "src/unsigned.rs"]
|
||||||
implementationsAndTests = concatMap generateModules sizes
|
implementationsAndTests = concatMap generateModules sizes
|
||||||
--
|
--
|
||||||
lump prefix =
|
lump prefix file =
|
||||||
let allFiles = map outputFile implementationsAndTests
|
let moduleNames = map (\s -> prefix ++ show s) sizes
|
||||||
files = filter (prefix `isPrefixOf`) allFiles
|
|
||||||
moduleFiles = map (drop (length prefix + 1)) files
|
|
||||||
moduleNames = map (takeWhile (/= '.')) moduleFiles
|
|
||||||
moduleIdents = map mkIdent moduleNames
|
moduleIdents = map mkIdent moduleNames
|
||||||
types = map (mkIdent . map toUpper) moduleNames
|
types = map (mkIdent . map toUpper) moduleNames
|
||||||
mods = map (\ name -> [item| mod $$name; |]) moduleIdents
|
mods = map (\ name -> [item| mod $$name; |]) moduleIdents
|
||||||
uses = zipWith (\ mname tname -> [item| pub use $$mname::$$tname; |])
|
uses = zipWith (\ mname tname -> [item| pub use $$mname::$$tname; |])
|
||||||
moduleIdents types
|
moduleIdents types
|
||||||
file = [sourceFile| $@{mods} $@{uses} |]
|
source = [sourceFile| $@{mods} $@{uses} |]
|
||||||
in Task (prefix ++ ".rs") (\hndl -> writeSourceFile hndl file)
|
in Task file (\hndl -> writeSourceFile hndl source)
|
||||||
--
|
--
|
||||||
generateModules size =
|
generateModules size =
|
||||||
let modules' = filter (\m -> predicate m size sizes) modules
|
let modules' = filter (\m -> predicate m size sizes) modules
|
||||||
@@ -92,18 +89,21 @@ generateTasks rng modules sizes = allTheFiles
|
|||||||
| otherwise =
|
| otherwise =
|
||||||
let name = mkIdent (startsWith ++ show size)
|
let name = mkIdent (startsWith ++ show size)
|
||||||
baseInclude = [item| pub use self::base::$$name; |]
|
baseInclude = [item| pub use self::base::$$name; |]
|
||||||
moduleSources = map (generateSubmodule size sizes) modules'
|
isSigned = startsWith == "I"
|
||||||
moduleFile | startsWith == "I" = "src/signed/i" ++ show size ++ ".rs"
|
moduleSources = map (generateSubmodule isSigned size sizes) modules'
|
||||||
|
moduleFile | isSigned = "src/signed/i" ++ show size ++ ".rs"
|
||||||
| otherwise = "src/unsigned/u" ++ show size ++ ".rs"
|
| otherwise = "src/unsigned/u" ++ show size ++ ".rs"
|
||||||
allSource = SourceFile Nothing [] (baseInclude : moduleSources)
|
allSource = SourceFile Nothing [] (baseInclude : map fst moduleSources)
|
||||||
in [Task moduleFile (\ hndl -> writeSourceFile hndl allSource)]
|
in [Task moduleFile (\ hndl -> writeSourceFile hndl allSource)] ++ map snd moduleSources
|
||||||
|
|
||||||
generateSubmodule :: Word -> [Word] -> RustModule -> Item Span
|
generateSubmodule :: Bool -> Word -> [Word] -> RustModule -> (Item Span, Task)
|
||||||
generateSubmodule size allSizes m =
|
generateSubmodule isSigned size allSizes m =
|
||||||
let SourceFile _ attrs internals = generator m size allSizes
|
let modBody = generator m size allSizes
|
||||||
modName = mkIdent (outputName m)
|
modName = mkIdent (outputName m)
|
||||||
modSpan = spanOf internals
|
modDecl = Mod [] CrateV modName Nothing (Span NoPosition NoPosition)
|
||||||
in Mod attrs CrateV modName (Just internals) modSpan
|
modFile | isSigned = "src/signed/i" ++ show size ++ "/" ++ outputName m ++ ".rs"
|
||||||
|
| otherwise = "src/unsigned/u" ++ show size ++ "/" ++ outputName m ++ ".rs"
|
||||||
|
in (modDecl, Task modFile (\ hndl -> writeSourceFile hndl modBody))
|
||||||
|
|
||||||
generateTests :: RandomGen g =>
|
generateTests :: RandomGen g =>
|
||||||
Word -> g ->
|
Word -> g ->
|
||||||
|
|||||||
Reference in New Issue
Block a user