Complete the shift over to language-rust.

2019-10-22 22:06:34 -07:00
parent 2400b10fbc
commit 620048bce6
8 changed files with 103 additions and 196 deletions
--- 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};

--- 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};
--- 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;
--- 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)]
--- 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
--- 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
+upcase = map toUpper
--- 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

--- 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)))