From 620048bce6e696671e9c1aa5b9eecbdabd5aeca5 Mon Sep 17 00:00:00 2001 From: Adam Wick Date: Tue, 22 Oct 2019 22:06:34 -0700 Subject: [PATCH] Complete the shift over to language-rust. --- generation/src/Base.hs | 24 +++++----- generation/src/BinaryOps.hs | 20 ++++----- generation/src/Compare.hs | 14 +++--- generation/src/Conversions.hs | 31 +++++++------ generation/src/CryptoNum.hs | 62 ++++++++------------------ generation/src/File.hs | 61 +++++++++++++++++-------- generation/src/Gen.hs | 83 ----------------------------------- generation/src/Main.hs | 4 +- 8 files changed, 103 insertions(+), 196 deletions(-) diff --git a/generation/src/Base.hs b/generation/src/Base.hs index ac70443..1009133 100644 --- a/generation/src/Base.hs +++ b/generation/src/Base.hs @@ -4,13 +4,10 @@ module Base( ) where -import Control.Monad(forM_) import File -import Gen import Language.Rust.Data.Ident import Language.Rust.Data.Position import Language.Rust.Quote -import Language.Rust.Pretty import Language.Rust.Syntax base :: File @@ -20,18 +17,17 @@ base = File { generator = declareBaseStructure } -declareBaseStructure :: Word -> Gen () +declareBaseStructure :: Word -> SourceFile Span declareBaseStructure bitsize = - do let name = "U" ++ show bitsize - entries = bitsize `div` 64 - top = entries - 1 - sname = mkIdent name - entriese = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty - strname = Lit [] (Str name Cooked Unsuffixed mempty) mempty - debugExp = buildDebugExp 0 entries [expr| f.debug_tuple($$(strname)) |] - lowerPrints = buildPrints entries "x" - upperPrints = buildPrints entries "X" - out $ show $ pretty' $ [sourceFile| + let tname = "U" ++ show bitsize + entries = bitsize `div` 64 + sname = mkIdent tname + entriese = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty + strname = Lit [] (Str tname Cooked Unsuffixed mempty) mempty + debugExp = buildDebugExp 0 entries [expr| f.debug_tuple($$(strname)) |] + lowerPrints = buildPrints entries "x" + upperPrints = buildPrints entries "X" + in [sourceFile| use core::fmt; use quickcheck::{Arbitrary,Gen}; diff --git a/generation/src/BinaryOps.hs b/generation/src/BinaryOps.hs index 05da4e9..7181bd2 100644 --- a/generation/src/BinaryOps.hs +++ b/generation/src/BinaryOps.hs @@ -5,11 +5,9 @@ module BinaryOps( where import File -import Gen import Language.Rust.Data.Ident import Language.Rust.Data.Position import Language.Rust.Quote -import Language.Rust.Pretty import Language.Rust.Syntax binaryOps :: File @@ -19,16 +17,16 @@ binaryOps = File { generator = declareBinaryOperators } -declareBinaryOperators :: Word -> Gen () +declareBinaryOperators :: Word -> SourceFile Span declareBinaryOperators bitsize = - do let struct_name = mkIdent ("U" ++ show bitsize) - entries = bitsize `div` 64 - andOps = generateBinOps "BitAnd" struct_name "bitand" BitAndOp entries - orOps = generateBinOps "BitOr" struct_name "bitor" BitOrOp entries - xorOps = generateBinOps "BitXor" struct_name "bitxor" BitXorOp entries - baseNegationStmts = negationStatements "self" entries - refNegationStmts = negationStatements "output" entries - out $ show $ pretty' $ [sourceFile| + let struct_name = mkIdent ("U" ++ show bitsize) + entries = bitsize `div` 64 + andOps = generateBinOps "BitAnd" struct_name "bitand" BitAndOp entries + orOps = generateBinOps "BitOr" struct_name "bitor" BitOrOp entries + xorOps = generateBinOps "BitXor" struct_name "bitxor" BitXorOp entries + baseNegationStmts = negationStatements "self" entries + refNegationStmts = negationStatements "output" entries + in [sourceFile| use core::ops::{BitAnd,BitAndAssign}; use core::ops::{BitOr,BitOrAssign}; use core::ops::{BitXor,BitXorAssign}; diff --git a/generation/src/Compare.hs b/generation/src/Compare.hs index 24169db..18e0d54 100644 --- a/generation/src/Compare.hs +++ b/generation/src/Compare.hs @@ -3,11 +3,9 @@ module Compare(comparisons) where import File -import Gen import Language.Rust.Data.Ident import Language.Rust.Data.Position import Language.Rust.Quote -import Language.Rust.Pretty import Language.Rust.Syntax comparisons :: File @@ -17,13 +15,13 @@ comparisons = File { generator = declareComparators } -declareComparators :: Word -> Gen () +declareComparators :: Word -> SourceFile Span declareComparators bitsize = - do let sname = mkIdent ("U" ++ show bitsize) - entries = bitsize `div` 64 - eqStatements = buildEqStatements 0 entries - compareExp = buildCompareExp 0 entries - out $ show $ pretty' $ [sourceFile| + let sname = mkIdent ("U" ++ show bitsize) + entries = bitsize `div` 64 + eqStatements = buildEqStatements 0 entries + compareExp = buildCompareExp 0 entries + in [sourceFile| use core::cmp::{Eq,Ordering,PartialEq}; #[cfg(test)] use quickcheck::quickcheck; diff --git a/generation/src/Conversions.hs b/generation/src/Conversions.hs index d9afbcc..556663a 100644 --- a/generation/src/Conversions.hs +++ b/generation/src/Conversions.hs @@ -5,11 +5,10 @@ module Conversions( where import File -import Gen(Gen,toLit,out) +import Gen(toLit) import Language.Rust.Data.Ident import Language.Rust.Data.Position import Language.Rust.Quote -import Language.Rust.Pretty import Language.Rust.Syntax conversions :: File @@ -19,21 +18,21 @@ conversions = File { generator = declareConversions } -declareConversions :: Word -> Gen () +declareConversions :: Word -> SourceFile Span declareConversions bitsize = - do let sname = mkIdent ("U" ++ show bitsize) - entries = bitsize `div` 64 - u8_prims = buildPrimitives sname (mkIdent "u8") entries - u16_prims = buildPrimitives sname (mkIdent "u16") entries - u32_prims = buildPrimitives sname (mkIdent "u32") entries - u64_prims = buildPrimitives sname (mkIdent "u64") entries - u128_prims = generateU128Primitives sname entries - i8_prims = generateSignedPrims sname (mkIdent "u8") (mkIdent "i8") - i16_prims = generateSignedPrims sname (mkIdent "u16") (mkIdent "i16") - i32_prims = generateSignedPrims sname (mkIdent "u32") (mkIdent "i32") - i64_prims = generateSignedPrims sname (mkIdent "u64") (mkIdent "i64") - i128_prims = generateI128Primitives sname - out $ show $ pretty' $ [sourceFile| + let sname = mkIdent ("U" ++ show bitsize) + entries = bitsize `div` 64 + u8_prims = buildPrimitives sname (mkIdent "u8") entries + u16_prims = buildPrimitives sname (mkIdent "u16") entries + u32_prims = buildPrimitives sname (mkIdent "u32") entries + u64_prims = buildPrimitives sname (mkIdent "u64") entries + u128_prims = generateU128Primitives sname entries + i8_prims = generateSignedPrims sname (mkIdent "u8") (mkIdent "i8") + i16_prims = generateSignedPrims sname (mkIdent "u16") (mkIdent "i16") + i32_prims = generateSignedPrims sname (mkIdent "u32") (mkIdent "i32") + i64_prims = generateSignedPrims sname (mkIdent "u64") (mkIdent "i64") + i128_prims = generateI128Primitives sname + in [sourceFile| use core::convert::{From,TryFrom}; use core::num::TryFromIntError; #[cfg(test)] diff --git a/generation/src/CryptoNum.hs b/generation/src/CryptoNum.hs index 3f77073..0512188 100644 --- a/generation/src/CryptoNum.hs +++ b/generation/src/CryptoNum.hs @@ -4,13 +4,11 @@ module CryptoNum( ) where -import Control.Monad(forM_) import File import Gen import Language.Rust.Data.Ident import Language.Rust.Data.Position import Language.Rust.Quote -import Language.Rust.Pretty import Language.Rust.Syntax cryptoNum :: File @@ -20,24 +18,22 @@ cryptoNum = File { generator = declareCryptoNumInstance } -declareCryptoNumInstance :: Word -> Gen () +declareCryptoNumInstance :: Word -> SourceFile Span declareCryptoNumInstance bitsize = - do let sname = mkIdent ("U" ++ show bitsize) - entries = bitsize `div` 64 - entlit = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty - top = entries - 1 - zeroTests = generateZeroTests 0 entries - bitlength = toLit bitsize - bytelen = bitsize `div` 8 - bytelenlit = toLit bytelen - bytebuffer = Delimited mempty Brace (Stream [ - Tree (Token mempty (LiteralTok (IntegerTok "0") Nothing)), - Tree (Token mempty Semicolon), - Tree (Token mempty (LiteralTok (IntegerTok (show bytelen)) Nothing)) - ]) - entrieslit = toLit entries - packerLines = generatePackerLines 0 (bitsize `div` 8) - out $ show $ pretty' $ [sourceFile| + let sname = mkIdent ("U" ++ show bitsize) + entries = bitsize `div` 64 + entlit = Lit [] (Int Dec (fromIntegral entries) Unsuffixed mempty) mempty + zeroTests = generateZeroTests 0 entries + bitlength = toLit bitsize + bytelen = bitsize `div` 8 + bytelenlit = toLit bytelen + bytebuffer = Delimited mempty Brace (Stream [ + Tree (Token mempty (LiteralTok (IntegerTok "0") Nothing)), + Tree (Token mempty Semicolon), + Tree (Token mempty (LiteralTok (IntegerTok (show bytelen)) Nothing)) + ]) + entrieslit = toLit entries + in [sourceFile| use core::cmp::min; use crate::CryptoNum; #[cfg(test)] @@ -142,32 +138,10 @@ declareCryptoNumInstance bitsize = } |] -byteShiftInfo :: Word -> (Word, Word) -byteShiftInfo idx = - (idx `div` 8, (idx `mod` 8) * 8) - -pad :: Int -> Char -> String -> String -pad len c str - | length str >= len = str - | otherwise = pad len c (c:str) - generateZeroTests :: Word -> Word -> [Stmt Span] -generateZeroTests i max - | i == max = [] +generateZeroTests i entries + | i == entries = [] | otherwise = let ilit = toLit i in [stmt| result = self.values[$$(ilit)] == 0; |] : - generateZeroTests (i + 1) max - -generatePackerLines :: Word -> Word -> [Stmt Span] -generatePackerLines i max - | i == max = [] - | otherwise = - let ilit = toLit i - nextLit = toLit (i + 1) - validx = toLit (i `div` 8) - shiftx = toLit ((i `mod` 8) * 8) - writeLine = [stmt| bytes[$$(ilit)] = (self.values[$$(validx)] >> $$(shiftx)) as u8; |] - ifLine = [stmt| if bytes.len() == $$(nextLit) { return; } |] - in writeLine : ifLine : generatePackerLines (i + 1) max - + generateZeroTests (i + 1) entries diff --git a/generation/src/File.hs b/generation/src/File.hs index 1702e38..619a657 100644 --- a/generation/src/File.hs +++ b/generation/src/File.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE QuasiQuotes #-} module File( File(..), Task(..), @@ -6,21 +7,24 @@ module File( ) where -import Control.Monad(forM_) import Data.Char(toUpper) +import Data.Map.Strict(Map) import qualified Data.Map.Strict as Map -import Gen(Gen,blank,out) import System.FilePath(takeBaseName,takeDirectory,takeFileName,()) +import Language.Rust.Data.Ident(Ident,mkIdent) +import Language.Rust.Data.Position(Span) +import Language.Rust.Quote(item,sourceFile) +import Language.Rust.Syntax(Item,SourceFile) data File = File { predicate :: Word -> [Word] -> Bool, outputName :: FilePath, - generator :: Word -> Gen () + generator :: Word -> SourceFile Span } data Task = Task { outputFile :: FilePath, - fileGenerator :: Gen () + fileData :: SourceFile Span } makeTask :: FilePath -> @@ -31,7 +35,7 @@ makeTask base size allSizes file | predicate file size allSizes = Just Task { outputFile = base ("u" ++ show size) outputName file <> ".rs", - fileGenerator = generator file size + fileData = generator file size } | otherwise = Nothing @@ -39,28 +43,49 @@ makeTask base size allSizes file addModuleTasks :: FilePath -> [Task] -> [Task] addModuleTasks base baseTasks = unsignedTask : (baseTasks ++ moduleTasks) where + moduleMap :: Map String [String] moduleMap = foldr addModuleInfo Map.empty baseTasks + + addModuleInfo :: Task -> Map String [String] -> Map String [String] addModuleInfo task = Map.insertWith (++) (takeDirectory (outputFile task)) [takeBaseName (outputFile task)] + + moduleTasks :: [Task] moduleTasks = Map.foldrWithKey generateModuleTask [] moduleMap + + generateModuleTask :: String -> [String] -> [Task] -> [Task] generateModuleTask directory mods acc = acc ++ [Task { outputFile = directory "mod.rs", - fileGenerator = - do forM_ mods $ \ modle -> out ("mod " ++ modle ++ ";") - blank - out ("pub use base::" ++ upcase (takeFileName directory) ++ ";") + fileData = + let modules = map (buildModule . mkIdent) mods + user = mkIdent (upcase (takeFileName directory)) + in [sourceFile| + $@{modules} + pub use base::$$user; + |] }] + + unsignedTask :: Task unsignedTask = Task { outputFile = base "unsigned" "mod.rs", - fileGenerator = - do forM_ (Map.keys moduleMap) $ \ key -> - out ("mod " ++ takeFileName key ++ ";") - blank - forM_ (Map.keys moduleMap) $ \ key -> - out ("pub use " ++ takeFileName key ++ "::" ++ - upcase (takeFileName key) ++ ";") + fileData = + let modules = map (buildModule . mkIdent . takeFileName) (Map.keys moduleMap) + uses = map (buildUse . takeFileName) (Map.keys moduleMap) + in [sourceFile| + $@{modules} + $@{uses} + |] } - + +buildModule :: Ident -> Item Span +buildModule x = [item| mod $$x; |] + +buildUse :: String -> Item Span +buildUse x = + let base = mkIdent x + up = mkIdent (upcase x) + in [item| pub use $$base::$$up; |] + upcase :: String -> String -upcase = map toUpper \ No newline at end of file +upcase = map toUpper diff --git a/generation/src/Gen.hs b/generation/src/Gen.hs index f7d2ee6..99dcc1a 100644 --- a/generation/src/Gen.hs +++ b/generation/src/Gen.hs @@ -1,95 +1,12 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Gen( - Gen(Gen), - runGen, - gensym, - indent, - blank, - out, - wrapIndent, - implFor, - implFor', - implFor'', toLit ) where -import Control.Monad.RWS.Strict(RWS,evalRWS) -import Control.Monad.State.Class(MonadState,get,put) -import Control.Monad.Writer.Class(MonadWriter,tell) -import Data.List(replicate) -import Data.Word(Word) import Language.Rust.Data.Position import Language.Rust.Syntax -newtype Gen a = Gen { unGen :: RWS () String GenState a} - deriving (Applicative, Functor, Monad, MonadState GenState, MonadWriter String) - -tabAmount :: Word -tabAmount = 4 - -data GenState = GenState { - indentAmount :: Word, - gensymIndex :: Word -} - -initGenState :: GenState -initGenState = GenState { indentAmount = 0, gensymIndex = 0 } - -runGen :: FilePath -> Gen a -> IO a -runGen path action = - do let (res, contents) = evalRWS (unGen action) () initGenState - writeFile path contents - return res - -gensym :: String -> Gen String -gensym prefix = - do gs <- get - let gs' = gs{ gensymIndex = gensymIndex gs + 1 } - put gs' - return (prefix ++ show (gensymIndex gs)) - -indent :: Gen a -> Gen a -indent action = - do gs <- get - put gs{ indentAmount = indentAmount gs + tabAmount } - res <- action - put gs - return res - -blank :: Gen () -blank = tell "\n" - -out :: String -> Gen () -out val = - do gs <- get - tell (replicate (fromIntegral (indentAmount gs)) ' ') - tell val - tell "\n" - -wrapIndent :: String -> Gen a -> Gen a -wrapIndent val middle = - do gs <- get - tell (replicate (fromIntegral (indentAmount gs)) ' ') - tell val - tell " {\n" - res <- indent middle - tell (replicate (fromIntegral (indentAmount gs)) ' ') - tell "}\n" - return res - -implFor :: String -> String -> Gen a -> Gen a -implFor trait name middle = - wrapIndent ("impl " ++ trait ++ " for " ++ name) middle - -implFor' :: String -> String -> Gen a -> Gen a -implFor' trait name middle = - wrapIndent ("impl<'a> " ++ trait ++ " for " ++ name) middle - -implFor'' :: String -> String -> Gen a -> Gen a -implFor'' trait name middle = - wrapIndent ("impl<'a,'b> " ++ trait ++ " for " ++ name) middle - toLit :: Word -> Expr Span toLit i = Lit [] (Int Dec (fromIntegral i) Unsuffixed mempty) mempty diff --git a/generation/src/Main.hs b/generation/src/Main.hs index 6bc50b3..f8fd695 100644 --- a/generation/src/Main.hs +++ b/generation/src/Main.hs @@ -9,7 +9,7 @@ import CryptoNum(cryptoNum) import Control.Monad(forM_,unless) import Data.Maybe(mapMaybe) import File(File,Task(..),addModuleTasks,makeTask) -import Gen(runGen) +import Language.Rust.Pretty(prettyAnnotated') import System.Directory(createDirectoryIfMissing) import System.Environment(getArgs) import System.Exit(die) @@ -56,4 +56,4 @@ main = forM_ (zip [(1::Word)..] tasks) $ \ (i, task) -> do putStrLn ("[" ++ show i ++ "/" ++ show total ++ "] " ++ outputFile task) createDirectoryIfMissing True (takeDirectory (outputFile task)) - runGen (outputFile task) (fileGenerator task) + writeFile (outputFile task) (show (prettyAnnotated' (fileData task)))