From 576a804d906bcc22033828c4a9ea17566fb089d9 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Sun, 15 Dec 2024 00:42:13 -0500 Subject: [PATCH] improve binding resolution error messages --- CHANGELOG.md | 1 + src/Convert/ResolveBindings.hs | 41 ++++++++++++++++----- test/error/binding_not_found_class.sv | 2 +- test/error/binding_not_found_overflow.sv | 2 +- test/error/binding_not_found_param.sv | 2 +- test/error/binding_not_found_port.sv | 2 +- test/error/binding_overflow_class.sv | 2 +- test/error/binding_overflow_param.sv | 2 +- test/error/binding_overflow_port.sv | 2 +- test/error/interface_param_mismatch_expr.sv | 2 +- test/error/interface_param_mismatch_type.sv | 2 +- test/error/module_param_mismatch_expr.sv | 2 +- test/error/module_param_mismatch_type.sv | 2 +- 13 files changed, 44 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3be4a1fd..e32c9d36 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -29,6 +29,7 @@ ### Other Enhancements +* Improved error messages for invalid port or parameter bindings * `--write path/to/dir/` can now also be used with `--pass-through` ## v0.0.12 diff --git a/src/Convert/ResolveBindings.hs b/src/Convert/ResolveBindings.hs index d95868c1..9ab84151 100644 --- a/src/Convert/ResolveBindings.hs +++ b/src/Convert/ResolveBindings.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} {- sv2v - Author: Zachary Snow - @@ -16,12 +17,14 @@ module Convert.ResolveBindings import Control.Monad.Writer.Strict import Data.List (intercalate, (\\)) +import Data.Maybe (isNothing) import qualified Data.Map.Strict as Map import Convert.Traverse import Language.SystemVerilog.AST -type Parts = Map.Map Identifier ([(Identifier, Bool)], [Identifier]) +data PartInfo = PartInfo PartKW [(Identifier, Bool)] [Identifier] +type Parts = Map.Map Identifier PartInfo convert :: [AST] -> [AST] convert = @@ -30,8 +33,8 @@ convert = (traverseDescriptions . traverseModuleItems . mapInstance) collectPartsM :: Description -> Writer Parts () -collectPartsM (Part _ _ _ _ name ports items) = - tell $ Map.singleton name (params, ports) +collectPartsM (Part _ _ kw _ name ports items) = + tell $ Map.singleton name $ PartInfo kw params ports where params = parameterInfos items collectPartsM _ = return () @@ -48,16 +51,17 @@ parameterInfos = mapInstance :: Parts -> ModuleItem -> ModuleItem mapInstance parts (Instance m paramBindings x rs portBindings) = -- if we can't find it, just skip :( - if maybePartInfo == Nothing + if isNothing maybePartInfo then Instance m paramBindings x rs portBindings else Instance m paramBindings' x rs portBindings' where maybePartInfo = Map.lookup m parts - Just (paramInfos, portNames) = maybePartInfo + Just (PartInfo kw paramInfos portNames) = maybePartInfo paramNames = map fst paramInfos msg :: String -> String - msg = flip (++) $ " in instance " ++ show x ++ " of " ++ show m + msg = flip (++) $ " in instance " ++ show x ++ " of " ++ show kw ++ " " + ++ show m paramBindings' = map checkParam $ resolveBindings (msg "parameter overrides") paramNames paramBindings @@ -101,22 +105,41 @@ mapInstance parts (Instance m paramBindings x rs portBindings) = mapInstance _ other = other +class BindingArg k where + showBinding :: k -> String + +instance BindingArg TypeOrExpr where + showBinding = either show show + +instance BindingArg Expr where + showBinding = show + type Binding t = (Identifier, t) -- give a set of bindings explicit names -resolveBindings :: String -> [Identifier] -> [Binding t] -> [Binding t] +resolveBindings + :: BindingArg t => String -> [Identifier] -> [Binding t] -> [Binding t] resolveBindings _ _ [] = [] resolveBindings location available bindings@(("", _) : _) = if length available < length bindings then - error $ "too many bindings specified for " ++ location + error $ "too many bindings specified for " ++ location ++ ": " + ++ describeList "specified" (map (showBinding . snd) bindings) + ++ ", but only " ++ describeList "available" (map show available) else zip available $ map snd bindings resolveBindings location available bindings = if not $ null unknowns then error $ "unknown binding" ++ unknownsPlural ++ " " - ++ unknownsStr ++ " specified for " ++ location + ++ unknownsStr ++ " specified for " ++ location ++ ", " + ++ describeList "available" (map show available) else bindings where unknowns = map fst bindings \\ available unknownsPlural = if length unknowns == 1 then "" else "s" unknownsStr = intercalate ", " $ map show unknowns + +describeList :: String -> [String] -> String +describeList desc [] = "0 " ++ desc +describeList desc xs = + show (length xs) ++ " " ++ desc ++ " (" ++ xsStr ++ ")" + where xsStr = intercalate ", " xs diff --git a/test/error/binding_not_found_class.sv b/test/error/binding_not_found_class.sv index c3e2379e..c8977b01 100644 --- a/test/error/binding_not_found_class.sv +++ b/test/error/binding_not_found_class.sv @@ -1,4 +1,4 @@ -// pattern: unknown binding "R" specified for parameters in class specialization of "example" +// pattern: unknown binding "R" specified for parameters in class specialization of "example", 2 available \("P", "Q"\) class example #( parameter P = 1, parameter Q = 1 diff --git a/test/error/binding_not_found_overflow.sv b/test/error/binding_not_found_overflow.sv index 5eb8f5cd..a8405821 100644 --- a/test/error/binding_not_found_overflow.sv +++ b/test/error/binding_not_found_overflow.sv @@ -1,4 +1,4 @@ -// pattern: unknown binding "z" specified for port connections in instance "e" of "example" +// pattern: unknown binding "z" specified for port connections in instance "e" of module "example", 2 available \("x", "y"\) module example( input x, y ); diff --git a/test/error/binding_not_found_param.sv b/test/error/binding_not_found_param.sv index 6fd2c472..bd9d9fce 100644 --- a/test/error/binding_not_found_param.sv +++ b/test/error/binding_not_found_param.sv @@ -1,4 +1,4 @@ -// pattern: unknown binding "R" specified for parameter overrides in instance "e" of "example" +// pattern: unknown binding "R" specified for parameter overrides in instance "e" of module "example", 2 available \("P", "Q"\) module example; parameter P = 1; parameter Q = 1; diff --git a/test/error/binding_not_found_port.sv b/test/error/binding_not_found_port.sv index 0110a0ee..ea95fdd9 100644 --- a/test/error/binding_not_found_port.sv +++ b/test/error/binding_not_found_port.sv @@ -1,4 +1,4 @@ -// pattern: unknown bindings "w", "z" specified for port connections in instance "e" of "example" +// pattern: unknown bindings "w", "z" specified for port connections in instance "e" of module "example", 2 available \("x", "y"\) module example( input x, y ); diff --git a/test/error/binding_overflow_class.sv b/test/error/binding_overflow_class.sv index 33575443..d2508647 100644 --- a/test/error/binding_overflow_class.sv +++ b/test/error/binding_overflow_class.sv @@ -1,4 +1,4 @@ -// pattern: too many bindings specified for parameters in class specialization of "example" +// pattern: too many bindings specified for parameters in class specialization of "example": 3 specified \(1, 2, 3\), but only 2 available \("P", "Q"\) class example #( parameter P = 1, parameter Q = 1 diff --git a/test/error/binding_overflow_param.sv b/test/error/binding_overflow_param.sv index 4279e2e3..b64377f1 100644 --- a/test/error/binding_overflow_param.sv +++ b/test/error/binding_overflow_param.sv @@ -1,4 +1,4 @@ -// pattern: too many bindings specified for parameter overrides in instance "e" of "example" +// pattern: too many bindings specified for parameter overrides in instance "e" of module "example": 3 specified \(1, 2, 3\), but only 2 available \("P", "Q"\) module example; parameter P = 1; parameter Q = 1; diff --git a/test/error/binding_overflow_port.sv b/test/error/binding_overflow_port.sv index 68d24d8b..e33b5269 100644 --- a/test/error/binding_overflow_port.sv +++ b/test/error/binding_overflow_port.sv @@ -1,4 +1,4 @@ -// pattern: too many bindings specified for port connections in instance "e" of "example" +// pattern: too many bindings specified for port connections in instance "e" of module "example": 3 specified \(1'b1, 1'b0, 1'b0\), but only 2 available \("x", "y"\) module example( input x, y ); diff --git a/test/error/interface_param_mismatch_expr.sv b/test/error/interface_param_mismatch_expr.sv index 663b1fa1..faa336a3 100644 --- a/test/error/interface_param_mismatch_expr.sv +++ b/test/error/interface_param_mismatch_expr.sv @@ -1,4 +1,4 @@ -// pattern: parameter "P" in instance "intf" of "Interface" expects an expression, but was given type logic +// pattern: parameter "P" in instance "intf" of interface "Interface" expects an expression, but was given type logic interface Interface; parameter P = 0; logic [P-1:0] x; diff --git a/test/error/interface_param_mismatch_type.sv b/test/error/interface_param_mismatch_type.sv index 07da7f26..9b5f1aea 100644 --- a/test/error/interface_param_mismatch_type.sv +++ b/test/error/interface_param_mismatch_type.sv @@ -1,4 +1,4 @@ -// pattern: parameter "P" in instance "intf" of "Interface" expects a type, but was given expression 1 +// pattern: parameter "P" in instance "intf" of interface "Interface" expects a type, but was given expression 1 interface Interface; parameter type P; P x; diff --git a/test/error/module_param_mismatch_expr.sv b/test/error/module_param_mismatch_expr.sv index 2f1c0b41..4cf4723a 100644 --- a/test/error/module_param_mismatch_expr.sv +++ b/test/error/module_param_mismatch_expr.sv @@ -1,4 +1,4 @@ -// pattern: parameter "P" in instance "mod" of "Module" expects an expression, but was given type logic +// pattern: parameter "P" in instance "mod" of module "Module" expects an expression, but was given type logic module Module; parameter P = 0; logic [P-1:0] x; diff --git a/test/error/module_param_mismatch_type.sv b/test/error/module_param_mismatch_type.sv index 4866c590..40ff9017 100644 --- a/test/error/module_param_mismatch_type.sv +++ b/test/error/module_param_mismatch_type.sv @@ -1,4 +1,4 @@ -// pattern: parameter "P" in instance "mod" of "Module" expects a type, but was given expression 1 +// pattern: parameter "P" in instance "mod" of module "Module" expects a type, but was given expression 1 module Module; parameter type P; P x;