Commit 30acc3e3 by Zachary Snow

fix spacing of as-patterns for future GHC upgrade

parent 536eba46
...@@ -42,7 +42,7 @@ convertStmt (Block Seq name decls stmts) = ...@@ -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)) = ...@@ -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] ...@@ -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)]) = ...@@ -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 ...@@ -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] ...@@ -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) = ...@@ -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 ...@@ -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 ...@@ -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) = ...@@ -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) = ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 = ...@@ -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) = ...@@ -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] ...@@ -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 ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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) = ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 = ...@@ -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 ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 ...@@ -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 = ...@@ -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)) = ...@@ -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 ...@@ -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 () ...@@ -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) = ...@@ -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] ...@@ -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 = ...@@ -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) = ...@@ -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 = ...@@ -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) = ...@@ -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 ...@@ -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) = ...@@ -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) = ...@@ -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)) = ...@@ -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 = ...@@ -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) = ...@@ -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 [])) = ...@@ -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 ...@@ -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 = ...@@ -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 ...@@ -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 ...@@ -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 = ...@@ -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 ...@@ -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 ...@@ -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 = ...@@ -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 = ...@@ -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) ...@@ -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 ...@@ -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 = ...@@ -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 = ...@@ -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 = ...@@ -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 [] = []
......
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