Start experimenting with full generation of all of the numeric types.
Previously, we used a little bit of generation to drive a lot of Rust macros. This works, but it's a little confusing to read and write. In addition, we used a lot of implementations with variable timings based on their input, which isn't great for crypto. This is the start of an attempt to just generate all of the relevant Rust code directly, and to use timing-channel resistant implementations for most of the routines.
This commit is contained in:
73
generation/src/Gen.hs
Normal file
73
generation/src/Gen.hs
Normal file
@@ -0,0 +1,73 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module Gen(
|
||||
Gen(Gen),
|
||||
runGen,
|
||||
gensym,
|
||||
indent,
|
||||
blank,
|
||||
out,
|
||||
wrapIndent,
|
||||
)
|
||||
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)
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user