mirror of https://github.com/zachjs/sv2v.git
fix spacing of as-patterns for future GHC upgrade
This commit is contained in:
parent
536eba46b9
commit
30acc3e3f9
|
|
@ -42,7 +42,7 @@ convertStmt (Block Seq name decls stmts) =
|
||||||
convertStmt other = other
|
convertStmt other = other
|
||||||
|
|
||||||
splitDecl :: Decl -> (Decl, Maybe (LHS, Expr))
|
splitDecl :: Decl -> (Decl, Maybe (LHS, Expr))
|
||||||
splitDecl (decl @ (Variable _ _ _ _ Nil)) =
|
splitDecl decl@(Variable _ _ _ _ Nil) =
|
||||||
(decl, Nothing)
|
(decl, Nothing)
|
||||||
splitDecl (Variable d t ident a e) =
|
splitDecl (Variable d t ident a e) =
|
||||||
(Variable d t ident a Nil, Just (LHSIdent ident, e))
|
(Variable d t ident a Nil, Just (LHSIdent ident, e))
|
||||||
|
|
|
||||||
|
|
@ -56,12 +56,12 @@ convertExpr (DimsFn fn (Right e)) =
|
||||||
DimsFn fn $ Left $ TypeOf e
|
DimsFn fn $ Left $ TypeOf e
|
||||||
convertExpr (DimFn fn (Right e) d) =
|
convertExpr (DimFn fn (Right e) d) =
|
||||||
DimFn fn (Left $ TypeOf e) d
|
DimFn fn (Left $ TypeOf e) d
|
||||||
convertExpr (orig @ (DimsFn FnUnpackedDimensions (Left t))) =
|
convertExpr orig@(DimsFn FnUnpackedDimensions (Left t)) =
|
||||||
case t of
|
case t of
|
||||||
UnpackedType _ rs -> RawNum $ fromIntegral $ length rs
|
UnpackedType _ rs -> RawNum $ fromIntegral $ length rs
|
||||||
TypeOf{} -> orig
|
TypeOf{} -> orig
|
||||||
_ -> RawNum 0
|
_ -> RawNum 0
|
||||||
convertExpr (orig @ (DimsFn FnDimensions (Left t))) =
|
convertExpr orig@(DimsFn FnDimensions (Left t)) =
|
||||||
case t of
|
case t of
|
||||||
IntegerAtom{} -> RawNum 1
|
IntegerAtom{} -> RawNum 1
|
||||||
Alias{} -> orig
|
Alias{} -> orig
|
||||||
|
|
|
||||||
|
|
@ -20,7 +20,7 @@ convert :: [AST] -> [AST]
|
||||||
convert = map $ traverseDescriptions convertDescription
|
convert = map $ traverseDescriptions convertDescription
|
||||||
|
|
||||||
convertDescription :: Description -> Description
|
convertDescription :: Description -> Description
|
||||||
convertDescription (description @ Part{}) =
|
convertDescription description@Part{} =
|
||||||
traverseModuleItems
|
traverseModuleItems
|
||||||
(traverseExprs $ traverseNestedExprs $ convertExpr functions)
|
(traverseExprs $ traverseNestedExprs $ convertExpr functions)
|
||||||
description'
|
description'
|
||||||
|
|
|
||||||
|
|
@ -44,9 +44,9 @@ simplifyStep (Concat [Number (Decimal size _ value)]) =
|
||||||
Number $ Decimal size False value
|
Number $ Decimal size False value
|
||||||
simplifyStep (Concat [Number (Based size _ base value kinds)]) =
|
simplifyStep (Concat [Number (Based size _ base value kinds)]) =
|
||||||
Number $ Based size False base value kinds
|
Number $ Based size False base value kinds
|
||||||
simplifyStep (Concat [e @ Stream{}]) = e
|
simplifyStep (Concat [e@Stream{}]) = e
|
||||||
simplifyStep (Concat [e @ Concat{}]) = e
|
simplifyStep (Concat [e@Concat{}]) = e
|
||||||
simplifyStep (Concat [e @ Repeat{}]) = e
|
simplifyStep (Concat [e@Repeat{}]) = e
|
||||||
simplifyStep (Concat es) = Concat $ filter (/= Concat []) es
|
simplifyStep (Concat es) = Concat $ filter (/= Concat []) es
|
||||||
simplifyStep (Repeat (Dec 0) _) = Concat []
|
simplifyStep (Repeat (Dec 0) _) = Concat []
|
||||||
simplifyStep (Repeat (Dec 1) es) = Concat es
|
simplifyStep (Repeat (Dec 1) es) = Concat es
|
||||||
|
|
@ -91,23 +91,23 @@ simplifyBinOp Add (UniOp UniSub e1) e2 = BinOp Sub e2 e1
|
||||||
simplifyBinOp Sub e1 (UniOp UniSub e2) = BinOp Add e1 e2
|
simplifyBinOp Sub e1 (UniOp UniSub e2) = BinOp Add e1 e2
|
||||||
simplifyBinOp Sub (UniOp UniSub e1) e2 = UniOp UniSub $ BinOp Add e1 e2
|
simplifyBinOp Sub (UniOp UniSub e1) e2 = UniOp UniSub $ BinOp Add e1 e2
|
||||||
|
|
||||||
simplifyBinOp Add (BinOp Add e (n1 @ Number{})) (n2 @ Number{}) =
|
simplifyBinOp Add (BinOp Add e n1@Number{}) n2@Number{} =
|
||||||
BinOp Add e (BinOp Add n1 n2)
|
BinOp Add e (BinOp Add n1 n2)
|
||||||
simplifyBinOp Sub (n1 @ Number{}) (BinOp Sub (n2 @ Number{}) e) =
|
simplifyBinOp Sub n1@Number{} (BinOp Sub n2@Number{} e) =
|
||||||
BinOp Add (BinOp Sub n1 n2) e
|
BinOp Add (BinOp Sub n1 n2) e
|
||||||
simplifyBinOp Sub (n1 @ Number{}) (BinOp Sub e (n2 @ Number{})) =
|
simplifyBinOp Sub n1@Number{} (BinOp Sub e n2@Number{}) =
|
||||||
BinOp Sub (BinOp Add n1 n2) e
|
BinOp Sub (BinOp Add n1 n2) e
|
||||||
simplifyBinOp Sub (BinOp Add e (n1 @ Number{})) (n2 @ Number{}) =
|
simplifyBinOp Sub (BinOp Add e n1@Number{}) n2@Number{} =
|
||||||
BinOp Add e (BinOp Sub n1 n2)
|
BinOp Add e (BinOp Sub n1 n2)
|
||||||
simplifyBinOp Add (n1 @ Number{}) (BinOp Add (n2 @ Number{}) e) =
|
simplifyBinOp Add n1@Number{} (BinOp Add n2@Number{} e) =
|
||||||
BinOp Add (BinOp Add n1 n2) e
|
BinOp Add (BinOp Add n1 n2) e
|
||||||
simplifyBinOp Add (n1 @ Number{}) (BinOp Sub e (n2 @ Number{})) =
|
simplifyBinOp Add n1@Number{} (BinOp Sub e n2@Number{}) =
|
||||||
BinOp Add e (BinOp Sub n1 n2)
|
BinOp Add e (BinOp Sub n1 n2)
|
||||||
simplifyBinOp Sub (BinOp Sub e (n1 @ Number{})) (n2 @ Number{}) =
|
simplifyBinOp Sub (BinOp Sub e n1@Number{}) n2@Number{} =
|
||||||
BinOp Sub e (BinOp Add n1 n2)
|
BinOp Sub e (BinOp Add n1 n2)
|
||||||
simplifyBinOp Add (BinOp Sub e (n1 @ Number{})) (n2 @ Number{}) =
|
simplifyBinOp Add (BinOp Sub e n1@Number{}) n2@Number{} =
|
||||||
BinOp Sub e (BinOp Sub n1 n2)
|
BinOp Sub e (BinOp Sub n1 n2)
|
||||||
simplifyBinOp Add (BinOp Sub (n1 @ Number{}) e) (n2 @ Number{}) =
|
simplifyBinOp Add (BinOp Sub n1@Number{} e) n2@Number{} =
|
||||||
BinOp Sub (BinOp Add n1 n2) e
|
BinOp Sub (BinOp Add n1 n2) e
|
||||||
simplifyBinOp Ge (BinOp Sub e (Dec 1)) (Dec 0) = BinOp Ge e (toDec 1)
|
simplifyBinOp Ge (BinOp Sub e (Dec 1)) (Dec 0) = BinOp Ge e (toDec 1)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -22,7 +22,7 @@ convert :: [AST] -> [AST]
|
||||||
convert = map $ traverseDescriptions convertDescription
|
convert = map $ traverseDescriptions convertDescription
|
||||||
|
|
||||||
convertDescription :: Description -> Description
|
convertDescription :: Description -> Description
|
||||||
convertDescription (description @ Part{}) =
|
convertDescription description@Part{} =
|
||||||
traverseModuleItems traverseModuleItem description
|
traverseModuleItems traverseModuleItem description
|
||||||
where
|
where
|
||||||
traverseModuleItem =
|
traverseModuleItem =
|
||||||
|
|
|
||||||
|
|
@ -48,7 +48,7 @@ convertDescription (Part attrs extern kw lifetime name ports items) =
|
||||||
convertDescription description = description
|
convertDescription description = description
|
||||||
|
|
||||||
expandParam :: [Identifier] -> ModuleItem -> ModuleItem
|
expandParam :: [Identifier] -> ModuleItem -> ModuleItem
|
||||||
expandParam shadowed (MIPackageItem (Decl (param @ (Param Parameter _ x _)))) =
|
expandParam shadowed (MIPackageItem (Decl param@(Param Parameter _ x _))) =
|
||||||
if elem x shadowed
|
if elem x shadowed
|
||||||
then Generate $ map (GenModuleItem . wrap) [param, extra]
|
then Generate $ map (GenModuleItem . wrap) [param, extra]
|
||||||
else wrap param
|
else wrap param
|
||||||
|
|
@ -82,14 +82,14 @@ traverseDeclM decl = do
|
||||||
|
|
||||||
-- substitute hierarchical references to constants
|
-- substitute hierarchical references to constants
|
||||||
traverseExprM :: Expr -> ST Expr
|
traverseExprM :: Expr -> ST Expr
|
||||||
traverseExprM (expr @ (Dot _ x)) = do
|
traverseExprM expr@(Dot _ x) = do
|
||||||
expr' <- traverseSinglyNestedExprsM traverseExprM expr
|
expr' <- traverseSinglyNestedExprsM traverseExprM expr
|
||||||
detailsE <- lookupElemM expr'
|
detailsE <- lookupElemM expr'
|
||||||
detailsX <- lookupElemM x
|
detailsX <- lookupElemM x
|
||||||
case (detailsE, detailsX) of
|
case (detailsE, detailsX) of
|
||||||
(Just ([_, _], _, Left{}), Just ([_, _], _, Left{})) ->
|
(Just ([_, _], _, Left{}), Just ([_, _], _, Left{})) ->
|
||||||
return $ Ident x
|
return $ Ident x
|
||||||
(Just (accesses @ [Access _ Nil, _], _, Left False), _) -> do
|
(Just (accesses@[Access _ Nil, _], _, Left False), _) -> do
|
||||||
details <- lookupElemM $ prefix x
|
details <- lookupElemM $ prefix x
|
||||||
when (details == Nothing) $
|
when (details == Nothing) $
|
||||||
insertElem accesses (Left True)
|
insertElem accesses (Left True)
|
||||||
|
|
|
||||||
|
|
@ -49,20 +49,20 @@ traverseDeclM decl = do
|
||||||
traverseModuleItemM :: DefaultNetType -> ModuleItem -> Scoper () ModuleItem
|
traverseModuleItemM :: DefaultNetType -> ModuleItem -> Scoper () ModuleItem
|
||||||
traverseModuleItemM _ (Genvar x) =
|
traverseModuleItemM _ (Genvar x) =
|
||||||
insertElem x () >> return (Genvar x)
|
insertElem x () >> return (Genvar x)
|
||||||
traverseModuleItemM defaultNetType (orig @ (Assign _ x _)) = do
|
traverseModuleItemM defaultNetType orig@(Assign _ x _) = do
|
||||||
needsLHS defaultNetType x
|
needsLHS defaultNetType x
|
||||||
return orig
|
return orig
|
||||||
traverseModuleItemM defaultNetType (orig @ (NInputGate _ _ x lhs exprs)) = do
|
traverseModuleItemM defaultNetType orig@(NInputGate _ _ x lhs exprs) = do
|
||||||
insertElem x ()
|
insertElem x ()
|
||||||
needsLHS defaultNetType lhs
|
needsLHS defaultNetType lhs
|
||||||
_ <- mapM (needsExpr defaultNetType) exprs
|
_ <- mapM (needsExpr defaultNetType) exprs
|
||||||
return orig
|
return orig
|
||||||
traverseModuleItemM defaultNetType (orig @ (NOutputGate _ _ x lhss expr)) = do
|
traverseModuleItemM defaultNetType orig@(NOutputGate _ _ x lhss expr) = do
|
||||||
insertElem x ()
|
insertElem x ()
|
||||||
_ <- mapM (needsLHS defaultNetType) lhss
|
_ <- mapM (needsLHS defaultNetType) lhss
|
||||||
needsExpr defaultNetType expr
|
needsExpr defaultNetType expr
|
||||||
return orig
|
return orig
|
||||||
traverseModuleItemM defaultNetType (orig @ (Instance _ _ x _ ports)) = do
|
traverseModuleItemM defaultNetType orig@(Instance _ _ x _ ports) = do
|
||||||
insertElem x ()
|
insertElem x ()
|
||||||
_ <- mapM (needsExpr defaultNetType . snd) ports
|
_ <- mapM (needsExpr defaultNetType . snd) ports
|
||||||
return orig
|
return orig
|
||||||
|
|
|
||||||
|
|
@ -88,7 +88,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
|
||||||
traverseModuleItemM :: ModuleItem -> Scoper [ModportDecl] ModuleItem
|
traverseModuleItemM :: ModuleItem -> Scoper [ModportDecl] ModuleItem
|
||||||
traverseModuleItemM (Modport modportName modportDecls) =
|
traverseModuleItemM (Modport modportName modportDecls) =
|
||||||
insertElem modportName modportDecls >> return (Generate [])
|
insertElem modportName modportDecls >> return (Generate [])
|
||||||
traverseModuleItemM (instanceItem @ Instance{}) = do
|
traverseModuleItemM instanceItem@Instance{} = do
|
||||||
modports <- embedScopes (\l () -> l) ()
|
modports <- embedScopes (\l () -> l) ()
|
||||||
if isNothing maybePartInfo then
|
if isNothing maybePartInfo then
|
||||||
return instanceItem
|
return instanceItem
|
||||||
|
|
@ -129,7 +129,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
|
||||||
|
|
||||||
-- add explicit slices for bindings of entire modport instance arrays
|
-- add explicit slices for bindings of entire modport instance arrays
|
||||||
addImpliedSlice :: Scopes [ModportDecl] -> Expr -> Expr
|
addImpliedSlice :: Scopes [ModportDecl] -> Expr -> Expr
|
||||||
addImpliedSlice modports (orig @ (Dot expr modportName)) =
|
addImpliedSlice modports orig@(Dot expr modportName) =
|
||||||
case lookupIntfElem modports (InstArrKey expr) of
|
case lookupIntfElem modports (InstArrKey expr) of
|
||||||
Just (_, _, InstArrVal l r) ->
|
Just (_, _, InstArrVal l r) ->
|
||||||
Dot (Range expr NonIndexed (l, r)) modportName
|
Dot (Range expr NonIndexed (l, r)) modportName
|
||||||
|
|
@ -485,7 +485,7 @@ inlineInstance global ranges modportBindings items partName
|
||||||
case lookup (Bit expr Tag) exprReplacements of
|
case lookup (Bit expr Tag) exprReplacements of
|
||||||
Just resolved -> replaceArrTag (replaceExpr' local elt) resolved
|
Just resolved -> replaceArrTag (replaceExpr' local elt) resolved
|
||||||
Nothing -> Bit (replaceExpr' local expr) (replaceExpr' local elt)
|
Nothing -> Bit (replaceExpr' local expr) (replaceExpr' local elt)
|
||||||
replaceExpr' local (expr @ (Dot Ident{} _)) =
|
replaceExpr' local expr@(Dot Ident{} _) =
|
||||||
case lookup expr exprReplacements of
|
case lookup expr exprReplacements of
|
||||||
Just expr' -> expr'
|
Just expr' -> expr'
|
||||||
Nothing -> checkExprResolution local expr $
|
Nothing -> checkExprResolution local expr $
|
||||||
|
|
@ -555,7 +555,7 @@ inlineInstance global ranges modportBindings items partName
|
||||||
Implicit Unspecified rs ->
|
Implicit Unspecified rs ->
|
||||||
IntegerVector TLogic Unspecified rs
|
IntegerVector TLogic Unspecified rs
|
||||||
_ -> t
|
_ -> t
|
||||||
removeDeclDir decl @ Net{} =
|
removeDeclDir decl@Net{} =
|
||||||
traverseNetAsVar removeDeclDir decl
|
traverseNetAsVar removeDeclDir decl
|
||||||
removeDeclDir other = other
|
removeDeclDir other = other
|
||||||
|
|
||||||
|
|
@ -620,7 +620,7 @@ inlineInstance global ranges modportBindings items partName
|
||||||
collectDeclDir (Variable dir _ ident _ _) =
|
collectDeclDir (Variable dir _ ident _ _) =
|
||||||
when (dir /= Local) $
|
when (dir /= Local) $
|
||||||
tell $ Map.singleton ident dir
|
tell $ Map.singleton ident dir
|
||||||
collectDeclDir net @ Net{} =
|
collectDeclDir net@Net{} =
|
||||||
collectNetAsVarM collectDeclDir net
|
collectNetAsVarM collectDeclDir net
|
||||||
collectDeclDir _ = return ()
|
collectDeclDir _ = return ()
|
||||||
findDeclDir :: Identifier -> Direction
|
findDeclDir :: Identifier -> Direction
|
||||||
|
|
@ -641,7 +641,7 @@ inlineInstance global ranges modportBindings items partName
|
||||||
loopVar = "_arr_" ++ key
|
loopVar = "_arr_" ++ key
|
||||||
|
|
||||||
isArray = not $ null ranges
|
isArray = not $ null ranges
|
||||||
[arrayRange @ (arrayLeft, arrayRight)] = ranges
|
[arrayRange@(arrayLeft, arrayRight)] = ranges
|
||||||
|
|
||||||
-- wrap the given item in a generate loop if necessary
|
-- wrap the given item in a generate loop if necessary
|
||||||
wrapInstance :: Identifier -> [ModuleItem] -> ModuleItem
|
wrapInstance :: Identifier -> [ModuleItem] -> ModuleItem
|
||||||
|
|
|
||||||
|
|
@ -105,7 +105,7 @@ addJumpStateDeclStmt stmt =
|
||||||
where (decls, [stmt']) = addJumpStateDeclTF [] [stmt]
|
where (decls, [stmt']) = addJumpStateDeclTF [] [stmt]
|
||||||
|
|
||||||
removeJumpState :: Stmt -> Stmt
|
removeJumpState :: Stmt -> Stmt
|
||||||
removeJumpState (orig @ (Asgn _ _ (LHSIdent ident) _)) =
|
removeJumpState orig@(Asgn _ _ (LHSIdent ident) _) =
|
||||||
if ident == jumpState
|
if ident == jumpState
|
||||||
then Null
|
then Null
|
||||||
else orig
|
else orig
|
||||||
|
|
|
||||||
|
|
@ -55,7 +55,7 @@ convertStmt tfs (Subroutine expr args) =
|
||||||
convertStmt _ other = other
|
convertStmt _ other = other
|
||||||
|
|
||||||
convertInvoke :: TFs -> (Expr -> Args -> a) -> Expr -> Args -> a
|
convertInvoke :: TFs -> (Expr -> Args -> a) -> Expr -> Args -> a
|
||||||
convertInvoke tfs constructor (Ident func) (Args pnArgs (kwArgs @ (_ : _))) =
|
convertInvoke tfs constructor (Ident func) (Args pnArgs kwArgs@(_ : _)) =
|
||||||
case tfs Map.!? func of
|
case tfs Map.!? func of
|
||||||
Nothing -> constructor (Ident func) (Args pnArgs kwArgs)
|
Nothing -> constructor (Ident func) (Args pnArgs kwArgs)
|
||||||
Just ordered -> constructor (Ident func) (Args args [])
|
Just ordered -> constructor (Ident func) (Args args [])
|
||||||
|
|
|
||||||
|
|
@ -42,7 +42,7 @@ convert :: [AST] -> [AST]
|
||||||
convert = map $ traverseDescriptions convertDescription
|
convert = map $ traverseDescriptions convertDescription
|
||||||
|
|
||||||
convertDescription :: Description -> Description
|
convertDescription :: Description -> Description
|
||||||
convertDescription (description @ (Part _ _ Module _ _ _ _)) =
|
convertDescription description@(Part _ _ Module _ _ _ _) =
|
||||||
partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
|
partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
|
||||||
description
|
description
|
||||||
convertDescription other = other
|
convertDescription other = other
|
||||||
|
|
@ -52,7 +52,7 @@ traverseDeclM :: Decl -> Scoper TypeInfo Decl
|
||||||
traverseDeclM (Variable dir t ident a e) = do
|
traverseDeclM (Variable dir t ident a e) = do
|
||||||
t' <- traverseTypeM t a ident
|
t' <- traverseTypeM t a ident
|
||||||
traverseDeclExprsM traverseExprM $ Variable dir t' ident a e
|
traverseDeclExprsM traverseExprM $ Variable dir t' ident a e
|
||||||
traverseDeclM net @ Net{} =
|
traverseDeclM net@Net{} =
|
||||||
traverseNetAsVarM traverseDeclM net
|
traverseNetAsVarM traverseDeclM net
|
||||||
traverseDeclM (Param s t ident e) = do
|
traverseDeclM (Param s t ident e) = do
|
||||||
t' <- traverseTypeM t [] ident
|
t' <- traverseTypeM t [] ident
|
||||||
|
|
@ -233,7 +233,7 @@ convertExpr scopes =
|
||||||
if head x == tag
|
if head x == tag
|
||||||
then Ident $ tail x
|
then Ident $ tail x
|
||||||
else Ident x
|
else Ident x
|
||||||
rewriteExpr (orig @ (Bit (Bit expr idxInner) idxOuter)) =
|
rewriteExpr orig@(Bit (Bit expr idxInner) idxOuter) =
|
||||||
if isJust maybeDims && expr == rewriteExpr expr
|
if isJust maybeDims && expr == rewriteExpr expr
|
||||||
then Bit expr' idx'
|
then Bit expr' idx'
|
||||||
else rewriteExprLowPrec orig
|
else rewriteExprLowPrec orig
|
||||||
|
|
@ -244,7 +244,7 @@ convertExpr scopes =
|
||||||
idxOuter' = orientIdx dimOuter idxOuter
|
idxOuter' = orientIdx dimOuter idxOuter
|
||||||
base = BinOp Mul idxInner' (rangeSize dimOuter)
|
base = BinOp Mul idxInner' (rangeSize dimOuter)
|
||||||
idx' = simplify $ BinOp Add base idxOuter'
|
idx' = simplify $ BinOp Add base idxOuter'
|
||||||
rewriteExpr (orig @ (Range (Bit expr idxInner) NonIndexed rangeOuter)) =
|
rewriteExpr orig@(Range (Bit expr idxInner) NonIndexed rangeOuter) =
|
||||||
if isJust maybeDims && expr == rewriteExpr expr
|
if isJust maybeDims && expr == rewriteExpr expr
|
||||||
then rewriteExpr $ Range exprOuter IndexedMinus range
|
then rewriteExpr $ Range exprOuter IndexedMinus range
|
||||||
else rewriteExprLowPrec orig
|
else rewriteExprLowPrec orig
|
||||||
|
|
@ -256,7 +256,7 @@ convertExpr scopes =
|
||||||
base = endianCondExpr rangeOuter baseDec baseInc
|
base = endianCondExpr rangeOuter baseDec baseInc
|
||||||
len = rangeSize rangeOuter
|
len = rangeSize rangeOuter
|
||||||
range = (base, len)
|
range = (base, len)
|
||||||
rewriteExpr (orig @ (Range (Bit expr idxInner) modeOuter rangeOuter)) =
|
rewriteExpr orig@(Range (Bit expr idxInner) modeOuter rangeOuter) =
|
||||||
if isJust maybeDims && expr == rewriteExpr expr
|
if isJust maybeDims && expr == rewriteExpr expr
|
||||||
then Range expr' modeOuter range'
|
then Range expr' modeOuter range'
|
||||||
else rewriteExprLowPrec orig
|
else rewriteExprLowPrec orig
|
||||||
|
|
@ -279,7 +279,7 @@ convertExpr scopes =
|
||||||
rewriteExprLowPrec other
|
rewriteExprLowPrec other
|
||||||
|
|
||||||
rewriteExprLowPrec :: Expr -> Expr
|
rewriteExprLowPrec :: Expr -> Expr
|
||||||
rewriteExprLowPrec (orig @ (Bit expr idx)) =
|
rewriteExprLowPrec orig@(Bit expr idx) =
|
||||||
if isJust maybeDims && expr == rewriteExpr expr
|
if isJust maybeDims && expr == rewriteExpr expr
|
||||||
then Range expr' mode' range'
|
then Range expr' mode' range'
|
||||||
else orig
|
else orig
|
||||||
|
|
@ -291,7 +291,7 @@ convertExpr scopes =
|
||||||
len = rangeSize dimOuter
|
len = rangeSize dimOuter
|
||||||
base = BinOp Add (endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)) (BinOp Mul idx' len)
|
base = BinOp Add (endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)) (BinOp Mul idx' len)
|
||||||
range' = (simplify base, simplify len)
|
range' = (simplify base, simplify len)
|
||||||
rewriteExprLowPrec (orig @ (Range expr NonIndexed range)) =
|
rewriteExprLowPrec orig@(Range expr NonIndexed range) =
|
||||||
if isJust maybeDims && expr == rewriteExpr expr
|
if isJust maybeDims && expr == rewriteExpr expr
|
||||||
then rewriteExpr $ Range expr IndexedMinus range'
|
then rewriteExpr $ Range expr IndexedMinus range'
|
||||||
else orig
|
else orig
|
||||||
|
|
@ -302,7 +302,7 @@ convertExpr scopes =
|
||||||
base = endianCondExpr range baseDec baseInc
|
base = endianCondExpr range baseDec baseInc
|
||||||
len = rangeSize range
|
len = rangeSize range
|
||||||
range' = (base, len)
|
range' = (base, len)
|
||||||
rewriteExprLowPrec (orig @ (Range expr mode range)) =
|
rewriteExprLowPrec orig@(Range expr mode range) =
|
||||||
if isJust maybeDims && expr == rewriteExpr expr
|
if isJust maybeDims && expr == rewriteExpr expr
|
||||||
then Range expr' mode' range'
|
then Range expr' mode' range'
|
||||||
else orig
|
else orig
|
||||||
|
|
|
||||||
|
|
@ -87,8 +87,8 @@ collectPackageM (Class _ name decls items) =
|
||||||
tell (Map.empty, Map.singleton name (decls, map unpackClassItem items), [])
|
tell (Map.empty, Map.singleton name (decls, map unpackClassItem items), [])
|
||||||
where
|
where
|
||||||
unpackClassItem :: ClassItem -> PackageItem
|
unpackClassItem :: ClassItem -> PackageItem
|
||||||
unpackClassItem (item @ (_, Task{})) = checkTF item
|
unpackClassItem item@(_, Task{}) = checkTF item
|
||||||
unpackClassItem (item @ (_, Function{})) = checkTF item
|
unpackClassItem item@(_, Function{}) = checkTF item
|
||||||
unpackClassItem item = checkNonTF item
|
unpackClassItem item = checkNonTF item
|
||||||
checkTF :: ClassItem -> PackageItem
|
checkTF :: ClassItem -> PackageItem
|
||||||
checkTF (QStatic, item) = item
|
checkTF (QStatic, item) = item
|
||||||
|
|
@ -242,7 +242,7 @@ processItems topName packageName moduleItems = do
|
||||||
-- produces partial mappings of exported identifiers, while also
|
-- produces partial mappings of exported identifiers, while also
|
||||||
-- checking the validity of the exports
|
-- checking the validity of the exports
|
||||||
resolveExportMI :: IdentStateMap -> ModuleItem -> PackagesState IdentStateMap
|
resolveExportMI :: IdentStateMap -> ModuleItem -> PackagesState IdentStateMap
|
||||||
resolveExportMI mapping (MIPackageItem (item @ (Export pkg ident))) =
|
resolveExportMI mapping (MIPackageItem item@(Export pkg ident)) =
|
||||||
if null packageName
|
if null packageName
|
||||||
then error $ "invalid " ++ (init $ show item)
|
then error $ "invalid " ++ (init $ show item)
|
||||||
++ " outside of package"
|
++ " outside of package"
|
||||||
|
|
@ -304,12 +304,12 @@ processItems topName packageName moduleItems = do
|
||||||
++ intercalate ", " rootPkgs
|
++ intercalate ", " rootPkgs
|
||||||
|
|
||||||
traversePackageItemM :: PackageItem -> Scope PackageItem
|
traversePackageItemM :: PackageItem -> Scope PackageItem
|
||||||
traversePackageItemM (orig @ (Import pkg ident)) = do
|
traversePackageItemM orig@(Import pkg ident) = do
|
||||||
if null ident
|
if null ident
|
||||||
then wildcardImports pkg
|
then wildcardImports pkg
|
||||||
else explicitImport pkg ident
|
else explicitImport pkg ident
|
||||||
return $ Decl $ CommentDecl $ "removed " ++ show orig
|
return $ Decl $ CommentDecl $ "removed " ++ show orig
|
||||||
traversePackageItemM (orig @ (Export pkg ident)) = do
|
traversePackageItemM orig@(Export pkg ident) = do
|
||||||
() <- when (not (null pkg || null ident)) $ do
|
() <- when (not (null pkg || null ident)) $ do
|
||||||
localName <- resolveIdent ident
|
localName <- resolveIdent ident
|
||||||
rootPkg <- lift $ resolveRootPackage pkg ident
|
rootPkg <- lift $ resolveRootPackage pkg ident
|
||||||
|
|
@ -459,7 +459,7 @@ findPackage packageName = do
|
||||||
assertMsg (not $ elem packageName stack) $
|
assertMsg (not $ elem packageName stack) $
|
||||||
"package dependency loop: " ++ show first ++ " depends on "
|
"package dependency loop: " ++ show first ++ " depends on "
|
||||||
++ intercalate ", which depends on " (map show rest)
|
++ intercalate ", which depends on " (map show rest)
|
||||||
let Just (package @ (exports, _))= maybePackage
|
let Just package@(exports, _) = maybePackage
|
||||||
if Map.null exports
|
if Map.null exports
|
||||||
then do
|
then do
|
||||||
-- process and resolve this package
|
-- process and resolve this package
|
||||||
|
|
@ -613,7 +613,7 @@ toRootPackage sourcePackage identState =
|
||||||
|
|
||||||
-- nests packages items missing from modules
|
-- nests packages items missing from modules
|
||||||
convertDescription :: PIs -> Description -> Description
|
convertDescription :: PIs -> Description -> Description
|
||||||
convertDescription pis (orig @ Part{}) =
|
convertDescription pis orig@Part{} =
|
||||||
if Map.null pis
|
if Map.null pis
|
||||||
then orig
|
then orig
|
||||||
else Part attrs extern kw lifetime name ports items'
|
else Part attrs extern kw lifetime name ports items'
|
||||||
|
|
|
||||||
|
|
@ -65,7 +65,7 @@ traverseDeclM other = return other
|
||||||
|
|
||||||
-- check for instances missing values for parameters without defaults
|
-- check for instances missing values for parameters without defaults
|
||||||
traverseModuleItem :: Parts -> ModuleItem -> ModuleItem
|
traverseModuleItem :: Parts -> ModuleItem -> ModuleItem
|
||||||
traverseModuleItem parts (orig @ (Instance part params name _ _)) =
|
traverseModuleItem parts orig@(Instance part params name _ _) =
|
||||||
if maybePartInfo == Nothing || null missingParams
|
if maybePartInfo == Nothing || null missingParams
|
||||||
then orig
|
then orig
|
||||||
else error $ "instance " ++ show name ++ " of " ++ show part
|
else error $ "instance " ++ show name ++ " of " ++ show part
|
||||||
|
|
|
||||||
|
|
@ -39,7 +39,7 @@ convert files =
|
||||||
-- add type parameter instantiations
|
-- add type parameter instantiations
|
||||||
files'' = map (concatMap explodeDescription) files'
|
files'' = map (concatMap explodeDescription) files'
|
||||||
explodeDescription :: Description -> [Description]
|
explodeDescription :: Description -> [Description]
|
||||||
explodeDescription (part @ (Part _ _ _ _ name _ _)) =
|
explodeDescription part@(Part _ _ _ _ name _ _) =
|
||||||
(part :) $
|
(part :) $
|
||||||
filter (not . alreadyExists) $
|
filter (not . alreadyExists) $
|
||||||
map (rewriteModule part) theseInstances
|
map (rewriteModule part) theseInstances
|
||||||
|
|
@ -57,7 +57,7 @@ convert files =
|
||||||
both (Map.fromListWith Set.union) $
|
both (Map.fromListWith Set.union) $
|
||||||
execWriter $ mapM (mapM collectUsageM) files''
|
execWriter $ mapM (mapM collectUsageM) files''
|
||||||
collectUsageM :: Description -> Writer (UsageMap, UsageMap) ()
|
collectUsageM :: Description -> Writer (UsageMap, UsageMap) ()
|
||||||
collectUsageM (part @ (Part _ _ _ _ name _ _)) =
|
collectUsageM part@(Part _ _ _ _ name _ _) =
|
||||||
tell $ both makeList $ execWriter $
|
tell $ both makeList $ execWriter $
|
||||||
(collectModuleItemsM collectModuleItemM) part
|
(collectModuleItemsM collectModuleItemM) part
|
||||||
where makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
|
where makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
|
||||||
|
|
@ -93,7 +93,7 @@ convert files =
|
||||||
|
|
||||||
-- instantiate the type parameters if this is a used default instance
|
-- instantiate the type parameters if this is a used default instance
|
||||||
reduceTypeDefaults :: Description -> Description
|
reduceTypeDefaults :: Description -> Description
|
||||||
reduceTypeDefaults (part @ (Part _ _ _ _ name _ _)) =
|
reduceTypeDefaults part@(Part _ _ _ _ name _ _) =
|
||||||
if shouldntReduce
|
if shouldntReduce
|
||||||
then part
|
then part
|
||||||
else traverseModuleItems (traverseDecls rewriteDecl) part
|
else traverseModuleItems (traverseDecls rewriteDecl) part
|
||||||
|
|
@ -149,7 +149,7 @@ convert files =
|
||||||
additionalParamItems = concatMap makeAddedParams $
|
additionalParamItems = concatMap makeAddedParams $
|
||||||
Map.toList $ Map.map snd inst
|
Map.toList $ Map.map snd inst
|
||||||
rewriteExpr :: Expr -> Expr
|
rewriteExpr :: Expr -> Expr
|
||||||
rewriteExpr (orig @ (Dot (Ident x) y)) =
|
rewriteExpr orig@(Dot (Ident x) y) =
|
||||||
if x == m
|
if x == m
|
||||||
then Dot (Ident m') y
|
then Dot (Ident m') y
|
||||||
else orig
|
else orig
|
||||||
|
|
@ -157,7 +157,7 @@ convert files =
|
||||||
traverseExprTypes rewriteType $
|
traverseExprTypes rewriteType $
|
||||||
traverseSinglyNestedExprs rewriteExpr other
|
traverseSinglyNestedExprs rewriteExpr other
|
||||||
rewriteLHS :: LHS -> LHS
|
rewriteLHS :: LHS -> LHS
|
||||||
rewriteLHS (orig @ (LHSDot (LHSIdent x) y)) =
|
rewriteLHS orig@(LHSDot (LHSIdent x) y) =
|
||||||
if x == m
|
if x == m
|
||||||
then LHSDot (LHSIdent m') y
|
then LHSDot (LHSIdent m') y
|
||||||
else orig
|
else orig
|
||||||
|
|
@ -192,7 +192,7 @@ convert files =
|
||||||
|
|
||||||
-- write down module parameter names and type parameters
|
-- write down module parameter names and type parameters
|
||||||
collectDescriptionM :: Description -> Writer Modules ()
|
collectDescriptionM :: Description -> Writer Modules ()
|
||||||
collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =
|
collectDescriptionM part@(Part _ _ _ _ name _ _) =
|
||||||
tell $ Map.singleton name typeMap
|
tell $ Map.singleton name typeMap
|
||||||
where
|
where
|
||||||
typeMap = Map.fromList $ execWriter $
|
typeMap = Map.fromList $ execWriter $
|
||||||
|
|
@ -250,7 +250,7 @@ prepareTypeExprs instanceName paramName =
|
||||||
(traverseTypeExprsM $ traverseNestedExprsM prepareExpr)
|
(traverseTypeExprsM $ traverseNestedExprsM prepareExpr)
|
||||||
where
|
where
|
||||||
prepareExpr :: Expr -> Writer (IdentSet, DeclMap) Expr
|
prepareExpr :: Expr -> Writer (IdentSet, DeclMap) Expr
|
||||||
prepareExpr (e @ Call{}) = do
|
prepareExpr e@Call{} = do
|
||||||
tell (Set.empty, Map.singleton x decl)
|
tell (Set.empty, Map.singleton x decl)
|
||||||
prepareExpr $ Ident x
|
prepareExpr $ Ident x
|
||||||
where
|
where
|
||||||
|
|
@ -281,7 +281,7 @@ convertGenItemM other =
|
||||||
|
|
||||||
-- attempt to rewrite instantiations with type parameters
|
-- attempt to rewrite instantiations with type parameters
|
||||||
convertModuleItemM :: ModuleItem -> Writer Instances ModuleItem
|
convertModuleItemM :: ModuleItem -> Writer Instances ModuleItem
|
||||||
convertModuleItemM (orig @ (Instance m bindings x r p)) =
|
convertModuleItemM orig@(Instance m bindings x r p) =
|
||||||
if hasOnlyExprs then
|
if hasOnlyExprs then
|
||||||
return orig
|
return orig
|
||||||
else if not hasUnresolvedTypes then do
|
else if not hasUnresolvedTypes then do
|
||||||
|
|
|
||||||
|
|
@ -276,7 +276,7 @@ directResolve mapping (Access x Nil : rest) = do
|
||||||
Entry _ "" subMapping <- Map.lookup x mapping
|
Entry _ "" subMapping <- Map.lookup x mapping
|
||||||
directResolve subMapping rest
|
directResolve subMapping rest
|
||||||
directResolve mapping (Access x e : rest) = do
|
directResolve mapping (Access x e : rest) = do
|
||||||
Entry _ (index @ (_ : _)) subMapping <- Map.lookup x mapping
|
Entry _ index@(_ : _) subMapping <- Map.lookup x mapping
|
||||||
(replacements, element) <- directResolve subMapping rest
|
(replacements, element) <- directResolve subMapping rest
|
||||||
let replacements' = Map.insert index e replacements
|
let replacements' = Map.insert index e replacements
|
||||||
Just (replacements', element)
|
Just (replacements', element)
|
||||||
|
|
|
||||||
|
|
@ -155,6 +155,6 @@ substitute scopes expr =
|
||||||
substituteIdent :: Scopes Expr -> Expr -> Expr
|
substituteIdent :: Scopes Expr -> Expr -> Expr
|
||||||
substituteIdent scopes (Ident x) =
|
substituteIdent scopes (Ident x) =
|
||||||
case lookupElem scopes x of
|
case lookupElem scopes x of
|
||||||
Just (_, _, n @ Number{}) -> n
|
Just (_, _, n@Number{}) -> n
|
||||||
_ -> Ident x
|
_ -> Ident x
|
||||||
substituteIdent _ other = other
|
substituteIdent _ other = other
|
||||||
|
|
|
||||||
|
|
@ -27,7 +27,7 @@ traverseDeclM (Variable d t x [] (Stream StreamR _ exprs)) =
|
||||||
expr' = resize exprSize lhsSize expr
|
expr' = resize exprSize lhsSize expr
|
||||||
lhsSize = DimsFn FnBits $ Left t
|
lhsSize = DimsFn FnBits $ Left t
|
||||||
exprSize = sizeof expr
|
exprSize = sizeof expr
|
||||||
traverseDeclM (Variable d t x [] (expr @ (Stream StreamL chunk exprs))) = do
|
traverseDeclM (Variable d t x [] expr@(Stream StreamL chunk exprs)) = do
|
||||||
inProcedure <- withinProcedureM
|
inProcedure <- withinProcedureM
|
||||||
if inProcedure
|
if inProcedure
|
||||||
then return $ Variable d t x [] expr
|
then return $ Variable d t x [] expr
|
||||||
|
|
@ -40,7 +40,7 @@ traverseDeclM (Variable d t x [] (expr @ (Stream StreamL chunk exprs))) = do
|
||||||
expr' = Call (Ident fnName) (Args [Concat exprs] [])
|
expr' = Call (Ident fnName) (Args [Concat exprs] [])
|
||||||
traverseDeclM (Variable d t x a expr) =
|
traverseDeclM (Variable d t x a expr) =
|
||||||
traverseExprM expr >>= return . Variable d t x a
|
traverseExprM expr >>= return . Variable d t x a
|
||||||
traverseDeclM decl @ Net{} = traverseNetAsVarM traverseDeclM decl
|
traverseDeclM decl@Net{} = traverseNetAsVarM traverseDeclM decl
|
||||||
traverseDeclM decl = return decl
|
traverseDeclM decl = return decl
|
||||||
|
|
||||||
traverseModuleItemM :: ModuleItem -> Scoper () ModuleItem
|
traverseModuleItemM :: ModuleItem -> Scoper () ModuleItem
|
||||||
|
|
|
||||||
|
|
@ -72,7 +72,7 @@ collectQueriedIdentsM _ _ = return ()
|
||||||
elaborateStringParam :: Idents -> ModuleItem -> ModuleItem
|
elaborateStringParam :: Idents -> ModuleItem -> ModuleItem
|
||||||
elaborateStringParam idents (MIAttr attr item) =
|
elaborateStringParam idents (MIAttr attr item) =
|
||||||
MIAttr attr $ elaborateStringParam idents item
|
MIAttr attr $ elaborateStringParam idents item
|
||||||
elaborateStringParam idents (orig @ (StringParam x str)) =
|
elaborateStringParam idents orig@(StringParam x str) =
|
||||||
if Set.member x idents
|
if Set.member x idents
|
||||||
then Generate $ map wrap [width, param]
|
then Generate $ map wrap [width, param]
|
||||||
else orig
|
else orig
|
||||||
|
|
@ -99,7 +99,7 @@ mapInstance partStringParams (Instance m params x rs ports) =
|
||||||
where
|
where
|
||||||
expand :: [Identifier] -> ParamBinding -> [ParamBinding]
|
expand :: [Identifier] -> ParamBinding -> [ParamBinding]
|
||||||
expand _ (paramName, Left t) = [(paramName, Left t)]
|
expand _ (paramName, Left t) = [(paramName, Left t)]
|
||||||
expand stringParams (orig @ (paramName, Right expr)) =
|
expand stringParams orig@(paramName, Right expr) =
|
||||||
if elem paramName stringParams
|
if elem paramName stringParams
|
||||||
then [(widthName paramName, Right width), orig]
|
then [(widthName paramName, Right width), orig]
|
||||||
else [orig]
|
else [orig]
|
||||||
|
|
|
||||||
|
|
@ -24,7 +24,7 @@ convert :: [AST] -> [AST]
|
||||||
convert = map $ traverseDescriptions convertDescription
|
convert = map $ traverseDescriptions convertDescription
|
||||||
|
|
||||||
convertDescription :: Description -> Description
|
convertDescription :: Description -> Description
|
||||||
convertDescription (description @ (Part _ _ Module _ _ _ _)) =
|
convertDescription description@(Part _ _ Module _ _ _ _) =
|
||||||
partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
|
partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
|
||||||
description
|
description
|
||||||
convertDescription other = other
|
convertDescription other = other
|
||||||
|
|
@ -103,7 +103,7 @@ convertType t1 =
|
||||||
|
|
||||||
-- write down the types of declarations
|
-- write down the types of declarations
|
||||||
traverseDeclM :: Decl -> Scoper Type Decl
|
traverseDeclM :: Decl -> Scoper Type Decl
|
||||||
traverseDeclM decl @ Net{} =
|
traverseDeclM decl@Net{} =
|
||||||
traverseNetAsVarM traverseDeclM decl
|
traverseNetAsVarM traverseDeclM decl
|
||||||
traverseDeclM decl = do
|
traverseDeclM decl = do
|
||||||
decl' <- case decl of
|
decl' <- case decl of
|
||||||
|
|
@ -196,7 +196,7 @@ convertExpr t (Mux c e1 e2) =
|
||||||
e1' = convertExpr t e1
|
e1' = convertExpr t e1
|
||||||
e2' = convertExpr t e2
|
e2' = convertExpr t e2
|
||||||
|
|
||||||
convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
|
convertExpr struct@(Struct _ fields []) (Pattern itemsOrig) =
|
||||||
if not (null extraNames) then
|
if not (null extraNames) then
|
||||||
error $ "pattern " ++ show (Pattern itemsOrig) ++
|
error $ "pattern " ++ show (Pattern itemsOrig) ++
|
||||||
" has extra named fields " ++ show extraNames ++
|
" has extra named fields " ++ show extraNames ++
|
||||||
|
|
@ -302,7 +302,7 @@ convertExpr (Implicit sg rs) expr =
|
||||||
|
|
||||||
-- TODO: This is a conversion for concat array literals with elements
|
-- TODO: This is a conversion for concat array literals with elements
|
||||||
-- that are unsized numbers. This probably belongs somewhere else.
|
-- that are unsized numbers. This probably belongs somewhere else.
|
||||||
convertExpr (t @ IntegerVector{}) (Concat exprs) =
|
convertExpr t@IntegerVector{} (Concat exprs) =
|
||||||
if all isUnsizedNumber exprs
|
if all isUnsizedNumber exprs
|
||||||
then Concat $ map (Cast $ Left t') exprs
|
then Concat $ map (Cast $ Left t') exprs
|
||||||
else Concat $ map (convertExpr t') exprs
|
else Concat $ map (convertExpr t') exprs
|
||||||
|
|
@ -317,7 +317,7 @@ convertExpr (t @ IntegerVector{}) (Concat exprs) =
|
||||||
|
|
||||||
-- TODO: This is really a conversion for using default patterns to
|
-- TODO: This is really a conversion for using default patterns to
|
||||||
-- populate arrays. Maybe this should be somewhere else?
|
-- populate arrays. Maybe this should be somewhere else?
|
||||||
convertExpr t (orig @ (Pattern [(Left UnknownType, expr)])) =
|
convertExpr t orig@(Pattern [(Left UnknownType, expr)]) =
|
||||||
if null rs
|
if null rs
|
||||||
then orig
|
then orig
|
||||||
else Repeat count [expr']
|
else Repeat count [expr']
|
||||||
|
|
|
||||||
|
|
@ -41,7 +41,7 @@ type ST = Scoper Type
|
||||||
|
|
||||||
-- insert the given declaration into the scope, and convert an TypeOfs within
|
-- insert the given declaration into the scope, and convert an TypeOfs within
|
||||||
traverseDeclM :: Decl -> ST Decl
|
traverseDeclM :: Decl -> ST Decl
|
||||||
traverseDeclM decl @ Net{} =
|
traverseDeclM decl@Net{} =
|
||||||
traverseNetAsVarM traverseDeclM decl
|
traverseNetAsVarM traverseDeclM decl
|
||||||
traverseDeclM decl = do
|
traverseDeclM decl = do
|
||||||
decl' <- traverseDeclNodesM traverseTypeM traverseExprM decl
|
decl' <- traverseDeclNodesM traverseTypeM traverseExprM decl
|
||||||
|
|
@ -98,7 +98,7 @@ traverseExprM (Cast (Left (Implicit sg [])) expr) =
|
||||||
traverseExprM (Cast (Left t) (Number (UnbasedUnsized bit))) =
|
traverseExprM (Cast (Left t) (Number (UnbasedUnsized bit))) =
|
||||||
-- defer until this expression becomes explicit
|
-- defer until this expression becomes explicit
|
||||||
return $ Cast (Left t) (Number (UnbasedUnsized bit))
|
return $ Cast (Left t) (Number (UnbasedUnsized bit))
|
||||||
traverseExprM (Cast (Left (t @ (IntegerAtom TInteger _))) expr) =
|
traverseExprM (Cast (Left t@(IntegerAtom TInteger _)) expr) =
|
||||||
-- convert to cast to an integer vector type
|
-- convert to cast to an integer vector type
|
||||||
traverseExprM $ Cast (Left t') expr
|
traverseExprM $ Cast (Left t') expr
|
||||||
where
|
where
|
||||||
|
|
@ -189,14 +189,14 @@ typeof (Number n) =
|
||||||
size = numberBitLength n
|
size = numberBitLength n
|
||||||
sg = if numberIsSigned n then Signed else Unspecified
|
sg = if numberIsSigned n then Signed else Unspecified
|
||||||
typeof (Call (Ident x) args) = typeofCall x args
|
typeof (Call (Ident x) args) = typeofCall x args
|
||||||
typeof (orig @ (Bit e _)) = do
|
typeof orig@(Bit e _) = do
|
||||||
t <- typeof e
|
t <- typeof e
|
||||||
let t' = popRange t
|
let t' = popRange t
|
||||||
case t of
|
case t of
|
||||||
TypeOf{} -> lookupTypeOf orig
|
TypeOf{} -> lookupTypeOf orig
|
||||||
Alias{} -> return $ TypeOf orig
|
Alias{} -> return $ TypeOf orig
|
||||||
_ -> return $ typeSignednessOverride t' Unsigned t'
|
_ -> return $ typeSignednessOverride t' Unsigned t'
|
||||||
typeof (orig @ (Range e NonIndexed r)) = do
|
typeof orig@(Range e NonIndexed r) = do
|
||||||
t <- typeof e
|
t <- typeof e
|
||||||
let t' = replaceRange r t
|
let t' = replaceRange r t
|
||||||
return $ case t of
|
return $ case t of
|
||||||
|
|
@ -217,7 +217,7 @@ typeof (Range expr mode (base, len)) =
|
||||||
if mode == IndexedPlus
|
if mode == IndexedPlus
|
||||||
then BinOp Sub (BinOp Add base len) (RawNum 1)
|
then BinOp Sub (BinOp Add base len) (RawNum 1)
|
||||||
else BinOp Add (BinOp Sub base len) (RawNum 1)
|
else BinOp Add (BinOp Sub base len) (RawNum 1)
|
||||||
typeof (orig @ (Dot e x)) = do
|
typeof orig@(Dot e x) = do
|
||||||
t <- typeof e
|
t <- typeof e
|
||||||
case t of
|
case t of
|
||||||
Struct _ fields [] -> return $ fieldsType fields
|
Struct _ fields [] -> return $ fieldsType fields
|
||||||
|
|
@ -404,7 +404,7 @@ typeCastUnneeded t1 t2 =
|
||||||
sz2 = typeSize t2
|
sz2 = typeSize t2
|
||||||
typeSize :: Type -> Maybe Expr
|
typeSize :: Type -> Maybe Expr
|
||||||
typeSize (IntegerVector _ _ rs) = Just $ dimensionsSize rs
|
typeSize (IntegerVector _ _ rs) = Just $ dimensionsSize rs
|
||||||
typeSize (t @ IntegerAtom{}) =
|
typeSize t@IntegerAtom{} =
|
||||||
typeSize $ tf [(RawNum 1, RawNum 1)]
|
typeSize $ tf [(RawNum 1, RawNum 1)]
|
||||||
where (tf, []) = typeRanges t
|
where (tf, []) = typeRanges t
|
||||||
typeSize _ = Nothing
|
typeSize _ = Nothing
|
||||||
|
|
|
||||||
|
|
@ -207,7 +207,7 @@ convertExpr _ (Cast te e) =
|
||||||
Cast te $ convertExpr SelfDetermined e
|
Cast te $ convertExpr SelfDetermined e
|
||||||
convertExpr _ (Concat exprs) =
|
convertExpr _ (Concat exprs) =
|
||||||
Concat $ map (convertExpr SelfDetermined) exprs
|
Concat $ map (convertExpr SelfDetermined) exprs
|
||||||
convertExpr context (Pattern [(Left UnknownType, e @ UU{})]) =
|
convertExpr context (Pattern [(Left UnknownType, e@UU{})]) =
|
||||||
convertExpr context e
|
convertExpr context e
|
||||||
convertExpr _ (Pattern items) =
|
convertExpr _ (Pattern items) =
|
||||||
Pattern $ zip
|
Pattern $ zip
|
||||||
|
|
@ -218,7 +218,7 @@ convertExpr _ (Call expr (Args pnArgs [])) =
|
||||||
where pnArgs' = map (convertExpr SelfDetermined) pnArgs
|
where pnArgs' = map (convertExpr SelfDetermined) pnArgs
|
||||||
convertExpr _ (Repeat count exprs) =
|
convertExpr _ (Repeat count exprs) =
|
||||||
Repeat count $ map (convertExpr SelfDetermined) exprs
|
Repeat count $ map (convertExpr SelfDetermined) exprs
|
||||||
convertExpr SelfDetermined (Mux cond (e1 @ UU{}) (e2 @ UU{})) =
|
convertExpr SelfDetermined (Mux cond e1@UU{} e2@UU{}) =
|
||||||
Mux
|
Mux
|
||||||
(convertExpr SelfDetermined cond)
|
(convertExpr SelfDetermined cond)
|
||||||
(convertExpr SelfDetermined e1)
|
(convertExpr SelfDetermined e1)
|
||||||
|
|
|
||||||
|
|
@ -31,10 +31,10 @@ initialState :: Info
|
||||||
initialState = ([], 1)
|
initialState = ([], 1)
|
||||||
|
|
||||||
traverseModuleItemM :: ModuleItem -> S ModuleItem
|
traverseModuleItemM :: ModuleItem -> S ModuleItem
|
||||||
traverseModuleItemM (item @ (Genvar x)) = declaration x item
|
traverseModuleItemM item@(Genvar x) = declaration x item
|
||||||
traverseModuleItemM (item @ (NInputGate _ _ x _ _)) = declaration x item
|
traverseModuleItemM item@(NInputGate _ _ x _ _) = declaration x item
|
||||||
traverseModuleItemM (item @ (NOutputGate _ _ x _ _)) = declaration x item
|
traverseModuleItemM item@(NOutputGate _ _ x _ _) = declaration x item
|
||||||
traverseModuleItemM (item @ (Instance _ _ x _ _)) = declaration x item
|
traverseModuleItemM item@(Instance _ _ x _ _) = declaration x item
|
||||||
traverseModuleItemM (MIPackageItem (Decl decl)) =
|
traverseModuleItemM (MIPackageItem (Decl decl)) =
|
||||||
traverseDeclM decl >>= return . MIPackageItem . Decl
|
traverseDeclM decl >>= return . MIPackageItem . Decl
|
||||||
traverseModuleItemM (MIAttr attr item) =
|
traverseModuleItemM (MIAttr attr item) =
|
||||||
|
|
@ -56,10 +56,10 @@ traverseDeclM decl =
|
||||||
-- label the generate blocks within an individual generate item which is already
|
-- label the generate blocks within an individual generate item which is already
|
||||||
-- in a list of generate items (top level or generate block)
|
-- in a list of generate items (top level or generate block)
|
||||||
traverseGenItemM :: GenItem -> S GenItem
|
traverseGenItemM :: GenItem -> S GenItem
|
||||||
traverseGenItemM (item @ GenIf{}) = do
|
traverseGenItemM item@GenIf{} = do
|
||||||
item' <- labelGenElse item
|
item' <- labelGenElse item
|
||||||
incrCount >> return item'
|
incrCount >> return item'
|
||||||
traverseGenItemM (item @ GenBlock{}) = do
|
traverseGenItemM item@GenBlock{} = do
|
||||||
item' <- labelBlock item
|
item' <- labelBlock item
|
||||||
incrCount >> return item'
|
incrCount >> return item'
|
||||||
traverseGenItemM (GenFor a b c item) = do
|
traverseGenItemM (GenFor a b c item) = do
|
||||||
|
|
|
||||||
|
|
@ -91,11 +91,11 @@ instance Show Expr where
|
||||||
showPatternItem (Left t, v) = printf "%s: %s" tStr (show v)
|
showPatternItem (Left t, v) = printf "%s: %s" tStr (show v)
|
||||||
where tStr = if null (show t) then "default" else show t
|
where tStr = if null (show t) then "default" else show t
|
||||||
show (MinTypMax a b c) = printf "(%s : %s : %s)" (show a) (show b) (show c)
|
show (MinTypMax a b c) = printf "(%s : %s : %s)" (show a) (show b) (show c)
|
||||||
show (e @ UniOp{}) = showsPrec 0 e ""
|
show e@UniOp{} = showsPrec 0 e ""
|
||||||
show (e @ BinOp{}) = showsPrec 0 e ""
|
show e@BinOp{} = showsPrec 0 e ""
|
||||||
show (e @ Dot {}) = showsPrec 0 e ""
|
show e@Dot {} = showsPrec 0 e ""
|
||||||
show (e @ Mux {}) = showsPrec 0 e ""
|
show e@Mux {} = showsPrec 0 e ""
|
||||||
show (e @ Call {}) = showsPrec 0 e ""
|
show e@Call {} = showsPrec 0 e ""
|
||||||
|
|
||||||
showsPrec _ (UniOp o e ) =
|
showsPrec _ (UniOp o e ) =
|
||||||
shows o .
|
shows o .
|
||||||
|
|
@ -185,12 +185,12 @@ showRange :: Range -> String
|
||||||
showRange (h, l) = '[' : show h ++ ':' : show l ++ "]"
|
showRange (h, l) = '[' : show h ++ ':' : show l ++ "]"
|
||||||
|
|
||||||
showUniOpPrec :: Expr -> ShowS
|
showUniOpPrec :: Expr -> ShowS
|
||||||
showUniOpPrec (e @ UniOp{}) = (showParen True . shows) e
|
showUniOpPrec e@UniOp{} = (showParen True . shows) e
|
||||||
showUniOpPrec (e @ BinOp{}) = (showParen True . shows) e
|
showUniOpPrec e@BinOp{} = (showParen True . shows) e
|
||||||
showUniOpPrec e = shows e
|
showUniOpPrec e = shows e
|
||||||
|
|
||||||
showBinOpPrec :: Expr -> ShowS
|
showBinOpPrec :: Expr -> ShowS
|
||||||
showBinOpPrec (e @ BinOp{}) = (showParen True . shows) e
|
showBinOpPrec e@BinOp{} = (showParen True . shows) e
|
||||||
showBinOpPrec e = shows e
|
showBinOpPrec e = shows e
|
||||||
|
|
||||||
type ParamBinding = (Identifier, TypeOrExpr)
|
type ParamBinding = (Identifier, TypeOrExpr)
|
||||||
|
|
|
||||||
|
|
@ -449,7 +449,7 @@ chunk base n0 =
|
||||||
|
|
||||||
-- number concatenation
|
-- number concatenation
|
||||||
instance Semigroup Number where
|
instance Semigroup Number where
|
||||||
(n1 @ Based{}) <> (n2 @ Based{}) =
|
n1@Based{} <> n2@Based{} =
|
||||||
Based size signed base values kinds
|
Based size signed base values kinds
|
||||||
where
|
where
|
||||||
size = size1 + size2
|
size = size1 + size2
|
||||||
|
|
@ -465,7 +465,7 @@ instance Semigroup Number where
|
||||||
n1 <> n2 =
|
n1 <> n2 =
|
||||||
toBased n1 <> toBased n2
|
toBased n1 <> toBased n2
|
||||||
where
|
where
|
||||||
toBased (n @ Based{}) = n
|
toBased n@Based{} = n
|
||||||
toBased (Decimal size signed num) =
|
toBased (Decimal size signed num) =
|
||||||
Based size signed Hex num 0
|
Based size signed Hex num 0
|
||||||
toBased (UnbasedUnsized bit) =
|
toBased (UnbasedUnsized bit) =
|
||||||
|
|
|
||||||
|
|
@ -104,9 +104,9 @@ showAssign :: (LHS, AsgnOp, Expr) -> String
|
||||||
showAssign (l, op, e) = (showPad l) ++ (showPad op) ++ (show e)
|
showAssign (l, op, e) = (showPad l) ++ (showPad op) ++ (show e)
|
||||||
|
|
||||||
showBranch :: Stmt -> String
|
showBranch :: Stmt -> String
|
||||||
showBranch (Block Seq "" [] (stmts @ [CommentStmt{}, _])) =
|
showBranch (Block Seq "" [] stmts@[CommentStmt{}, _]) =
|
||||||
'\n' : (indent $ show stmts)
|
'\n' : (indent $ show stmts)
|
||||||
showBranch (block @ Block{}) = ' ' : show block
|
showBranch block@Block{} = ' ' : show block
|
||||||
showBranch stmt = '\n' : (indent $ show stmt)
|
showBranch stmt = '\n' : (indent $ show stmt)
|
||||||
|
|
||||||
showBlockedBranch :: Stmt -> String
|
showBlockedBranch :: Stmt -> String
|
||||||
|
|
@ -129,11 +129,11 @@ showBlockedBranch stmt =
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
showElseBranch :: Stmt -> String
|
showElseBranch :: Stmt -> String
|
||||||
showElseBranch (stmt @ If{}) = ' ' : show stmt
|
showElseBranch stmt@If{} = ' ' : show stmt
|
||||||
showElseBranch stmt = showBranch stmt
|
showElseBranch stmt = showBranch stmt
|
||||||
|
|
||||||
showShortBranch :: Stmt -> String
|
showShortBranch :: Stmt -> String
|
||||||
showShortBranch (stmt @ Asgn{}) = ' ' : show stmt
|
showShortBranch stmt@Asgn{} = ' ' : show stmt
|
||||||
showShortBranch stmt = showBranch stmt
|
showShortBranch stmt = showBranch stmt
|
||||||
|
|
||||||
showCase :: Case -> String
|
showCase :: Case -> String
|
||||||
|
|
|
||||||
|
|
@ -1578,7 +1578,7 @@ caseInsideKW tok kw =
|
||||||
parseError (tokenPosition tok) $ "cannot use inside with " ++ show kw
|
parseError (tokenPosition tok) $ "cannot use inside with " ++ show kw
|
||||||
|
|
||||||
addMIAttr :: Attr -> ModuleItem -> ModuleItem
|
addMIAttr :: Attr -> ModuleItem -> ModuleItem
|
||||||
addMIAttr _ (item @ (MIPackageItem (Decl CommentDecl{}))) = item
|
addMIAttr _ item@(MIPackageItem (Decl CommentDecl{})) = item
|
||||||
addMIAttr attr item = MIAttr attr item
|
addMIAttr attr item = MIAttr attr item
|
||||||
|
|
||||||
missingToken :: String -> ParseState a
|
missingToken :: String -> ParseState a
|
||||||
|
|
@ -1646,15 +1646,15 @@ makeTypeOf (Token _ _ pos) expr = (pos, check)
|
||||||
check sg [] = unexpectedSigning pos sg (show typ)
|
check sg [] = unexpectedSigning pos sg (show typ)
|
||||||
|
|
||||||
addMITrace :: ModuleItem -> [ModuleItem] -> [ModuleItem]
|
addMITrace :: ModuleItem -> [ModuleItem] -> [ModuleItem]
|
||||||
addMITrace _ items @ (MIPackageItem (Decl CommentDecl{}) : _) = items
|
addMITrace _ items@(MIPackageItem (Decl CommentDecl{}) : _) = items
|
||||||
addMITrace trace items = trace : items
|
addMITrace trace items = trace : items
|
||||||
|
|
||||||
addPITrace :: PackageItem -> [PackageItem] -> [PackageItem]
|
addPITrace :: PackageItem -> [PackageItem] -> [PackageItem]
|
||||||
addPITrace _ items @ (Decl CommentDecl{} : _) = items
|
addPITrace _ items@(Decl CommentDecl{} : _) = items
|
||||||
addPITrace trace items = trace : items
|
addPITrace trace items = trace : items
|
||||||
|
|
||||||
addCITrace :: ClassItem -> [ClassItem] -> [ClassItem]
|
addCITrace :: ClassItem -> [ClassItem] -> [ClassItem]
|
||||||
addCITrace _ items @ ((_, Decl CommentDecl{}) : _) = items
|
addCITrace _ items@((_, Decl CommentDecl{}) : _) = items
|
||||||
addCITrace trace items = trace : items
|
addCITrace trace items = trace : items
|
||||||
|
|
||||||
makeFor :: Either [Decl] [(LHS, Expr)] -> Expr -> [(LHS, AsgnOp, Expr)] -> Stmt -> Stmt
|
makeFor :: Either [Decl] [(LHS, Expr)] -> Expr -> [(LHS, AsgnOp, Expr)] -> Stmt -> Stmt
|
||||||
|
|
|
||||||
|
|
@ -82,7 +82,7 @@ parseDTsAsPortDecls = parseDTsAsPortDecls' . dropTrailingComma
|
||||||
where
|
where
|
||||||
dropTrailingComma :: [DeclToken] -> [DeclToken]
|
dropTrailingComma :: [DeclToken] -> [DeclToken]
|
||||||
dropTrailingComma [] = []
|
dropTrailingComma [] = []
|
||||||
dropTrailingComma [DTComma{}, end @ DTEnd{}] = [end]
|
dropTrailingComma [DTComma{}, end@DTEnd{}] = [end]
|
||||||
dropTrailingComma (tok : toks) = tok : dropTrailingComma toks
|
dropTrailingComma (tok : toks) = tok : dropTrailingComma toks
|
||||||
|
|
||||||
-- internal parseDTsAsPortDecls after the removal of an optional trailing comma
|
-- internal parseDTsAsPortDecls after the removal of an optional trailing comma
|
||||||
|
|
@ -102,7 +102,7 @@ parseDTsAsPortDecls' pieces =
|
||||||
pieces' = filter (not . isAttr) pieces
|
pieces' = filter (not . isAttr) pieces
|
||||||
|
|
||||||
propagateDirections :: Direction -> [Decl] -> [Decl]
|
propagateDirections :: Direction -> [Decl] -> [Decl]
|
||||||
propagateDirections dir (decl @ (Variable _ InterfaceT{} _ _ _) : decls) =
|
propagateDirections dir (decl@(Variable _ InterfaceT{} _ _ _) : decls) =
|
||||||
decl : propagateDirections dir decls
|
decl : propagateDirections dir decls
|
||||||
propagateDirections lastDir (Variable currDir t x a e : decls) =
|
propagateDirections lastDir (Variable currDir t x a e : decls) =
|
||||||
decl : propagateDirections dir decls
|
decl : propagateDirections dir decls
|
||||||
|
|
@ -167,7 +167,7 @@ parseDTsAsModuleItems tokens =
|
||||||
-- internal; attempt to parse an elaboration system task
|
-- internal; attempt to parse an elaboration system task
|
||||||
asElabTask :: [DeclToken] -> Maybe ModuleItem
|
asElabTask :: [DeclToken] -> Maybe ModuleItem
|
||||||
asElabTask tokens = do
|
asElabTask tokens = do
|
||||||
DTIdent _ x @ ('$' : _) <- return $ head tokens
|
DTIdent _ x@('$' : _) <- return $ head tokens
|
||||||
severity <- lookup x elabTasks
|
severity <- lookup x elabTasks
|
||||||
Just $ ElabTask severity args
|
Just $ ElabTask severity args
|
||||||
where
|
where
|
||||||
|
|
@ -328,7 +328,7 @@ parseDTsAsAsgns tokens =
|
||||||
"unexpected " ++ surprise ++ " in for loop initialization"
|
"unexpected " ++ surprise ++ " in for loop initialization"
|
||||||
|
|
||||||
shiftIncOrDec :: [DeclToken] -> [DeclToken]
|
shiftIncOrDec :: [DeclToken] -> [DeclToken]
|
||||||
shiftIncOrDec (tok @ (DTAsgn _ AsgnOp{} _ _) : toks) =
|
shiftIncOrDec (tok@(DTAsgn _ AsgnOp{} _ _) : toks) =
|
||||||
before ++ tok : delim : shiftIncOrDec after
|
before ++ tok : delim : shiftIncOrDec after
|
||||||
where (before, delim : after) = break isCommaOrEnd toks
|
where (before, delim : after) = break isCommaOrEnd toks
|
||||||
shiftIncOrDec [] = []
|
shiftIncOrDec [] = []
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue