Commit 8f5620da by Zachary Snow

my eyes are open

parent 751b3ad3
...@@ -33,10 +33,10 @@ possibilities = ['0', '1'] ...@@ -33,10 +33,10 @@ possibilities = ['0', '1']
explodeBy :: [Char] -> String -> [String] explodeBy :: [Char] -> String -> [String]
explodeBy _ "" = [""] explodeBy _ "" = [""]
explodeBy wilds (x : xs) = explodeBy wilds (x : xs) =
if elem x wilds [(:)] <*> chars <*> prev
then concat $ map (\c -> map (c :) prev) possibilities where
else map (x :) prev chars = if elem x wilds then possibilities else [x]
where prev = explodeBy wilds xs prev = explodeBy wilds xs
expandExpr :: [Char] -> Expr -> [Expr] expandExpr :: [Char] -> Expr -> [Expr]
expandExpr wilds (Number s) = map Number $ explodeBy wilds s expandExpr wilds (Number s) = map Number $ explodeBy wilds s
......
...@@ -13,7 +13,6 @@ ...@@ -13,7 +13,6 @@
module Convert.Logic (convert) where module Convert.Logic (convert) where
import Data.Maybe (fromJust)
import qualified Data.Set as Set import qualified Data.Set as Set
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
...@@ -75,7 +74,4 @@ convertGenItem f item = convertGenItem' item ...@@ -75,7 +74,4 @@ convertGenItem f item = convertGenItem' item
convertGenItem' (GenCase e cases def) = GenCase e cases' def' convertGenItem' (GenCase e cases def) = GenCase e cases' def'
where where
cases' = zip (map fst cases) (map (convertGenItem' . snd) cases) cases' = zip (map fst cases) (map (convertGenItem' . snd) cases)
def' = if def == Nothing def' = fmap convertGenItem' def
then Nothing
else Just $ convertGenItem' $ fromJust def
...@@ -201,10 +201,7 @@ rewriteStmt dimMap orig = rs orig ...@@ -201,10 +201,7 @@ rewriteStmt dimMap orig = rs orig
rc (exprs, stmt) = (map re exprs, rs stmt) rc (exprs, stmt) = (map re exprs, rs stmt)
e' = re e e' = re e
cases' = map rc cases cases' = map rc cases
def' = def' = fmap rs def
case def of
Nothing -> Nothing
Just stmt -> Just $ rs stmt
rs (AsgnBlk lhs expr) = convertAssignment AsgnBlk lhs expr rs (AsgnBlk lhs expr) = convertAssignment AsgnBlk lhs expr
rs (Asgn lhs expr) = convertAssignment Asgn lhs expr rs (Asgn lhs expr) = convertAssignment Asgn lhs expr
rs (For (x1, e1) cc (x2, e2) stmt) = For (x1, e1') cc' (x2, e2') (rs stmt) rs (For (x1, e1) cc (x2, e2) stmt) = For (x1, e1') cc' (x2, e2') (rs stmt)
...@@ -241,7 +238,7 @@ convertModuleItem dimMap (MIDecl (Variable d t x a me)) = ...@@ -241,7 +238,7 @@ convertModuleItem dimMap (MIDecl (Variable d t x a me)) =
(tf, rs) = typeDims t (tf, rs) = typeDims t
t' = tf $ flattenRanges rs t' = tf $ flattenRanges rs
a' = map (rewriteRange dimMap) a a' = map (rewriteRange dimMap) a
me' = maybe Nothing (Just . rewriteExpr dimMap) me me' = fmap (rewriteExpr dimMap) me
convertModuleItem dimMap (Generate items) = convertModuleItem dimMap (Generate items) =
Generate $ map (convertGenItem dimMap) items Generate $ map (convertGenItem dimMap) items
convertModuleItem dimMap (Assign lhs expr) = convertModuleItem dimMap (Assign lhs expr) =
...@@ -250,10 +247,8 @@ convertModuleItem dimMap (AlwaysC kw stmt) = ...@@ -250,10 +247,8 @@ convertModuleItem dimMap (AlwaysC kw stmt) =
AlwaysC kw (rewriteStmt dimMap stmt) AlwaysC kw (rewriteStmt dimMap stmt)
convertModuleItem dimMap (Function ret f decls stmt) = convertModuleItem dimMap (Function ret f decls stmt) =
Function ret f decls (rewriteStmt dimMap stmt) Function ret f decls (rewriteStmt dimMap stmt)
convertModuleItem _ (Instance m params x Nothing) = convertModuleItem dimMap (Instance m params x ml) =
Instance m params x Nothing Instance m params x $ fmap (map convertPortBinding) ml
convertModuleItem dimMap (Instance m params x (Just l)) =
Instance m params x $ Just $ map convertPortBinding l
where where
convertPortBinding :: PortBinding -> PortBinding convertPortBinding :: PortBinding -> PortBinding
convertPortBinding (p, Nothing) = (p, Nothing) convertPortBinding (p, Nothing) = (p, Nothing)
...@@ -276,6 +271,4 @@ convertGenItem dimMap item = convertGenItem' item ...@@ -276,6 +271,4 @@ convertGenItem dimMap item = convertGenItem' item
convertGenItem' (GenCase e cases def) = GenCase e cases' def' convertGenItem' (GenCase e cases def) = GenCase e cases' def'
where where
cases' = zip (map fst cases) (map (convertGenItem' . snd) cases) cases' = zip (map fst cases) (map (convertGenItem' . snd) cases)
def' = if def == Nothing def' = fmap convertGenItem' def
then Nothing
else Just $ convertGenItem' $ fromJust def
...@@ -17,7 +17,6 @@ module Convert.Traverse ...@@ -17,7 +17,6 @@ module Convert.Traverse
) where ) where
import Control.Monad.State import Control.Monad.State
import Data.Maybe
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
type MapperM s t = t -> (State s) t type MapperM s t = t -> (State s) t
...@@ -34,6 +33,10 @@ traverseDescriptionsM mapper descriptions = ...@@ -34,6 +33,10 @@ traverseDescriptionsM mapper descriptions =
traverseDescriptions :: Mapper Description -> Mapper AST traverseDescriptions :: Mapper Description -> Mapper AST
traverseDescriptions = unmonad traverseDescriptionsM traverseDescriptions = unmonad traverseDescriptionsM
maybeDo :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
maybeDo _ Nothing = return Nothing
maybeDo fun (Just val) = fun val >>= return . Just
traverseModuleItemsM :: MapperM s ModuleItem -> MapperM s Description traverseModuleItemsM :: MapperM s ModuleItem -> MapperM s Description
traverseModuleItemsM mapper (Module name ports items) = traverseModuleItemsM mapper (Module name ports items) =
mapM fullMapper items >>= return . Module name ports mapM fullMapper items >>= return . Module name ports
...@@ -56,9 +59,7 @@ traverseModuleItemsM mapper (Module name ports items) = ...@@ -56,9 +59,7 @@ traverseModuleItemsM mapper (Module name ports items) =
genItemMapper (GenCase e cases def) = do genItemMapper (GenCase e cases def) = do
caseItems <- mapM (genItemMapper . snd) cases caseItems <- mapM (genItemMapper . snd) cases
let cases' = zip (map fst cases) caseItems let cases' = zip (map fst cases) caseItems
def' <- if def == Nothing def' <- maybeDo genItemMapper def
then return Nothing
else genItemMapper (fromJust def) >>= \x -> return $ Just x
return $ GenCase e cases' def' return $ GenCase e cases' def'
traverseModuleItemsM _ orig = return orig traverseModuleItemsM _ orig = return orig
...@@ -78,9 +79,7 @@ traverseStmtsM mapper = moduleItemMapper ...@@ -78,9 +79,7 @@ traverseStmtsM mapper = moduleItemMapper
cs (Case kw expr cases def) = do cs (Case kw expr cases def) = do
caseStmts <- mapM fullMapper $ map snd cases caseStmts <- mapM fullMapper $ map snd cases
let cases' = zip (map fst cases) caseStmts let cases' = zip (map fst cases) caseStmts
def' <- if def == Nothing def' <- maybeDo fullMapper def
then return Nothing
else fullMapper (fromJust def) >>= \x -> return $ Just x
return $ Case kw expr cases' def' return $ Case kw expr cases' def'
cs (AsgnBlk lhs expr) = return $ AsgnBlk lhs expr cs (AsgnBlk lhs expr) = return $ AsgnBlk lhs expr
cs (Asgn lhs expr) = return $ Asgn lhs expr cs (Asgn lhs expr) = return $ Asgn lhs expr
......
...@@ -84,12 +84,11 @@ convertStmt types = rs ...@@ -84,12 +84,11 @@ convertStmt types = rs
rs :: Stmt -> Stmt rs :: Stmt -> Stmt
rs (Block header stmts) = rs (Block header stmts) =
Block header' (map rs stmts) Block header' (map rs stmts)
where header' = maybe Nothing (\(x, decls) -> Just (x, map rd decls)) header where header' = fmap (\(x, decls) -> (x, map rd decls)) header
rs (Case kw e cases def) = Case kw (re e) rs (Case kw e cases def) = Case kw (re e)
(map convertCase cases) def' (map convertCase cases) (fmap rs def)
where where
convertCase (exprs, stmt) = (map re exprs, rs stmt) convertCase (exprs, stmt) = (map re exprs, rs stmt)
def' = maybe Nothing (Just . rs) def
rs (AsgnBlk lhs expr) = AsgnBlk lhs (re expr) rs (AsgnBlk lhs expr) = AsgnBlk lhs (re expr)
rs (Asgn lhs expr) = Asgn lhs (re expr) rs (Asgn lhs expr) = Asgn lhs (re expr)
rs (For (x1, e1) e (x2, e2) stmt) = rs (For (x1, e1) e (x2, e2) stmt) =
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment