diff --git a/doc/libraries_ref_guide/LibDoc/Prelude.tex b/doc/libraries_ref_guide/LibDoc/Prelude.tex index 4eff2aae5..e8af76ec1 100644 --- a/doc/libraries_ref_guide/LibDoc/Prelude.tex +++ b/doc/libraries_ref_guide/LibDoc/Prelude.tex @@ -3531,6 +3531,86 @@ \subsubsection{Tuples} \end{tabular} \end{center} +\te{TupleSize} provides a way to determine the number of elements in a tuple +at the type level. The size is represented as a numeric type parameter. + +\index{TupleSize@\te{TupleSize} (type class)} +\index[typeclass]{TupleSize} + +\begin{libverbatim} + typeclass TupleSize #(type a, numeric type n) + dependencies (a determines n); + endtypeclass +\end{libverbatim} + +The type class has instances for unit type \te{void} with size 0, and for all +tuple types with their respective sizes. The numeric type \te{n} represents +the number of elements in the tuple. + +\begin{center} +\begin{tabular}{|p{1.5 in}|p{3.8 in}|} +\hline +\multicolumn{2}{|c|}{\te{TupleSize} Instances}\\ +\hline +\hline +\te{TupleSize \#(void, 0)}&The unit type has size 0.\\ +\hline +\te{TupleSize \#(a, 1)}&A single element (non-tuple) has size 1.\\ +\hline +\te{TupleSize \#((a, b), 2)}&A 2-tuple has size 2.\\ +\hline +\te{TupleSize \#((a,b,c), 3)}&A 3-tuple has size 3.\\ +\hline +\te{...}&Instances exist for all tuple sizes.\\ +\hline +\end{tabular} +\end{center} + +\te{AppendTuple} provides a way to join two tuples of arbitrary size into a single larger +tuple, and to split a tuple back into two parts. + +\index{AppendTuple@\te{AppendTuple} (type class)} +\index{appendTuple@\texttt{appendTuple} (\texttt{AppendTuple} type class function)} +\index{splitTuple@\texttt{splitTuple} (\texttt{AppendTuple} type class function)} +\index[function]{Prelude!appendTuple} +\index[function]{Prelude!splitTuple} +\index[typeclass]{AppendTuple} + +\begin{libverbatim} + typeclass AppendTuple #(type a, type b, type c) + dependencies ((a, b) determines c); + function c appendTuple(a x, b y); + function Tuple2#(a, b) splitTuple(c x); + endtypeclass +\end{libverbatim} + +The type class has instances for various tuple combinations, including special +handling for unit type \te{void}. + +\begin{center} +\begin{tabular}{|p{1.5 in}|p{3.8 in}|} +\hline +\multicolumn{2}{|c|}{\te{AppendTuple} Functions}\\ +\hline +\hline +\te{appendTuple}&Concatenates two tuples \te{x} and \te{y} into a single +larger tuple. The elements from \te{x} appear first, followed by the elements +from \te{y}.\\ +\cline{2-2} +&\\ +& \te{function c appendTuple(a x, b y);}\\ +&\\ +\hline +\te{splitTuple}&Splits a tuple \te{x} into two parts. Returns a 2-tuple +containing the first part of type \te{a} and the second part of type \te{b}.\\ +\cline{2-2} +&\\ +& \te{function Tuple2\#(a, b) splitTuple(c x);}\\ +&\\ +\hline +\end{tabular} +\end{center} + {\bf Examples} \begin{verbatim} @@ -3538,8 +3618,28 @@ \subsubsection{Tuples} Bool field1 = tpl_1( foo ); // this is value 1 in the list int field2 = tpl_2( foo ); // this is value 2 in the list foo = tuple2( !field1, field2 ); + + // Appending a 2-tuple and a 3-tuple to create a 5-tuple + Tuple2#(Bool, Int#(8)) t1 = tuple2(True, 42); + Tuple3#(String, Bit#(4), UInt#(16)) t2 = tuple3("test", 4'hA, 100); + + Tuple5#(Bool, Int#(8), String, Bit#(4), UInt#(16)) t3 = + appendTuple(t1, t2); + + // Splitting a 4-tuple into a 2-tuple and a 2-tuple + Tuple4#(Bool, Int#(8), String, Bit#(4)) t4 = + tuple4(True, 42, "test", 4'hA); + + Tuple2#(Tuple2#(Bool, Int#(8)), Tuple2#(String, Bit#(4))) parts = + splitTuple(t4); + + // Appending with unit type (void) + Tuple2#(Bool, Int#(8)) t5 = tuple2(False, 0); + Tuple2#(Bool, Int#(8)) t6 = appendTuple(t5, ?); // same as t5 + Tuple2#(Bool, Int#(8)) t7 = appendTuple(?, t5); // same as t5 \end{verbatim} + % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \com{Array} \subsubsection{Array} @@ -6211,16 +6311,62 @@ \subsubsection{Operations on Functions} \end{tabular} \end{center} +\index{Curry@\te{Curry} (type class)} +\index[typeclass]{Curry} +\index{curryN@\te{curryN} (function)} +\index[function]{Prelude!curryN} +\index{uncurryN@\te{uncurryN} (function)} +\index[function]{Prelude!uncurryN} + +The \te{Curry} typeclass generalizes the \te{curry} and \te{uncurry} functions +to work with tuples of any size (not just Tuple2). + +\begin{libverbatim} +typeclass Curry#(type f, type g) + dependencies (f determines g); + function g curryN(f x); + function f uncurryN(g x); +endtypeclass +\end{libverbatim} + +\begin{center} +\begin{tabular}{|p{1 in}|p{4 in}|} +\hline +\te{curryN}&Converts an uncurried function (taking an N-tuple argument) into a curried +function (taking N arguments one at a time). For example, \te{curryN} can convert a +function taking \te{Tuple3\#(a,b,c)} into a function \te{a -> b -> c -> result}.\\ +\hline +\te{uncurryN}&The inverse of \te{curryN}. Converts a curried function (taking N arguments +one at a time) into an uncurried function (taking an N-tuple argument).\\ +\hline +\end{tabular} +\end{center} + {\bf Examples} \begin{libverbatim} - //using constFn to set the initial values of the registers in a list + // Using constFn to set the initial values of the registers in a list List#(Reg#(Resource)) items <- mapM( constFn(mkReg(initRes)),upto(1,numAdd) ); + // Using compose when mapping over a list return(pack(map(compose(head0,toList),state))); - xs <- mapM(constFn(mkReg(False)),genList); + // Using curryN with a 3-tuple + function Int#(32) add3Tuple(Tuple3#(Int#(32), Int#(32), Int#(32)) t); + return tpl_1(t) + tpl_2(t) + tpl_3(t); + endfunction + + let add3Curried = curryN(add3Tuple); + Int#(32) result = add3Curried(1)(2)(3); // result = 6 + + // Using uncurryN + function Int#(32) add3(Int#(32) a, Int#(32) b, Int#(32) c); + return a + b + c; + endfunction + + let add3Uncurried = uncurryN(add3); + Int#(32) result2 = add3Uncurried(tuple3(1, 2, 3)); // result2 = 6 \end{libverbatim} diff --git a/doc/libraries_ref_guide/LibDoc/Vector.tex b/doc/libraries_ref_guide/LibDoc/Vector.tex index c26e8ce81..38138516e 100644 --- a/doc/libraries_ref_guide/LibDoc/Vector.tex +++ b/doc/libraries_ref_guide/LibDoc/Vector.tex @@ -2289,8 +2289,62 @@ \subsubsection{Converting to and from Vectors} \hline \end{tabular} +The \te{ConcatTuple} type class provides functions to convert between a Vector +of tuples and a single flattened tuple. When you have a Vector where each +element is a tuple (or can be viewed as a tuple), \te{concatTuple} flattens +all the elements into one large tuple by concatenating them together. The +reverse operation, \te{unconcatTuple}, splits a large tuple back into a Vector +of smaller tuples. + +\index{ConcatTuple@\te{ConcatTuple} (type class)} +\index{concatTuple@\texttt{concatTuple} (\texttt{ConcatTuple} type class function)} +\index{unconcatTuple@\texttt{unconcatTuple} (\texttt{ConcatTuple} type class function)} +\index[function]{Vector!concatTuple} +\index[function]{Vector!unconcatTuple} +\index[typeclass]{ConcatTuple} -{\bf Example - Converting to and from Vectors} +\begin{libverbatim} + typeclass ConcatTuple #(numeric type n, type a, type b) + dependencies ((n, a) determines b); + function b concatTuple(Vector#(n, a) v); + function Vector#(n, a) unconcatTuple(b x); + endtypeclass +\end{libverbatim} + +The type class has instances for various vector sizes: +\begin{itemize} +\item A vector of size 0 converts to/from the unit type \te{void} +\item A vector of size 1 converts to/from a single element +\item Larger vectors convert by appending each element tuple to +form a larger tuple +\end{itemize} + +\begin{tabular}{|p{1.2 in}|p{4.4 in}|} +\hline +\multicolumn{2}{|c|}{\te{ConcatTuple} Functions}\\ +\hline +\hline +&\\ \te{concatTuple} & Flattens a Vector of tuples into a single large tuple +by concatenating all the tuple elements together. Each element of the vector +is appended sequentially to form the result tuple.\\ +& \\ \cline{2-2} +&\begin{libverbatim} +function b concatTuple(Vector#(n, a) v); +\end{libverbatim} +\\ +\hline +&\\ \te{unconcatTuple}&Splits a large tuple into a Vector of smaller tuples. +This is the inverse of \te{concatTuple}, distributing the tuple elements across +a Vector of the specified size.\\ +& \\ \cline{2-2} +&\begin{libverbatim} +function Vector#(n, a) unconcatTuple(b x); +\end{libverbatim} +\\ +\hline +\end{tabular} + +{\bf Examples - Lists} Convert the vector \te{my\_vector} to a list named \te{my\_list}. \begin{libverbatim} @@ -2298,6 +2352,61 @@ \subsubsection{Converting to and from Vectors} List#(Int#(13)) my_list = toList(my_vector); \end{libverbatim} +{\bf Examples - Tuples} + +Flatten a vector of 3 pairs (2-tuples) into a single 6-tuple: +\begin{libverbatim} + // Create a vector of three 2-tuples + Vector#(3, Tuple2#(Bool, Int#(8))) vec_of_pairs = vec( + tuple2(True, 1), + tuple2(False, 2), + tuple2(True, 3) + ); + + // Flatten into a single 6-tuple + Tuple6#(Bool, Int#(8), Bool, Int#(8), Bool, Int#(8)) flat = + concatTuple(vec_of_pairs); + // Result: (True, 1, False, 2, True, 3) + + // Convert back to vector of pairs + Vector#(3, Tuple2#(Bool, Int#(8))) restored = unconcatTuple(flat); +\end{libverbatim} + +Flatten a vector of 4 single elements (which can be viewed as 1-tuples) into a 4-tuple: +\begin{libverbatim} + Vector#(4, Int#(8)) vec_ints = vec(10, 20, 30, 40); + + // Each Int#(8) is treated as a single element + Tuple4#(Int#(8), Int#(8), Int#(8), Int#(8)) tuple_ints = + concatTuple(vec_ints); + // Result: (10, 20, 30, 40) +\end{libverbatim} + +Flatten a vector of 2 triples (3-tuples) into a single 6-tuple: +\begin{libverbatim} + Vector#(2, Tuple3#(Bool, UInt#(4), String)) vec_triples = vec( + tuple3(True, 5, "hello"), + tuple3(False, 10, "world") + ); + + Tuple6#(Bool, UInt#(4), String, Bool, UInt#(4), String) result = + concatTuple(vec_triples); + // Result: (True, 5, "hello", False, 10, "world") +\end{libverbatim} + +Special cases: +\begin{libverbatim} + // Empty vector converts to unit type + Vector#(0, Tuple2#(Bool, Int#(8))) empty = nil; + void unit = concatTuple(empty); + + // Single element vector returns just that element + Vector#(1, Tuple2#(Bool, Int#(8))) single = + vec(tuple2(True, 42)); + Tuple2#(Bool, Int#(8)) pair = concatTuple(single); + // Result: (True, 42) +\end{libverbatim} + \subsubsection{ListN} diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index a21a278cf..7d6472321 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -95,7 +95,8 @@ package Prelude( primCharToString, primUIntBitsToInteger, primIntBitsToInteger, - ($), (∘), id, const, constFn, flip, while, curry, uncurry, asTypeOf, + ($), (∘), id, const, constFn, flip, while, + curry, uncurry, Curry(..), Curry', asTypeOf, liftM, liftM2, bindM, (<+>), rJoin, @@ -172,6 +173,7 @@ package Prelude( Tuple6, tuple6, Has_tpl_6(..), Tuple7, tuple7, Has_tpl_7(..), Tuple8, tuple8, Has_tpl_8(..), + AppendTuple(..), AppendTuple', AppendTuple'', TupleSize, TupleSize', -- lists required for desugaring List(..), @@ -255,7 +257,10 @@ package Prelude( Generic(..), Conc(..), ConcPrim(..), ConcPoly(..), Meta(..), MetaData(..), StarArg(..), NumArg(..), StrArg(..), NumConArg(..), StarConArg(..), OtherConArg(..), - MetaConsNamed(..), MetaConsAnon(..), MetaField(..) + MetaConsNamed(..), MetaConsAnon(..), MetaField(..), + + WrapField(..), WrapMethod(..), WrapPorts(..), + Port(..), unPort, SplitPorts(..) ) where infixr 0 $ @@ -2595,6 +2600,31 @@ curry f x y = f (x, y) uncurry :: (a -> b -> c) -> ((a, b) -> c) uncurry f (x, y) = f x y +-- Polymorphic, N-argument version of curry/uncurry +class Curry f g | f -> g where + curryN :: f -> g + uncurryN :: g -> f + +instance Curry (() -> a) a where + curryN f = f () + uncurryN f _ = f + +instance (Curry' f g) => Curry f g where + curryN = curryN' + uncurryN = uncurryN' + +class Curry' f g | f -> g where + curryN' :: f -> g + uncurryN' :: g -> f + +instance (Curry' (b -> c) d) => Curry' ((a, b) -> c) (a -> d) where + curryN' f x = curryN' $ \y -> f (x, y) + uncurryN' f (x, y) = uncurryN' (f x) y + +instance Curry' (a -> b) (a -> b) where + curryN' = id + uncurryN' = id + --@ Constant function --@ \index{const@\te{const} (Prelude function)} --@ \begin{libverbatim} @@ -3384,6 +3414,54 @@ tuple7 a b c d e f g = (a,b,c,d,e,f,g) tuple8 :: a -> b -> c -> d -> e -> f -> g -> h -> Tuple8 a b c d e f g h tuple8 a b c d e f g h = (a,b,c,d,e,f,g,h) +class AppendTuple a b c | a b -> c where + appendTuple :: a -> b -> c + splitTuple :: c -> (a, b) + +instance AppendTuple a () a where + appendTuple x _ = x + splitTuple x = (x, ()) + +-- The above instance should take precedence over the other cases that assume +-- b is non-unit. To avoid overlapping instances, the below are factored out as +-- a seperate type class: +instance (AppendTuple' a b c) => AppendTuple a b c where + appendTuple = appendTuple' + splitTuple = splitTuple' + +class AppendTuple' a b c | a b -> c where + appendTuple' :: a -> b -> c + splitTuple' :: c -> (a, b) + +instance AppendTuple' () a a where + appendTuple' _ = id + splitTuple' x = ((), x) + +instance (AppendTuple'' a b c) => AppendTuple' a b c where + appendTuple' = appendTuple'' + splitTuple' = splitTuple'' + +class AppendTuple'' a b c | a b -> c where + appendTuple'' :: a -> b -> c + splitTuple'' :: c -> (a, b) + +instance AppendTuple'' a b (a, b) where + appendTuple'' a b = (a, b) + splitTuple'' = id + +instance (AppendTuple'' a b c) => AppendTuple'' (h, a) b (h, c) where + appendTuple'' (x, y) z = (x, appendTuple'' y z) + splitTuple'' (x, y) = case splitTuple'' y of + (w, z) -> ((x, w), z) + +class TupleSize a n | a -> n where {} +instance TupleSize () 0 where {} +instance (TupleSize' a n) => TupleSize a n where {} + +class TupleSize' a n | a -> n where {} +instance TupleSize' a 1 where {} +instance (TupleSize' b (TSub n 1)) => TupleSize' (a, b) n where {} + -- FUNCTIONS TO REPLACE UNAVAILABLE INFIXES compose :: (b -> c) -> (a -> b) -> (a -> c) @@ -4386,3 +4464,232 @@ data (MetaConsAnon :: $ -> # -> # -> *) name idx nfields = MetaConsAnon -- field) and index in the constructor's fields data (MetaField :: $ -> # -> *) name idx = MetaField deriving (FShow) + + +-- Tag a method with metadata. +-- Currently just the list of input port names. +-- Should eventually include the output port names, when we support multiple output ports. +primitive primMethod :: List String -> a -> a + +-- Convert bewtween a field in an interface that is being synthesized, +-- and a field in the corresponding field in the generated wrapper interface. +-- Also takes the name of the field for error reporting purposes. +class (WrapField :: $ -> * -> * -> *) name f w | name f -> w where + -- Given a proxy value for the field name, and the values of the prefix and arg_names pragmas, + -- converts a synthesized interface field value to its wrapper interface field. + toWrapField :: StrArg name -> String -> List String -> f -> w + + -- Given a proxy value for the field name, converts a wrapper interface field value + -- to its synthesized interface field. + fromWrapField :: StrArg name -> w -> f + + -- Save the port types for a field in the wrapped interface, given the module name + -- and the prefix, arg_names and result pragmas. + saveFieldPortTypes :: StrArg name -> f -> Maybe Name__ -> String -> List String -> String -> Module () + +instance (WrapMethod m w) => (WrapField name m w) where + toWrapField _ prefix names = + let baseNames = methodArgBaseNames (_ :: m) prefix names 1 + in primMethod (inputPortNames (_ :: m) baseNames) ∘ toWrapMethod + fromWrapField _ = fromWrapMethod + saveFieldPortTypes _ _ modName prefix names = + let baseNames = methodArgBaseNames (_ :: m) prefix names 1 + in saveMethodPortTypes (_ :: m) modName baseNames + +-- TODO: It doesn't seem possible to have a PrimAction field in a synthesized interface, +-- but this case was being handled in GenWrap. +instance WrapField name PrimAction PrimAction where + toWrapField _ _ _ = id + fromWrapField _ = id + saveFieldPortTypes _ _ _ _ _ _ = return () + +instance WrapField name Clock Clock where + toWrapField _ _ _ = id + fromWrapField _ = id + saveFieldPortTypes _ _ _ _ _ _ = return () + +instance WrapField name Reset Reset where + toWrapField _ _ _ = id + fromWrapField _ = id + saveFieldPortTypes _ _ _ _ _ _ = return () + +instance (Bits a n) => WrapField name (Inout a) (Inout_ n) where + toWrapField _ _ _ = primInoutCast0 + fromWrapField _ = primInoutUncast0 + saveFieldPortTypes _ _ modName _ _ result = primSavePortType modName result $ typeOf (_ :: (Inout a)) + +class WrapMethod m w | m -> w where + -- Convert a synthesized interface method to its wrapper interface method. + toWrapMethod :: m -> w + + -- Convert a wrapper interface method to its synthesized interface method. + fromWrapMethod :: w -> m + + -- Compute the actual argument base names for a method, given the prefix and arg_names pragmas. + methodArgBaseNames :: m -> String -> List String -> Integer -> List String + + -- Compute the list of input port names for a method, from the argument base names. + inputPortNames :: m -> List String -> List String + + -- Save the port types for a method, given the module name, argument base names and result name. + saveMethodPortTypes :: m -> Maybe Name__ -> List String -> String -> Module () + +instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, WrapMethod b v, Curry (pb -> v) w) => + WrapMethod (a -> b) w where + toWrapMethod f = curryN $ toWrapMethod ∘ f ∘ unsplitPorts ∘ unpackPorts + fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ packPorts ∘ splitPorts + + methodArgBaseNames _ prefix (Cons h t) i = Cons + -- arg_names can start with a digit + (if prefix == "" && (h == "" || not (isDigit $ stringHead h)) + then h + else prefix +++ "_" +++ h) + (methodArgBaseNames (_ :: b) prefix t $ i + 1) + methodArgBaseNames _ prefix Nil i = Cons + (prefix +++ "_" +++ integerToString i) + (methodArgBaseNames (_ :: b) prefix Nil $ i + 1) + + inputPortNames _ (Cons h t) = checkPortNames (_ :: a) h `listPrimAppend` inputPortNames (_ :: b) t + inputPortNames _ Nil = error "inputPortNames: empty arg names list" + + saveMethodPortTypes _ modName (Cons h t) result = do + savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) h + saveMethodPortTypes (_ :: b) modName t result + saveMethodPortTypes _ _ Nil _ = error "saveMethodPortTypes: empty arg names list" + +instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where + toWrapMethod = toActionValue_ + fromWrapMethod = fromActionValue_ + methodArgBaseNames _ _ Nil _ = Nil + methodArgBaseNames prx prefix argNames _ = + primError (getEvalPosition prx) $ integerToString (listLength argNames) +++ + " excess arg_names provided for method " +++ prefix + inputPortNames _ Nil = Nil + inputPortNames _ (Cons _ _) = error "inputPortNames: uncaught excess arg names" + saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) + +instance (Bits a n) => WrapMethod a (Bit n) where + toWrapMethod = pack + fromWrapMethod = unpack + methodArgBaseNames _ _ Nil _ = Nil + methodArgBaseNames prx prefix argNames _ = + primError (getEvalPosition prx) $ integerToString (listLength argNames) +++ + " excess arg_names provided for method " +++ prefix + inputPortNames _ Nil = Nil + inputPortNames _ (Cons _ _) = error "inputPortNames: uncaught excess arg names" + saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) + +{- +Eventually, we should support splitting multiple output ports. +instance (SplitPorts a p, TupleSize p n, WrapPorts p pb) => WrapMethod (ActionValue a) (ActionValue pb) where + toWrapMethod = fmap packPorts + fromWrapMethod = fmap unpackPorts + outputPortNames _ base = checkPortNames (_ :: a) base + saveMethodPortTypes _ modName _ result = + savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) result + +instance (SplitPorts a p, TupleSize p n, WrapPorts p pb) => WrapMethod a pb where + toWrapMethod a = packPorts a + fromWrapMethod a = unpackPorts a + outputPortNames _ base = checkPortNames (_ :: a) base + saveMethodPortTypes _ modName _ result = + savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) result +-} + +class WrapPorts p pb | p -> pb where + -- Convert from a tuple of values to a tuple of bits. + packPorts :: p -> pb + -- Convert from a tuple of bits to a tuple of values. + unpackPorts :: pb -> p + -- Save the port types, given their names. + savePortTypes :: p -> Maybe Name__ -> List String -> Module () + +instance (Bits a n, WrapPorts b bb) => WrapPorts (Port a, b) (Bit n, bb) where + packPorts (Port a, b) = (pack a, packPorts b) + unpackPorts (a, b) = (Port $ unpack a, unpackPorts b) + savePortTypes _ modName (Cons h t) = do + primSavePortType modName h $ typeOf (_ :: a) + savePortTypes (_ :: b) modName t + savePortTypes _ _ Nil = error "savePortTypes: empty port names list" + +instance (Bits a n) => WrapPorts (Port a) (Bit n) where + packPorts (Port a) = pack a + unpackPorts = Port ∘ unpack + savePortTypes _ modName (Cons h _) = primSavePortType modName h $ typeOf (_ :: a) + savePortTypes _ _ Nil = error "savePortTypes: empty port names list" + +instance WrapPorts () () where + packPorts _ = () + unpackPorts _ = () + savePortTypes _ _ _ = return () + +-- Compute the list port names for type 'a' given a base name. +-- Check that the number of port names matches the number of ports. +-- This error should only occur if there is an error in a WrapPorts instance. +checkPortNames :: (SplitPorts a p, TupleSize p n) => a -> String -> List String +checkPortNames proxy base = + let pn = portNames proxy base + in + if listLength pn /= valueOf n + then primError (getEvalPosition proxy) $ + "SplitPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ + " ports, but " +++ integerToString (listLength pn) +++ " port names were given" + else pn + +class SplitPorts a p | a -> p where + -- Convert a value to a tuple of values corresponding to ports. + splitPorts :: a -> p + -- Combine a tuple of values corresponding to ports into a value. + unsplitPorts :: p -> a + -- Compute the list of port names for a type, given a base name. + -- This must be the same length as the tuple of values. + -- XXX it would be nice to use ListN here to enforce this, but it's not + -- available in the Prelude. + portNames :: a -> String -> List String + +data Port a = Port a + deriving (FShow) + +unPort :: Port a -> a +unPort (Port a) = a + +-- XXX if the default instance is the only one, then it gets inlined in CtxReduce +-- and other instances for this class are ignored. +instance SplitPorts () () where + splitPorts = id + unsplitPorts = id + portNames _ _ = Nil + +-- Default instance: don't split anything we don't know how to split. +instance SplitPorts a (Port a) where + splitPorts = Port + unsplitPorts = unPort + portNames _ base = Cons base Nil + +{- +XXX Consider if we want to split tuples by default. This would change the current behavior, +but might be a sensible one, especially if we support methods with multiple output ports. + +instance (SplitTuplePorts (a, b) r) => SplitPorts (a, b) r where + splitPorts = splitTuplePorts + unsplitPorts = unsplitTuplePorts + portNames = splitTuplePortNames 1 + +class SplitTuplePorts a p | a -> p where + splitTuplePorts :: a -> p + unsplitTuplePorts :: p -> a + splitTuplePortNames :: Integer -> a -> String -> List String + +instance (SplitPorts a p, SplitTuplePorts b q, AppendTuple p q r) => SplitTuplePorts (a, b) r where + splitTuplePorts (a, b) = splitPorts a `appendTuple` splitTuplePorts b + unsplitTuplePorts x = case splitTuple x of + (a, b) -> (unsplitPorts a, unsplitTuplePorts b) + splitTuplePortNames i _ base = + portNames (_ :: a) (base +++ "_" +++ integerToString i) `listPrimAppend` + splitTuplePortNames (i + 1) (_ :: b) base + +instance (SplitPorts a p) => SplitTuplePorts a p where + splitTuplePorts = splitPorts + unsplitTuplePorts x = unsplitPorts x + splitTuplePortNames i _ base = portNames (_ :: a) $ base +++ "_" +++ integerToString i +-} diff --git a/src/Libraries/Base1/PreludeBSV.bsv b/src/Libraries/Base1/PreludeBSV.bsv index 4509f532a..a2cf7d7f7 100644 --- a/src/Libraries/Base1/PreludeBSV.bsv +++ b/src/Libraries/Base1/PreludeBSV.bsv @@ -82,12 +82,6 @@ interface VRWire#(type a) ; method Bool whas() ; endinterface: VRWire -interface VRWireN#(numeric type n); - method PrimAction wset(Bit#(n) datain); - method Bit#(n) wget(); - method Bit#(1) whas(); -endinterface - // __mkRWireSubmodule only exists so that BSC can get a handle on the // 'AVInst' for the submodule instantiation of 'vMkRWire', by applying // a few compiler stages to the definition. This occurs in diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs new file mode 100644 index 000000000..dd15071f8 --- /dev/null +++ b/src/Libraries/Base1/SplitPorts.bs @@ -0,0 +1,198 @@ +package SplitPorts where + +-- Utilities for port splitting + +import qualified List +import Vector + +-- Newtype tags to indicate that a types should be split (recursively or not) into ports +data ShallowSplit a = ShallowSplit a +data DeepSplit a = DeepSplit a + +-- Tag to indicate that the DeepSplitPorts recursion should terminate +data NoSplit a = NoSplit a + +instance (ShallowSplitPorts a p) => SplitPorts (ShallowSplit a) p where + splitPorts (ShallowSplit x) = shallowSplitPorts x + unsplitPorts = ShallowSplit ∘ shallowUnsplitPorts + portNames _ = shallowSplitPortNames (_ :: a) + +instance (DeepSplitPorts a p) => SplitPorts (DeepSplit a) p where + splitPorts (DeepSplit x) = deepSplitPorts x + unsplitPorts = DeepSplit ∘ deepUnsplitPorts + portNames _ = deepSplitPortNames (_ :: a) + +instance DeepSplitPorts (NoSplit a) (Port a) where + deepSplitPorts (NoSplit x) = Port x + deepUnsplitPorts (Port x) = NoSplit x + deepSplitPortNames _ base = Cons base Nil + + +-- Helper class using generics, to split a struct or vector into a tuple of ports. +class ShallowSplitPorts a p | a -> p where + shallowSplitPorts :: a -> p + shallowUnsplitPorts :: p -> a + shallowSplitPortNames :: a -> String -> List String + +instance (Generic a r, ShallowSplitPorts' r p) => + ShallowSplitPorts a p where + shallowSplitPorts = shallowSplitPorts' ∘ from + shallowUnsplitPorts = to ∘ shallowUnsplitPorts' + shallowSplitPortNames _ = shallowSplitPortNames' (_ :: r) + +class ShallowSplitPorts' r p | r -> p where + shallowSplitPorts' :: r -> p + shallowUnsplitPorts' :: p -> r + shallowSplitPortNames' :: r -> String -> List String + +instance (ShallowSplitPorts' a p, ShallowSplitPorts' b q, AppendTuple p q r) => ShallowSplitPorts' (a, b) r where + shallowSplitPorts' (a, b) = shallowSplitPorts' a `appendTuple` shallowSplitPorts' b + shallowUnsplitPorts' x = case splitTuple x of + (a, b) -> (shallowUnsplitPorts' a, shallowUnsplitPorts' b) + shallowSplitPortNames' _ base = + shallowSplitPortNames' (_ :: a) base `List.append` shallowSplitPortNames' (_ :: b) base + +instance ShallowSplitPorts' () () where + shallowSplitPorts' _ = () + shallowUnsplitPorts' _ = () + shallowSplitPortNames' _ _ = Nil + +instance (ShallowSplitPorts' r p1, ConcatTuple n p1 p) => ShallowSplitPorts' (Vector n r) p where + shallowSplitPorts' = concatTuple ∘ map shallowSplitPorts' + shallowUnsplitPorts' = map shallowUnsplitPorts' ∘ unconcatTuple + shallowSplitPortNames' _ base = + let genElem i = shallowSplitPortNames' (_ :: r) (base +++ "_" +++ integerToString i) + in List.concat $ List.map genElem $ List.upto 0 (valueOf n - 1) + +instance (ShallowSplitPorts' r p) => ShallowSplitPorts' (Meta (MetaField name idx) r) p where + shallowSplitPorts' (Meta x) = shallowSplitPorts' x + shallowUnsplitPorts' = Meta ∘ shallowUnsplitPorts' + shallowSplitPortNames' _ base = shallowSplitPortNames' (_ :: r) $ + -- Avoid an extra underscore, since data fields names are _[0-9]+ + if base == "" || stringOf name == "" || stringHead (stringOf name) == '_' + then base +++ stringOf name + else base +++ "_" +++ stringOf name + +instance (ShallowSplitPorts' r p) => ShallowSplitPorts' (Meta m r) p where + shallowSplitPorts' (Meta x) = shallowSplitPorts' x + shallowUnsplitPorts' = Meta ∘ shallowUnsplitPorts' + shallowSplitPortNames' _ = shallowSplitPortNames' (_ :: r) + +instance (SplitPorts a p) => ShallowSplitPorts' (Conc a) p where + shallowSplitPorts' (Conc x) = splitPorts x + shallowUnsplitPorts' = Conc ∘ unsplitPorts + shallowSplitPortNames' _ = portNames (_ :: a) + + +-- Helper class using generics, to recursively split structs and vectors into a tuple of ports. +class DeepSplitPorts a p | a -> p where + deepSplitPorts :: a -> p + deepUnsplitPorts :: p -> a + deepSplitPortNames :: a -> String -> List String + +-- Avoid recursing into Int and UInt. +-- These are wrappers around Bit, and we want to generate ports like foo_x and +-- not `foo_x_1` for an Int or UInt field x. +instance DeepSplitPorts (UInt n) (Port (UInt n)) where + deepSplitPorts = Port + deepUnsplitPorts = unPort + deepSplitPortNames _ base = Cons base Nil + +instance DeepSplitPorts (Int n) (Port (Int n)) where + deepSplitPorts = Port + deepUnsplitPorts = unPort + deepSplitPortNames _ base = Cons base Nil + +instance DeepSplitPorts () () where + deepSplitPorts _ = () + deepUnsplitPorts _ = () + deepSplitPortNames _ _ = Nil + +instance (DeepSplitTuplePorts (a, b) p) => DeepSplitPorts (a, b) p where + deepSplitPorts = deepSplitTuplePorts + deepUnsplitPorts = deepUnsplitTuplePorts + deepSplitPortNames = deepSplitTuplePortNames 1 + +class DeepSplitTuplePorts a p | a -> p where + deepSplitTuplePorts :: a -> p + deepUnsplitTuplePorts :: p -> a + deepSplitTuplePortNames :: Integer -> a -> String -> List String + +instance (DeepSplitPorts a p, DeepSplitTuplePorts b q, AppendTuple p q r) => DeepSplitTuplePorts (a, b) r where + deepSplitTuplePorts (a, b) = deepSplitPorts a `appendTuple` deepSplitTuplePorts b + deepUnsplitTuplePorts x = case splitTuple x of + (a, b) -> (deepUnsplitPorts a, deepUnsplitTuplePorts b) + deepSplitTuplePortNames i _ base = + deepSplitPortNames (_ :: a) (base +++ "_" +++ integerToString i) `List.append` + deepSplitTuplePortNames (i + 1) (_ :: b) base + +instance (DeepSplitPorts a p) => DeepSplitTuplePorts a p where + deepSplitTuplePorts = deepSplitPorts + deepUnsplitTuplePorts x = deepUnsplitPorts x + deepSplitTuplePortNames i _ base = deepSplitPortNames (_ :: a) $ base +++ "_" +++ integerToString i + + +instance (Generic a r, DeepSplitPorts' r a p) => DeepSplitPorts a p where + deepSplitPorts = deepSplitPorts' (_ :: r) + deepUnsplitPorts = deepUnsplitPorts' (_ :: r) + deepSplitPortNames = deepSplitPortNames' (_ :: r) + +class DeepSplitPorts' r a p | r a -> p where + deepSplitPorts' :: r -> a -> p + deepUnsplitPorts' :: r -> p -> a + deepSplitPortNames' :: r -> a -> String -> List String + +-- Terminate recursion for n /= 1 constructors +instance (SplitPorts a p) => DeepSplitPorts' r a p where + deepSplitPorts' _ = splitPorts + deepUnsplitPorts' _ = unsplitPorts + deepSplitPortNames' _ = portNames + +-- Recurse into the fields of a struct +instance (Generic a r, DeepSplitPorts'' r p) => DeepSplitPorts' (Meta (MetaData name pkg args 1) r') a p where + deepSplitPorts' _ = deepSplitPorts'' ∘ from + deepUnsplitPorts' _ = to ∘ deepUnsplitPorts'' + deepSplitPortNames' _ _ = deepSplitPortNames'' (_ :: r) + +class DeepSplitPorts'' r p | r -> p where + deepSplitPorts'' :: r -> p + deepUnsplitPorts'' :: p -> r + deepSplitPortNames'' :: r -> String -> List String + +instance (DeepSplitPorts'' a p, DeepSplitPorts'' b q, AppendTuple p q r) => DeepSplitPorts'' (a, b) r where + deepSplitPorts'' (a, b) = deepSplitPorts'' a `appendTuple` deepSplitPorts'' b + deepUnsplitPorts'' x = case splitTuple x of + (a, b) -> (deepUnsplitPorts'' a, deepUnsplitPorts'' b) + deepSplitPortNames'' _ base = + deepSplitPortNames'' (_ :: a) base `List.append` deepSplitPortNames'' (_ :: b) base + +instance DeepSplitPorts'' () () where + deepSplitPorts'' _ = () + deepUnsplitPorts'' _ = () + deepSplitPortNames'' _ _ = Nil + +instance (DeepSplitPorts'' r p1, ConcatTuple n p1 p) => DeepSplitPorts'' (Vector n r) p where + deepSplitPorts'' = concatTuple ∘ map deepSplitPorts'' + deepUnsplitPorts'' = map deepUnsplitPorts'' ∘ unconcatTuple + deepSplitPortNames'' _ base = + let genElem i = deepSplitPortNames'' (_ :: r) (base +++ "_" +++ integerToString i) + in List.concat $ List.map genElem $ List.upto 0 (valueOf n - 1) + +instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta (MetaField name idx) r) p where + deepSplitPorts'' (Meta x) = deepSplitPorts'' x + deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' + deepSplitPortNames'' _ base = deepSplitPortNames'' (_ :: r) $ + -- Avoid an extra underscore, since data fields names are _[0-9]+ + if base == "" || stringOf name == "" || stringHead (stringOf name) == '_' + then base +++ stringOf name + else base +++ "_" +++ stringOf name + +instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta m r) p where + deepSplitPorts'' (Meta x) = deepSplitPorts'' x + deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' + deepSplitPortNames'' _ = deepSplitPortNames'' (_ :: r) + +instance (DeepSplitPorts a p) => DeepSplitPorts'' (Conc a) p where + deepSplitPorts'' (Conc x) = deepSplitPorts x + deepUnsplitPorts'' = Conc ∘ deepUnsplitPorts + deepSplitPortNames'' _ = deepSplitPortNames (_ :: a) diff --git a/src/Libraries/Base1/Vector.bs b/src/Libraries/Base1/Vector.bs index 4ed71dfb9..306a21cff 100644 --- a/src/Libraries/Base1/Vector.bs +++ b/src/Libraries/Base1/Vector.bs @@ -19,7 +19,8 @@ package Vector( find, findElem, findIndex, countLeadingZeros, countElem, countIf, countOnes, countOnesAlt, rotateBy, rotateBitsBy, - readVReg, writeVReg, toChunks, fromChunks, drop, Ascii + readVReg, writeVReg, toChunks, fromChunks, drop, Ascii, + ConcatTuple(..), ConcatTuple'(..) ) where import List @@ -1268,6 +1269,59 @@ fromChunks :: (Bits ch ch_sz, Bits t out_sz, Div out_sz ch_sz n) => Vector n ch fromChunks x = Prelude.unpack $ (Prelude.pack x)[valueOf out_sz - 1:0] +-- Convert between a vector of n tuples a and a flattened tuple b. +class ConcatTuple n a b | n a -> b where + concatTuple :: Vector n a -> b + unconcatTuple :: b -> Vector n a + +instance ConcatTuple 0 a () where + concatTuple _ = () + unconcatTuple _ = nil + +instance ConcatTuple 1 a a where + concatTuple v = head v + unconcatTuple x = cons x nil + +-- Linear recursive implementation: O(n^2) +-- instance (Add n1 1 n, ConcatTuple n1 a b, AppendTuple a b c) => ConcatTuple n a c where +-- concatTuple v = appendTuple (head v) $ concatTuple (tail v) +-- unconcatTuple x = case splitTuple x of +-- (y, z) -> cons y $ unconcatTuple z + +-- O(n lg n) optimization: split into chunks that are powers of 2 +instance (Add lgn 1 (TLog (TAdd n 1)), Add (TExp lgn) n1 n, ConcatTuple n1 a b, ConcatTuple' lgn a c, AppendTuple b c d) => + ConcatTuple n a d where + concatTuple v = + let v1 :: Vector n1 a = take v + v2 :: Vector (TExp lgn) a = drop v + in concatTuple v1 `appendTuple` concatTuple' v2 + unconcatTuple x = + let res :: (b, c) = splitTuple x + v1 :: Vector n1 a = unconcatTuple res.fst + v2 :: Vector (TExp lgn) a = unconcatTuple' res.snd + in append v1 v2 + +-- Concatenate a vector of 2^n tuples +class ConcatTuple' n a b | n a -> b where + concatTuple' :: Vector (TExp n) a -> b + unconcatTuple' :: b -> Vector (TExp n) a + +instance ConcatTuple' 0 a a where + concatTuple' v = head v + unconcatTuple' x = cons x nil + +instance (Add n1 1 n, ConcatTuple' n1 a b, AppendTuple b b c) => ConcatTuple' n a c where + concatTuple' v = + let v1 :: Vector (TExp n1) a = take v + v2 :: Vector (TExp n1) a = drop v + in concatTuple' v1 `appendTuple` concatTuple' v2 + unconcatTuple' x = + let res :: (b, b) = splitTuple x + v1 :: Vector (TExp n1) a = unconcatTuple' res.fst + v2 :: Vector (TExp n1) a = unconcatTuple' res.snd + in append v1 v2 + + --@ \item{\bf Examples Using the Vector Type} --@ --@ The following example shows some common uses of the {\te{Vector}} diff --git a/src/Libraries/Base1/depends.mk b/src/Libraries/Base1/depends.mk index 0446a6da7..52e8f5f75 100644 --- a/src/Libraries/Base1/depends.mk +++ b/src/Libraries/Base1/depends.mk @@ -1,5 +1,5 @@ ## Automatically generated by bluetcl -exec makedepend -- Do NOT EDIT -## Date: Tue Jul 23 10:01:18 AM PDT 2024 +## Date: Thu Dec 19 11:17:07 AM PST 2024 ## Command: bluetcl -exec makedepend -bdir $(BUILDDIR) *.bs* $(BUILDDIR)/ActionSeq.bo: ActionSeq.bs $(BUILDDIR)/List.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo @@ -36,4 +36,5 @@ $(BUILDDIR)/RegFile.bo: RegFile.bs $(BUILDDIR)/ConfigReg.bo $(BUILDDIR)/List.bo $(BUILDDIR)/Reserved.bo: Reserved.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo $(BUILDDIR)/RevertingVirtualReg.bo: RevertingVirtualReg.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo $(BUILDDIR)/SShow.bo: SShow.bs $(BUILDDIR)/ListN.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo +$(BUILDDIR)/SplitPorts.bo: SplitPorts.bs $(BUILDDIR)/List.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo $(BUILDDIR)/Vector.bo: Vector.bs $(BUILDDIR)/List.bo $(BUILDDIR)/Array.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo diff --git a/src/comp/CSyntax.hs b/src/comp/CSyntax.hs index 64d26342a..c8d40355e 100644 --- a/src/comp/CSyntax.hs +++ b/src/comp/CSyntax.hs @@ -175,7 +175,8 @@ data CDefn | Cforeign { cforg_name :: Id, cforg_type :: CQType, cforg_foreign_name :: Maybe String, - cforg_ports :: Maybe ([String], [String]) } + cforg_ports :: Maybe ([String], [String]), + cforg_is_noinline :: Bool } | Cprimitive Id CQType | CprimType IdK | CPragma Pragma @@ -195,7 +196,7 @@ instance NFData CDefn where rnf (Cinstance qt defls) = rnf2 qt defls rnf (CValue i cs) = rnf2 i cs rnf (CValueSign def) = rnf def - rnf (Cforeign name ty fname ports) = rnf4 name ty fname ports + rnf (Cforeign name ty fname ports ni) = rnf5 name ty fname ports ni rnf (Cprimitive i qt) = rnf2 i qt rnf (CprimType ik) = rnf ik rnf (CPragma pr) = rnf pr @@ -1131,8 +1132,10 @@ instance PPrint CDefn where (IdK i) -> ppConId d i (IdKind i k) -> ppConId d i <+> t "::" <+> pp d k (IdPKind i pk) -> ppConId d i <+> t "::" <+> pp d pk - pPrint d p (Cforeign i ty oname opnames) = - text "foreign" <+> ppVarId d i <+> t "::" <+> pp d ty <> (case oname of Nothing -> text ""; Just s -> text (" = " ++ show s)) <> (case opnames of Nothing -> text ""; Just (is, os) -> t"," <> pparen True (sep (map (text . show) is ++ po os))) + pPrint d p (Cforeign i ty oname opnames ni) = + text "foreign" <> (if ni then text " noinline" else empty) <+> ppVarId d i <+> t "::" <+> pp d ty <> + (case oname of Nothing -> text ""; Just s -> text (" = " ++ show s)) <> + (case opnames of Nothing -> text ""; Just (is, os) -> t"," <> pparen True (sep (map (text . show) is ++ po os))) where po [o] = [text ",", text (show o)] po os = [t"(" <> sepList (map (text . show) os) (t",") <> t ")"] pPrint d p (CIinstance i qt) = diff --git a/src/comp/CSyntaxUtil.hs b/src/comp/CSyntaxUtil.hs index 8abbf355f..8272d64c4 100644 --- a/src/comp/CSyntaxUtil.hs +++ b/src/comp/CSyntaxUtil.hs @@ -63,6 +63,10 @@ mkMaybe :: (Maybe CExpr) -> CExpr mkMaybe Nothing = CCon idInvalid [] mkMaybe (Just e) = CCon idValid [e] +mkList :: Position -> [CExpr] -> CExpr +mkList pos [] = CCon (idNil pos) [] +mkList pos (e:es) = CCon (idCons pos) [e, mkList pos es] + num_to_cliteral_at :: Integral n => Position -> n -> CLiteral num_to_cliteral_at pos num = CLiteral pos $ LInt $ ilDec (toInteger num) diff --git a/src/comp/CVPrint.hs b/src/comp/CVPrint.hs index 8f97ace07..f2c8c95d6 100644 --- a/src/comp/CVPrint.hs +++ b/src/comp/CVPrint.hs @@ -287,8 +287,8 @@ instance PVPrint CDefn where pvPrint d p (CprimType (IdKind i k)) = t"primitive type" <+> pp d i <+> t "::" <+> pp d k - pvPrint d p (Cforeign i ty oname opnames) = - text "foreign" <+> pvpId d i <+> t "::" + pvPrint d p (Cforeign i ty oname opnames ni) = + text "foreign" <> (if ni then text " noinline" else empty) <+> pvpId d i <+> t "::" <+> pp d ty <> (case oname of Nothing -> empty; Just s -> text (" = " ++ show s)) <> (case opnames of diff --git a/src/comp/ContextErrors.hs b/src/comp/ContextErrors.hs index f18171231..1c7e8fcbe 100644 --- a/src/comp/ContextErrors.hs +++ b/src/comp/ContextErrors.hs @@ -20,8 +20,8 @@ import TIMonad import TCMisc import Unify -import FStringCompat (mkFString) -import Id(mkId) +import FStringCompat (FString, mkFString, getFString) +import Id(Id, mkId) import PreIds import CSyntax import Util(separate, concatMapM, quote, headOrErr, toMaybe, boolCompress) @@ -39,8 +39,8 @@ import CType(typeclassId, isTNum, getTNum) -- a list of the contexts which failed to reduce, this function -- returns the list of error messages which should be reported -- -handleContextReduction :: Position -> [VPred] -> TI a -handleContextReduction pos vps = +handleContextReduction :: Maybe Id -> Position -> [VPred] -> TI a +handleContextReduction mid pos vps = do -- We used to remove duplicates: -- let vps' = nubVPred vps @@ -80,15 +80,15 @@ handleContextReduction pos vps = then vps_reduced_nicenames else is_mod_arrow_vps - emsgs <- mapM (handleContextReduction' pos) err_vps + emsgs <- mapM (handleContextReduction' mid pos) err_vps errs "handleContextReduction" emsgs -- -------------------- -- This helper function takes one predicate at a time -handleContextReduction' :: Position -> (VPred, [VPred]) -> TI EMsg -handleContextReduction' pos +handleContextReduction' :: Maybe Id -> Position -> (VPred, [VPred]) -> TI EMsg +handleContextReduction' mid pos p@((VPred vpi (PredWithPositions (IsIn c@(Class { name=(CTypeclass cid) }) ts) _)), _) | cid == idBitwise = case ts of @@ -165,12 +165,17 @@ handleContextReduction' pos _ -> return $ defaultContextReductionErr pos p _ -> internalError("handleContextReduction': " ++ "SizedLiteral instance contains wrong number of types") + | cid == idWrapField = + case ts of + [TCon (TyStr name _), t, _] -> return $ handleCtxRedWrapField mid pos p name t + _ -> internalError("handleContextReduction': " ++ + "WrapField instance contains wrong number of types") -- | cid == idLiteral = -- | cid == idRealLiteral = -- | cid == idStringLiteral = -handleContextReduction' pos p = +handleContextReduction' mid pos p = return (defaultContextReductionErr pos p) -- -------------------- @@ -454,6 +459,21 @@ handleCtxRedPrimPort pos (vp, reduced_ps) userty = in (pos, ECtxErrPrimPort (pfpString userty) poss hasVar) +-- -------------------- + +handleCtxRedWrapField:: Maybe Id -> Position -> (VPred, [VPred]) -> FString -> Type -> EMsg +handleCtxRedWrapField mid pos (vp, reduced_ps) name userty = + (pos, EBadIfcType (fmap pfpString mid) $ + "The interface method `" ++ getFString name ++ + "' uses type(s) that are not in the Bits or SplitPorts typeclasses: " ++ + intercalate ", " (concatMap bitsPredType reduced_ps) + ) + where + bitsPredType :: VPred -> [String] + bitsPredType (VPred _ (PredWithPositions (IsIn (Class { name=(CTypeclass cid) }) [t, _]) _)) + | cid == idBits = [pfpString t] + bitsPredType _ = [] + -- ======================================================================== -- Weak Context @@ -998,7 +1018,7 @@ earlyContextReduction pos ps = rs <- mapM try_pred ps let err_preds = map fst (filter (not . snd) rs) when (not (null err_preds)) $ - handleContextReduction pos err_preds + handleContextReduction Nothing pos err_preds -- ======================================================================== diff --git a/src/comp/Error.hs b/src/comp/Error.hs index 137e38044..e48e7a2e0 100644 --- a/src/comp/Error.hs +++ b/src/comp/Error.hs @@ -805,7 +805,7 @@ data ErrMsg = | EPolyField | ENotKNum String | EBadGenArg String - | EBadIfcType String String + | EBadIfcType (Maybe String) String | EBadForeignIfcType String | ENoTypeSign String | EStmtContext String @@ -2124,9 +2124,12 @@ getErrorText (ENotKNum t) = (Type 41, empty, s2par ("Only size polymorphism allowed in code generation: " ++ t)) getErrorText (EBadGenArg i) = (Type 42, empty, s2par ("Bad argument in code generation: " ++ ishow i)) -getErrorText (EBadIfcType mod msg) = +getErrorText (EBadIfcType (Just mod) msg) = (Type 43, empty, s2par ("Cannot synthesize " ++ quote mod ++ ": " ++ msg)) +getErrorText (EBadIfcType Nothing msg) = + (Type 43, empty, + s2par ("Cannot synthesize this module or function: " ++ msg)) getErrorText (ENoTypeSign e) = (Type 44, empty, s2par ("Missing or bad type signature for a module: " ++ e)) getErrorText (EStmtContext c) = diff --git a/src/comp/GenBin.hs b/src/comp/GenBin.hs index cad48d9eb..1e9ca1162 100644 --- a/src/comp/GenBin.hs +++ b/src/comp/GenBin.hs @@ -27,7 +27,7 @@ doTrace = elem "-trace-genbin" progArgs -- .bo file tag -- change this whenever the .bo format changes -- See also GenABin.header header :: [Byte] -header = B.unpack $ TE.encodeUtf8 $ T.pack "bsc-bo-20230831-1" +header = B.unpack $ TE.encodeUtf8 $ T.pack "bsc-bo-20240814-1" genBinFile :: ErrorHandle -> String -> CSignature -> CSignature -> IPackage a -> IO () @@ -84,8 +84,8 @@ instance Bin CDefn where do putI 2; toBin vis; toBin st; toBin ik; toBin is; toBin fs writeBytes (Cclass incoh ps ik is deps fs) = do putI 3; toBin incoh; toBin ps; toBin ik; toBin is; toBin deps; toBin fs - writeBytes (Cforeign n cqt fn ports) = - do putI 4; toBin n; toBin cqt; toBin fn; toBin ports + writeBytes (Cforeign n cqt fn ports ni) = + do putI 4; toBin n; toBin cqt; toBin fn; toBin ports; toBin ni writeBytes (Cprimitive i cqt) = do putI 5; toBin i; toBin cqt writeBytes (CprimType ik) = do putI 6; toBin ik writeBytes (CIinstance i cqt) = do putI 7; toBin i; toBin cqt @@ -128,7 +128,8 @@ instance Bin CDefn where cqt <- fromBin fn <- fromBin ports <- fromBin - return (Cforeign n cqt fn ports) + ni <- fromBin + return (Cforeign n cqt fn ports ni) 5 -> do when doTrace $ traceM ("Cprimitive") i <- fromBin; cqt <- fromBin return (Cprimitive i cqt) @@ -642,6 +643,8 @@ instance Bin (IConInfo a) where internalError "GenBin.Bin(IConInfo).writeBytes: ICPred" writeBytes (ICHandle { }) = internalError "GenBin.Bin(IConInfo).writeBytes: ICHandle" + writeBytes (ICMethod { }) = + internalError "GenBin.Bin(IConInfo).writeBytes: ICMethod" readBytes = do tag <- getI t <- fromBin case tag of diff --git a/src/comp/GenFuncWrap.hs b/src/comp/GenFuncWrap.hs index 1a33d6f27..c25dc2dbc 100644 --- a/src/comp/GenFuncWrap.hs +++ b/src/comp/GenFuncWrap.hs @@ -9,14 +9,13 @@ import Error(internalError, ErrMsg(..), ErrorHandle, bsError) import Flags(Flags) import PPrint import Id -import PreIds(idBits, idUnpack, idPack, tmpVarIds, - idActionValue, idFromActionValue_) +import PreIds(idFromWrapField, idActionValue, idStrArg) import CSyntax import SymTab import Scheme import Assump import Type(tModule, fn) -import CType(getArrows, cTVarNum) +import CType(getArrows, getRes, cTStr) import Pred(expandSyn) import TypeCheck(cCtxReduceDef) import Subst(tv) @@ -241,48 +240,21 @@ addFuncWrap errh symt is (CPackage modid exps imps fixs ds includes) = do -- n = the number of arguments to the foreign function -- t = the base type of the foreign function funcDef :: ErrorHandle -> SymTab -> Id -> CQType -> Id -> Int -> CQType -> IO CDefn -funcDef errh symt i oqt@(CQType octxs ot) i_ n (CQType _ t) = - let - -- unfortunately, we have to duplicate the work that genwrap did - -- in creating the interface interface type and interface - -- conversion functions - - pos = getPosition i - (as, r) = getArrows ot - - -- the arguments are always bitifiable - bitsCtx a s = CPred (CTypeclass idBits) [a, s] - size_vars = map (cTVarNum . enumId "sn" pos) [0..] - as_ctxs = zipWith bitsCtx as size_vars - - vs = map (setIdPosition pos) $ take n tmpVarIds - epack e = cVApply idPack [e] - es = map (epack . CVar) vs - - f_expr = cVApply i_ es - +funcDef errh symt i oqt@(CQType _ ot) i_ n (CQType _ t) = + let pos = getPosition i + r = getRes ot -- the result is either an actionvalue or a value isAV = isActionValue symt r - r_size_var = cTVarNum $ enumId "sn" pos n - r_ctxs = case (isAV) of - Just av_t -> [bitsCtx av_t r_size_var] - Nothing -> [bitsCtx r r_size_var] - - expr = if (isJust isAV) - then cVApply idFromActionValue_ [f_expr] - else cVApply idUnpack [f_expr] - - -- put the ctxs together - ctxs' = as_ctxs ++ r_ctxs ++ octxs - qt' = CQType ctxs' ot + fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (getIdFString i) (getIdPosition i) + expr = cVApply idFromWrapField [fnp, CVar i_] in -- XXX this code works for Action/ActionValue foreign funcs, -- XXX but they are not handled by astate yet if (isJust isAV) - then bsError errh [(getPosition i, ENoInlineAction (getIdBaseString i))] + then bsError errh [(pos, ENoInlineAction (getIdBaseString i))] else return $ - CValueSign (CDef i qt' [CClause (map CPVar vs) [] expr]) + CValueSign (CDef i oqt [CClause [] [] expr]) -- --------------- @@ -304,7 +276,7 @@ funcDef_ mi i i_ qt_ args = -- output port: oport = getIdString i in - Cforeign i_ qt_ (Just mstr) (Just (iports, [oport])) + Cforeign i_ qt_ (Just mstr) (Just (iports, [oport])) True -- --------------- diff --git a/src/comp/GenSign.hs b/src/comp/GenSign.hs index cf4c54b9a..0161e839f 100644 --- a/src/comp/GenSign.hs +++ b/src/comp/GenSign.hs @@ -407,11 +407,11 @@ genDefSign s look currentPkg (CValueSign (CDef i qt _)) = in case look qi of Nothing -> [] Just _ -> [(CIValueSign qi (qualCQType s qt), [])] -genDefSign s look currentPkg (Cforeign i qt ms mps) = +genDefSign s look currentPkg (Cforeign i qt ms mps ni) = let qi = qualId currentPkg i in case look qi of Nothing -> [] - Just _ -> [(Cforeign qi (qualCQType s qt) ms mps, [])] + Just _ -> [(Cforeign qi (qualCQType s qt) ms mps ni, [])] genDefSign s look currentPkg (Cprimitive i qt) = let qi = qualId currentPkg i in case look qi of diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index d54c0a6d9..03fa7dc11 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -9,8 +9,9 @@ module GenWrap( import Prelude hiding ((<>)) #endif +import Data.Char(isDigit) import Data.List(nub, (\\), find) -import Control.Monad(when, foldM, filterM, zipWithM, mapAndUnzipM) +import Control.Monad(when, foldM, filterM, zipWithM) import Control.Monad.Except(ExceptT, runExceptT, throwError) import Control.Monad.State(StateT, runStateT, lift, gets, get, put) import PFPrint @@ -19,7 +20,7 @@ import Error(internalError, EMsg, EMsgs(..), ErrMsg(..), ErrorHandle, bsError) import ErrorMonad(ErrorMonad, convErrorMonadToIO) import Flags(Flags) import FStringCompat -import PreStrings(fsUnderscore, fs_t, fsTo, fsFrom, fsEmpty, fsEnable, fs_rdy) +import PreStrings(fsUnderscore, fs_t, fsTo, fsFrom, fsEmpty, fsEnable, fs_rdy, fsDot) import Id import IdPrint import PreIds @@ -429,12 +430,12 @@ chkType def ty = Right ((_:_) :=> _) -> let ctx = if isClassic() then "context" else "proviso" msg = "It has a " ++ ctx ++ "." - in bad (getPosition def, EBadIfcType (pfpString defId) msg) + in bad (getPosition def, EBadIfcType (Just $ pfpString defId) msg) Right ([] :=> t) -> do if not (null (tv t)) then let msg = "Its interface is polymorphic." - in bad (getPosition def, EBadIfcType (pfpString defId) msg) + in bad (getPosition def, EBadIfcType (Just $ pfpString defId) msg) else do --traceM ("chkType: " ++ pfpReadable (t, getArrows t)) @@ -446,7 +447,7 @@ chkType def ty = (f:_) -> let msg = "Its interface has a polymorphic field " ++ quote (pfpString f) ++ "." in bad (getPosition def, - EBadIfcType (pfpString defId) msg) + EBadIfcType (Just $ pfpString defId) msg) [] -> do ----traceM ("chkType 2: " ++ pfpReadable (chkInterface tr)) @@ -460,10 +461,10 @@ chkType def ty = quote (pfpString t) ++ " is not an interface." in bad (getPosition def, - EBadIfcType (pfpString defId) msg) + EBadIfcType (Just $ pfpString defId) msg) _ -> let msg = "It is not a module." in bad (getPosition def, - EBadIfcType (pfpString defId) msg) + EBadIfcType (Just $ pfpString defId) msg) -- Return a list of names of any fields which are polymorphic, -- if the given type is an interface; otherwise return an empty list. @@ -828,17 +829,11 @@ genTDef trec@(IfcTRec newId rootId _ sty _ k fts args _) = (ifc',newprops) <- genIfc trec args k --traceM( "genTDef: ifc " ++ ppReadable ifc' ) --traceM( "genTDef:: new prop are: " ++ ppReadable newprops ) - flgs <- getFlags - symt <- getSymTab - let res = cCtxReduceDef flgs symt ifc' - --traceM( "genTDef: res " ++ ppReadable res ) - case res of -- type checking for the interface - Left msgs -> bads msgs - Right ifc'' -> return GeneratedIfc { - genifc_id = newId, - genifc_kind = k, - genifc_cdefn = ifc'', - genifc_pprops = newprops } + return GeneratedIfc { + genifc_id = newId, + genifc_kind = k, + genifc_cdefn = ifc', + genifc_pprops = newprops } -- Generate a new interface definition for the CPackage -- Basically, this consists of a Cstruct of sub-type Sintrface. @@ -892,18 +887,11 @@ genIfcField trec ifcIdIn prefixes (FInf fieldIdQ argtypes rettype _) = return ((concat fields), (concat props)) _ -> -- leaf function do - let (v, vs) = unconsOrErr "GenWrap.genIfcField: v:vs" $ - map cTVarNum (take (length argtypes + 1) tmpTyVarIds) - let bitsCtx a s = CPred (CTypeclass idBits) [a, s] - let ctx = zipWith bitsCtx argtypes vs - let ss = map (TAp tBit) vs - isClock <- isClockType rettype isReset <- isResetType rettype isInout <- isInoutType rettype let isIot = isInout/=Nothing isPA <- isPrimAction rettype - isAV <- isActionValue rettype isVec <- isVectorInterfaces rettype case (isVec, argtypes) of (Just (n, tVec, isListN), []) -> @@ -916,37 +904,31 @@ genIfcField trec ifcIdIn prefixes (FInf fieldIdQ argtypes rettype _) = let (fields,props) = unzip fieldsprops return (concat fields, concat props) _ -> do -- ELSE NOT a Vec - (r', ctx') <- - if isAV then do - av_t <- getAVType "genIfcField" rettype - return (TAp tActionValue_ v, bitsCtx av_t v : ctx) - else return $ - case isInout of - Just t -> (TAp tInout_ v, - bitsCtx t v : ctx) - _ -> if (isPA || isClock || isReset) then (rettype, ctx) - else (TAp tBit v, bitsCtx rettype v : ctx) - let fi = binId prefixes fieldId - -- - let (mprops, ifcPragmas) = gen prefixes ciPrags fieldId fi - gen | isClock = genNewClockIfcPragmas - | isReset = genNewResetIfcPragmas - | isIot = genNewInoutIfcPragmas - | otherwise = genNewMethodIfcPragmas - - let ifc_field = CField { cf_name = fi, - cf_pragmas = Just ifcPragmas, - cf_type = CQType ctx' (foldr arrow r' ss), - cf_orig_type = Just (foldr arrow rettype argtypes), - cf_default = [] - } - -- - -- the ready field - let rdy_field = if (isClock || isReset || isIot) then [] - else mkReadyField trec ifcPragmas ifcIdIn fieldId fi - -- - --traceM( "ifc_fields is: " ++ ppReadable ifc_field) - return ((ifc_field : rdy_field), mprops ) + let fnt = cTStr (fieldPathName prefixes fieldId) (getIdPosition fieldIdQ) + let v = cTVar $ head tmpTyVarIds + let ctx = CPred (CTypeclass idWrapField) [fnt, foldr arrow rettype argtypes, v] + + let fi = binId prefixes fieldId + -- + let (mprops, ifcPragmas) = gen prefixes ciPrags fieldId fi + gen | isClock = genNewClockIfcPragmas + | isReset = genNewResetIfcPragmas + | isIot = genNewInoutIfcPragmas + | otherwise = genNewMethodIfcPragmas + + let ifc_field = CField { cf_name = fi, + cf_pragmas = Just ifcPragmas, + cf_type = CQType [ctx] v, + cf_orig_type = Just (foldr arrow rettype argtypes), + cf_default = [] + } + -- + -- the ready field + let rdy_field = if (isClock || isReset || isIot) then [] + else mkReadyField trec ifcPragmas ifcIdIn fieldId fi + -- + --traceM( "ifc_fields is: " ++ ppReadable ifc_field) + return ((ifc_field : rdy_field), mprops ) -- create a RDY field, if requested @@ -1087,25 +1069,26 @@ genTo pps ty mk = cint <- chkInterface ty case cint of Nothing -> internalError ("genTo: " ++ pfpReadable (ty, mk)) - Just (_, _, fts) -> do - meths <- mapM (meth mk noPrefixes) fts + Just (ifcId, _, fts) -> do + meths <- mapM (meth mk noPrefixes ifcId) fts fty <- flatTypeId pps ty let tmpl = Cinterface (getPosition fts) (Just fty) (concat meths) return tmpl where - meth :: CExpr -> IfcPrefixes -> FInf -> GWMonad [CDefl] - meth sel prefixes (FInf f as r aIds) = + meth :: CExpr -> IfcPrefixes -> Id -> FInf -> GWMonad [CDefl] + meth sel prefixes ifcIdIn (FInf f as r aIds) = do + ciPrags <- getInterfaceFieldPrags ifcIdIn f {- f should be qualifed -} mi <- chkInterface r case (mi, as) of - (Just (_, _, fts), []) -> do + (Just (ifcId, _, fts), []) -> do isAV <- isActionValue r if isAV then internalError "genTo 2: unexpected AV" else do --traceM ("selector: " ++ show sel) - newPrefixes <- extendPrefixes prefixes [] r f - meths <- mapM (meth (extSel sel f) newPrefixes) fts + newPrefixes <- extendPrefixes prefixes ciPrags r f + meths <- mapM (meth (extSel sel f) newPrefixes ifcId) fts return (concat meths) _ -> do -- Generate the Verilog template for X isVec <- isVectorInterfaces r @@ -1116,32 +1099,24 @@ genTo pps ty mk = let primselect = idPrimSelectFn noPosition let lit k = CLit $ num_to_cliteral_at noPosition k let selector n = cVApply primselect [posLiteral noPosition, extSel sel f, lit n] - elemPrefix <- extendPrefixes prefixes [] r f + elemPrefix <- extendPrefixes prefixes ciPrags r f let recurse num = do numPrefix <- extendPrefixes elemPrefix [] r (mkNumId num) - meth (selector num) numPrefix (FInf idEmpty [] tVec []) + meth (selector num) numPrefix ifcIdIn (FInf idEmpty [] tVec []) fields <- mapM recurse nums return (concat fields) _ -> do - isClock <- isClockType r - isReset <- isResetType r - isInout <- isInoutType r - isPA <- isPrimAction r - isAV <- isActionValue r - let vs = take (length as) (aIds ++ tmpVarXIds) + -- Compute the prefix and arg_names pragmas for the flattened interface field, extended according to the current prefix. + let currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix + localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) + localPrefix = joinStrings_ currentPre localPrefix1 + prefix = stringLiteralAt noPosition localPrefix + arg_names = mkList (getPosition f) [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] + fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f)(getIdPosition f) -- XXX idEmpty is a horrible way to know no more selection is required - let ec = if f == idEmpty then sel else - cApply 11 (CSelect sel (setInternal f)) - (map (\ v -> CApply eUnpack [CVar v]) vs) - let e = - case isInout of - Just _ -> CApply ePrimInoutCast0 [ec] - _ -> if isClock || isReset || isPA - then ec - else if isAV - then cVApply idToActionValue_ [ec] - else CApply ePack [ec] - return [CLValue (binId prefixes f) [CClause (map CPVar vs) [] e] []] + let ec = if f == idEmpty then sel else CSelect sel (setInternal f) + let e = CApply (CVar idToWrapField) [fnp, prefix, arg_names, ec] + return [CLValue (binId prefixes f) [CClause [] [] e] []] -- -------------------- -- genWrapE toplevel: mkFrom_ @@ -1156,15 +1131,15 @@ mkFrom_ trec@(IfcTRec { rec_numargs = [], rec_typemap = [] }) = tyId <- flatTypeId pps t let arg = id_t (getPosition t) let ty = cTCon tyId `fn` t - (expr, ctxs) <- genFrom pps t (CVar arg) + expr <- genFrom pps t (CVar arg) let cls = CClause [CPVar arg] [] expr - return (CValueSign (CDef (from_Id tyId) (CQType ctxs ty) [cls])) + return (CValueSign (CDef (from_Id tyId) (CQType [] ty) [cls])) mkFrom_ x = internalError "GenWrap::mkFrom_ " from_Id :: Id -> Id from_Id i = addInternalProp (mkIdPre fsFrom i) -genFrom :: [PProp] -> CType -> CExpr -> GWMonad (CExpr, [CPred]) +genFrom :: [PProp] -> CType -> CExpr -> GWMonad CExpr genFrom pps ty var = do --traceM ("genFrom type: " ++ (pfpAll ty)) @@ -1179,27 +1154,19 @@ genFrom pps ty var = ifcPrags <- getInterfacePrags ti let prefixes = noPrefixes { ifcp_pragmas = ifcPrags } fieldBlobs <- mapM (meth prefixes ti) fts - let expr = blobsToIfc ti fts fieldBlobs - let bits_types = unions (map fifth fieldBlobs) - ctxs = [ CPred (CTypeclass idBits) [t, cTVarNum v] - | (t, v) <- zip bits_types tmpTyVarIds ] - return (expr, ctxs) + return $ blobsToIfc ti fts fieldBlobs where blobsToIfc ti fts fieldBlobs = - let meths = [ CLValue (setInternal f) [CClause (map CPVar vs) [] e] gs - | (f, vs, e, gs, _) <- fieldBlobs ] + let meths = [ CLValue (setInternal f) [CClause [] [] e] gs + | (f, e, gs) <- fieldBlobs ] in Cinterface (getPosition fts) (Just ti) meths - fifth (_, _, _, _, x) = x - - -- This returns a 5-tuple of a field Id (method or subifc), - -- its argument Ids, its result expression, and its implicit - -- condition (only for methods), and a list of types which need - -- Bits provisos. + -- This returns a 3-tuple of a field Id (method or subifc), + -- its defining expression, and its implicit condition (only for methods). -- Note: The Id is qualified, because it could be something not -- imported by the user (and this not available unqualified). meth :: IfcPrefixes -> Id -> FInf -> - GWMonad (Id, [Id], CExpr, [CQual], [CType]) + GWMonad (Id, CExpr, [CQual]) meth prefixes ifcId (FInf f as r aIds) = do ciPrags <- getInterfaceFieldPrags ifcId f {- f should be qualifed -} @@ -1210,8 +1177,7 @@ genFrom pps ty var = newprefixes <- extendPrefixes prefixes ciPrags r f fieldBlobs <- mapM (meth newprefixes ti) fts let expr = blobsToIfc ti fts fieldBlobs - ctxs = unions (map fifth fieldBlobs) - return (f, [], expr, [], ctxs) + return (f, expr, []) _ -> do isVec <- isVectorInterfaces r case (isVec, as) of @@ -1222,47 +1188,29 @@ genFrom pps ty var = do newprefixes <- extendPrefixes prefixes ciPrags r f meth newprefixes idVector (FInf (mkNumId num) [] tVec []) fieldBlobs <- mapM recurse nums - let (es, gs) = unzip [(e, g) | (_, _, e, g, _) <- fieldBlobs] + let (es, gs) = unzip [(e, g) | (_, e, g) <- fieldBlobs] let vec = cToVector isListN es - let ctxs = case fieldBlobs of - -- each element will have the same ctxs - -- so just take from the first one - (blob:_) -> fifth blob - _ -> [] - return (f, [], vec, concat gs, ctxs) + return (f, vec, concat gs) _ -> do isPA <- isPrimAction r isClock <- isClockType r isReset <- isResetType r isInout <- isInoutType r let isIot = isInout /= Nothing - isAV <- isActionValue r let binf = binId prefixes f let wbinf = mkRdyId binf let sel = CSelect var let hasNoRdy = isAlwaysRdy pps wbinf || isAlwaysReadyIfc (ifcp_pragmas prefixes ++ ciPrags) let meth_guard = CApply eUnpack [sel wbinf] - let vs = take (length as) (aIds ++ tmpVarXIds) let qs = if (hasNoRdy || isClock || isReset || isIot) then [] else [CQFilter meth_guard] - let ec = cApply 13 (sel binf) - (map (\ v -> CApply ePack [CVar v]) vs) - (e, res_ctxs) <- - case isInout of - Just iot -> return (CApply ePrimInoutUncast0 [ec], [iot]) - _ -> if (isPA || isClock || isReset) - then return (ec, []) - else - if isAV - then do - retType <- getAVType "genFrom" r - return - (cApply 12 (CVar idFromActionValue_) [ec], - [retType]) - else return (CApply eUnpack [ec], [r]) - let ctxs = nub (res_ctxs ++ as) - return (f, vs, e, qs, ctxs) + + -- Call fromWrapField with a proxy for the field name as a type level string, + -- and the field selection from the unwrapped module. + let fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) + let e = CApply (CVar idFromWrapField) [fnp, sel binf] + return (f, e, qs) -- -------------------- @@ -1359,11 +1307,17 @@ mkCtxs ty = mkNewModDef :: M.Map Id GeneratedIfc -> ModDefInfo -> GWMonad CDefn mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = do + --traceM ("mkNewModDef: " ++ ppReadable def) -- XXX This could have been stored in the moduledef info -- XXX (note that the first half is the "ts" in "vtis") let tr = case getArrows t of (_, TAp _ r) -> r _ -> internalError "GenWrap.mkNewModDef: tr" + cint <- chkInterface tr + (ifcId, _, fts) <- case cint of + Just res -> return res + Nothing -> internalError "GenWrap.mkNewModDef: cint" + tyId <- flatTypeId vps tr -- id of the Ifc_ let ty = tmod (cTCon tyId) -- type of new module @@ -1381,7 +1335,6 @@ mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = -- get back the arg port to type mapping, for recording flgs <- getFlags arg_pts <- convEM $ checkModulePortNames flgs (getPosition i) vps vtis ftps - let arg_infos = thd $ unzip3 vtis (vs, ts) = unzip $ concatMap extractVTPairs arg_infos @@ -1397,10 +1350,15 @@ mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = -- statements to record the port-types of module arguments -- (for the current module) arg_sptStmts = map (uncurry saveTopModPortTypeStmt) arg_pts + + -- interface save-port-type statements + ifc_sptStmts <- mkFieldSavePortTypeStmts Nothing ifcId fts + + let sptStmts = arg_sptStmts ++ ifc_sptStmts -- a do-block around the module body, so that we can include the -- save-port-type statements - lexp = if not (null arg_sptStmts) - then Cdo False (arg_sptStmts ++ [CSExpr Nothing mexp]) + lexp = if not (null sptStmts) + then Cdo False (sptStmts ++ [CSExpr Nothing mexp]) else mexp -- liftM of the do-block to = cVApply idLiftM [CVar (to_Id tyId), lexp] @@ -1493,7 +1451,7 @@ mkNewModDef _ (def,_,_,_) = -- This is the part of "genWrapInfo" which makes the DefFun, -- a continuation function which does the final wrapper computation. --- type DefFun = VWireInfo -> VSchedInfo -> VPathInfo -> [VPort] -> SymTab -> [VFieldInfo] -> [Id] -> [Id] -> IO CDefn +-- type DefFun = Bool -> VWireInfo -> VSchedInfo -> VPathInfo -> [VPort] -> SymTab -> [VFieldInfo] -> [Id] -> IO CDefn -- XXX: alwaysEnabled is dropped and broken (not propagated to {inhigh}) mkDef :: [PProp] -> [PProp] -> CDef -> CQType -> GWMonad DefFun mkDef iprags pps (CDef i (CQType _ qt) _) cqt = do @@ -1507,7 +1465,7 @@ mkDef iprags pps (CDef i (CQType _ qt) _) cqt = do -- do not use ifc prags here (st2, ti_) <- runGWMonadGetNoFail (flatTypeId pps tr) st1 let vs = take (length ts) tmpVarIds - (st3, Just (_, _, finfs)) <- runGWMonadGetNoFail (chkInterface tr) st2 + (st3, Just (ifcId, _, finfs)) <- runGWMonadGetNoFail (chkInterface tr) st2 let -- return an expression for creating the arg (from the wrapper's args) -- and the type of the internal module's arg (for port-type saving) @@ -1552,10 +1510,6 @@ mkDef iprags pps (CDef i (CQType _ qt) _) cqt = do -- make the arg port-types, for saving in the module arg_pts = mkArgPortTypes wire_info arg_ts let - -- don't use the "fixed up" veriFields below because we don't need - -- port property information (makes the flow a little simpler, I think) - vfield_map = M.fromList [(vf_name vf, vf) | vf <- fields] - fields' = filter (not . (isRdyToRemoveField (iprags ++ pps))) fields veriFields = (map (fixupVeriField (iprags ++ pps) ips) fields') vexp = xWrapperModuleVerilog @@ -1569,7 +1523,7 @@ mkDef iprags pps (CDef i (CQType _ qt) _) cqt = do pathinfo vlift = (cVApply idLiftModule [vexp]) body <- runGWMonadNoFail - (genFromBody arg_pts vfield_map vlift true_ifc_ids ti_ finfs) + (genFromBody arg_pts vlift true_ifc_ids ti_ ifcId finfs) st4 let cls = CClause (map CPVar vs) [] body return $ CValueSign (CDef i cqt [cls])) @@ -1594,22 +1548,21 @@ mkArgPortTypes wire_info arg_ts = -- used in wrapper generate to wrap the module given by mk -- to the result. -genFromBody :: [(VPort, CType)] -> M.Map Id VFieldInfo -> - CExpr -> [Id] -> Id -> [FInf] -> GWMonad CExpr -genFromBody arg_pts vfield_map mk true_ifc_ids si fts = +genFromBody :: [(VPort, CType)] -> + CExpr -> [Id] -> Id -> Id -> [FInf] -> GWMonad CExpr +genFromBody arg_pts mk true_ifc_ids si ifcId fts = do -- traceM( "genFromBody: " ++ ppReadable fts ) let sty = cTCon si let pos = getIdPosition si - let mkMethod = mkFromBind vfield_map true_ifc_ids (CVar (id_t pos)) - (meths, ifc_ptss) <- mapAndUnzipM mkMethod fts - let -- interface save-port-type statements - ifc_sptStmts = - map (uncurry (savePortTypeStmt (CVar id_x))) (concat ifc_ptss) - -- argument save-port-type statements - arg_sptStmts = + let mkMethod = mkFromBind true_ifc_ids (CVar (id_t pos)) + meths <- mapM mkMethod fts + -- interface save-port-type statements + ifc_sptStmts <- mkFieldSavePortTypeStmts (Just $ CVar id_x) ifcId fts + -- argument save-port-type statements + let arg_sptStmts = map (uncurry (savePortTypeStmt (CVar id_x))) arg_pts - sptStmts = arg_sptStmts ++ ifc_sptStmts + sptStmts = arg_sptStmts ++ map CMStmt ifc_sptStmts let tmpl = Cmodule pos $ [CMStmt $ CSBindT (CPVar (id_t pos)) Nothing [] (CQType [] sty) mk] ++ ((saveNameStmt (id_t pos) id_x):sptStmts) ++ @@ -1618,23 +1571,24 @@ genFromBody arg_pts vfield_map mk true_ifc_ids si fts = return tmpl --- Creates a method for the module body --- also returns the raw port-type information for correlation +-- Creates a method for the module body. -- XXX some of this can be replaced with a call to "mkFrom_" -mkFromBind :: M.Map Id VFieldInfo -> [Id] -> CExpr -> FInf -> GWMonad (CDefl, [(VPort, CType)]) -mkFromBind vfield_map true_ifc_ids var ft = +-- Currently there is an optimization preventing this - we avoid adding guards for +-- ready signals that are known to be constant True, which isn't known when mkFrom_ is generated. +mkFromBind :: [Id] -> CExpr -> FInf -> GWMonad CDefl +mkFromBind true_ifc_ids var ft = do ms <- meth noPrefixes ft - return (mkv ms, fth4 ms) + return $ mkv ms where - mkv (f, e, g, _) = CLValue (setInternal f) [CClause vps [] e'] g + mkv (f, e, g) = CLValue (setInternal f) [CClause vps [] e'] g where (vps, e') = unLams e -- This returns a triple of a field Id (method or subifc), -- its definition, and its implicit condition (only for methods). -- Note: The Id is qualified, because it could be something not -- imported by the user (and this not available unqualified). - meth :: IfcPrefixes -> FInf -> GWMonad (Id, CExpr, [CQual], [(VPort, CType)]) + meth :: IfcPrefixes -> FInf -> GWMonad (Id, CExpr, [CQual]) meth prefixes (FInf f as r aIds) = do mi <- chkInterface r @@ -1642,7 +1596,7 @@ mkFromBind vfield_map true_ifc_ids var ft = (Just (ti, _, fts), []) -> do newprefixes <- extendPrefixes prefixes [] r f fieldBlobs <- mapM (meth newprefixes) fts - return (f, cInterface ti (map fst3of4 fieldBlobs), [], concatMap fth4 fieldBlobs) + return (f, cInterface ti fieldBlobs, []) _ -> do isVec <- isVectorInterfaces r case (isVec, as) of @@ -1652,48 +1606,27 @@ mkFromBind vfield_map true_ifc_ids var ft = let recurse num = do newprefixes <- extendPrefixes prefixes [] r f meth newprefixes (FInf (mkNumId num) [] tVec []) fieldBlobs <- mapM recurse nums - let (es, gs) = unzip [(e,g) | (_, e, g, _) <- fieldBlobs] + let (es, gs) = unzip [(e,g) | (_, e, g) <- fieldBlobs] let vec = cToVector isListN es - return (f, vec, concat gs, concatMap fth4 fieldBlobs) + return (f, vec, concat gs) _ -> do isPA <- isPrimAction r isClock <- isClockType r isReset <- isResetType r isInout <- isInoutType r let isIot = isInout/=Nothing - isAV <- isActionValue r let binf = binId prefixes f let wbinf = mkRdyId binf let sel = CSelect var let meth_guard = CApply eUnpack [sel wbinf] - let vs = take (length as) (aIds ++ tmpVarXIds) let qs = if (wbinf `elem` true_ifc_ids || isClock || isReset || isIot) then [] else [CQFilter meth_guard] - let ec = cApply 13 (sel binf) (map (\ v -> CApply ePack [CVar v]) vs) - let e = - case isInout of - Just _ -> (CApply ePrimInoutUncast0 [ec]) - _ -> if (isPA || isClock || isReset) - then ec - else - if isAV - then cApply 12 (CVar idFromActionValue_) [ec] - else CApply eUnpack [ec] - pts <- case (M.lookup binf vfield_map) of - Just (Method { vf_inputs = inps, - vf_output = mo }) -> do - output_type <- if isAV then - getAVType "mkFromBind" r - else return r - return ((maybeToList (fmap (\p -> (p, output_type)) mo)) ++ - zip inps as) - Just (Inout { vf_inout = vn }) -> do - let ty = r - vp = (vn, []) - return [(vp,ty)] - _ -> do --traceM ("no field info: " ++ ppReadable (f, binf, vfield_map)) - return [] - return (f, cLams vs e, qs, pts) + + -- Call fromWrapField with a proxy for the field name as a type level string, + -- and the field selection from the unwrapped module. + let fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) + let e = CApply (CVar idFromWrapField) [fnp, sel binf] + return (f, e, qs) @@ -2007,6 +1940,32 @@ binId :: IfcPrefixes -> Id -> Id binId ifcp i | i == idEmpty = mkId noPosition (concatFString (init (ifcp_pathIdString ifcp))) binId ifcp i = (mkIdPre (concatFString (ifcp_pathIdString ifcp)) (unQualId i)) +fieldPathName :: IfcPrefixes -> Id -> FString +-- XXX horrible hack when there isn't selection required at the end +fieldPathName ifcp i | i == idEmpty = concatFString $ init $ map fixupPathElement $ ifcp_pathIdString ifcp +fieldPathName ifcp i = concatFString $ map fixupPathElement (ifcp_pathIdString ifcp) ++ [getIdBase i] + +fsIndexPlaceholder :: FString +fsIndexPlaceholder = mkFString "[_]" + +-- This has two transformations we want to do on path elements when constructing +-- the String type passed to WrapField for the field-wrapping error message: +-- 1. Replace the "_" separators in the path with "." to match the field selection that +-- would appear in the source. +-- 2. Replace the concrete index numbers in the path with "[_]". This is so that we do +-- not create multiple independent WrapField contexts when wrapping each element of a +-- vector-blasted field. If we use concrete field numbers each WrapField context needs to +-- be resolved individually, leading to repeated construction of the field-wrapping +-- dictionaries. If we use the placeholder all of the WrapField contexts for each +-- vector-blasted field will match so they will be joined into a single context +-- (see joinNeededCtxs in TCMisc.hs) before being resolved, so the field-wrapping +-- dictionaries will be constructed only once. +fixupPathElement :: FString -> FString +fixupPathElement fs + | fs == fsUnderscore = fsDot + | all isDigit (getFString fs) = fsIndexPlaceholder + | otherwise = fs + -- Extend the prefixes -- Take the current set of prefix information, add to that information -- from the the pragma of the current field Id, and add it to the current set of @@ -2220,6 +2179,53 @@ saveTopModPortTypeStmt i t = cVApply idSavePortType [mkMaybe Nothing, stringLiteralAt noPosition s, typeLiteral t] +-- saveFieldPortTypes v "prefix" ["arg1", "arg2"] "result" +mkFieldSavePortTypeStmts :: Maybe CExpr -> Id -> [FInf] -> GWMonad [CStmt] +mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId + where + meth :: IfcPrefixes -> Id -> FInf -> GWMonad [CStmt] + meth prefixes ifcIdIn (FInf f as r aIds) = + do + ciPrags <- getInterfaceFieldPrags ifcIdIn f + mi <- chkInterface r + case (mi, as) of + (Just (ti, _, fts), []) -> do + newprefixes <- extendPrefixes prefixes ciPrags r f + concatMapM (meth newprefixes ti) fts + _ -> do + isVec <- isVectorInterfaces r + case (isVec, as) of + (Just (n, tVec, isListN), []) -> do + let nums = [0..(n-1)] :: [Integer] + let recurse num = do newprefixes <- extendPrefixes prefixes ciPrags r f + meth newprefixes ifcIdIn (FInf (mkNumId num) [] tVec []) + concatMapM recurse nums + _ -> do + -- Compute the local prefix and result name for this field in the flattened interface + -- from the current prefixes and pragmas from the field definition. + let methodStr = getIdBaseString f + currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix + localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) + localPrefix = joinStrings_ currentPre localPrefix1 + mResName = lookupResultIfcPragma ciPrags + resultName = case mResName of + Just str -> joinStrings_ currentPre str + Nothing -> joinStrings_ currentPre methodStr + + -- Arguments to saveFieldPortTypes: proxies for the field name as a type level string and the field type, + -- and the values for the prefix, arg_names, and result pragmas. + let fproxy = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) + proxy = mkTypeProxyExpr $ foldr arrow r as + prefix = stringLiteralAt noPosition localPrefix + arg_names = mkList (getPosition f) [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] + result = stringLiteralAt noPosition resultName + return [ + CSExpr Nothing $ + cVApply idLiftModule $ + [cVApply idSaveFieldPortTypes + [fproxy, proxy, mkMaybe v, prefix, arg_names, result]]] + + saveNameStmt :: Id -> Id -> CMStmt saveNameStmt svName resultVar = CMStmt (CSletseq [(CLValue resultVar [CClause [] [] nameExpr]) []]) where nameExpr = cVApply idGetModuleName [cVApply idAsIfc [CVar svName]] @@ -2232,9 +2238,6 @@ extSel :: CExpr -> Id -> CExpr extSel sel xid | xid == idEmpty = sel extSel sel xid = CSelect sel xid -cLams :: [Id] -> CExpr -> CExpr -cLams is e = foldr (CLam . Right) e is - unLams :: CExpr -> ([CPat], CExpr) unLams (CLam (Right i) e) = ((CPVar i):is, e') where (is, e') = unLams e unLams (CLam (Left p) e) = ((CPAny p):is, e') where (is, e') = unLams e @@ -2262,7 +2265,6 @@ tmod t = TAp (cTCon idModule) t id_t :: Position -> Id id_t pos = mkId pos fs_t - -- ==================== -- Ready method utilities diff --git a/src/comp/GenWrapUtils.hs b/src/comp/GenWrapUtils.hs index eef8e628b..fbca33dd7 100644 --- a/src/comp/GenWrapUtils.hs +++ b/src/comp/GenWrapUtils.hs @@ -9,6 +9,7 @@ import Pragma import PreIds import CSyntax import CType +import Undefined (UndefKind(..)) -- ==================== @@ -87,4 +88,7 @@ getDefArgs dcls t = -- ==================== +mkTypeProxyExpr :: CType -> CExpr +mkTypeProxyExpr ty = CHasType (CAny (getPosition ty) UNotUsed) $ CQType [] ty + diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 677768cb2..25c9875a1 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -253,6 +253,10 @@ iExpand errh flags symt alldefs is_noinlined_func pps def@(IDef mi _ _ _) = do let (iks, args, varginfo, ifc) = goutput go let rules = go_rules go let insts = go_state_vars go + let vclockinfo = go_vclockinfo go + let vresetinfo = go_vresetinfo go + + chkIfcPortNames errh args ifc vclockinfo vresetinfo -- turn heap into IDef definitions let @@ -1021,9 +1025,6 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) | isitInout_ t = do (iinout, e') <- evalInout e let modPos = getPosition modId (ws, fi) <- makeIfcInout modPos i (BetterInfo.mi_prefix bi) iinout - let mType = fmap (snd . itGetArrows) (BetterInfo.mi_orig_type bi) - vname = vf_inout fi - maybe (return ()) (saveTopModPortType vname) mType setIfcSchedNameScopeProgress Nothing return [(IEFace i [] (Just (e',t)) Nothing ws fi)] @@ -1033,8 +1034,12 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) | isRdyId i = iExpandField modId implicitCond clkRst (i, bi, e, t) = do showTopProgress ("Elaborating method " ++ quote (pfpString i)) setIfcSchedNameScopeProgress (Just (IEP_Method i False)) + (_, P p e') <- evalUH e + let (ins, eb) = case e' of + ICon _ (ICMethod _ ins eb) -> (ins, eb) + _ -> internalError ("iExpandField: expected ICMethod: " ++ ppReadable e') (its, ((IDef i1 t1 e1 _), ws1, fi1), ((IDef wi wt we _), ws2, fi2)) - <- iExpandMethod modId 1 [] implicitCond clkRst (i, bi, e) + <- iExpandMethod modId 1 [] (pConj implicitCond p) clkRst (i, bi, ins, eb) let wp1 = wsToProps ws1 -- default clock domain forced in by iExpandField let wp2 = wsToProps ws2 setIfcSchedNameScopeProgress Nothing @@ -1043,10 +1048,10 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) = do -- expand a method iExpandMethod :: Id -> Integer -> [Id] -> HPred -> - (HClock, HReset) -> (Id, BetterInfo.BetterInfo, HExpr) -> + (HClock, HReset) -> (Id, BetterInfo.BetterInfo, [String], HExpr) -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) -iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, e) = do +iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, ins, e) = do when doDebug $ traceM ("iExpandMethod " ++ ppString i ++ " " ++ ppReadable e) (_, P p e') <- evalUH e case e' of @@ -1056,36 +1061,30 @@ iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, e) = do -- a GenWrap-added context that wasn't satisfied, and GenWrap -- should only be adding Bits) errG (reportNonSynthTypeInMethod modId i e') - ILam li ty eb -> iExpandMethodLam modId n args implicitCond clkRst (i, bi, eb) li ty p + ILam li ty eb -> iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p _ -> iExpandMethod' implicitCond curClk (i, bi, e') p iExpandMethodLam :: Id -> Integer -> [Id] -> HPred -> - (HClock, HReset) -> (Id, BetterInfo.BetterInfo, HExpr) -> + (HClock, HReset) -> (Id, BetterInfo.BetterInfo, [String], HExpr) -> Id -> IType -> Pred HeapData -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) -iExpandMethodLam modId n args implicitCond clkRst (i, bi, eb) li ty p = do +iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p = do + -- traceM ("iExpandMethodLam " ++ ppString i ++ " " ++ show ins) + let i' :: Id + i' = mkId (getPosition i) $ mkFString $ head ins -- substitute argument with a modvar and replace with body - let i_n :: Id - i_n = mkIdPost (BetterInfo.mi_prefix bi) (concatFString [fsUnderscore, mkNumFString n]) - i' :: Id - i' = if null (BetterInfo.mi_args bi) then i_n else (BetterInfo.mi_args bi) !! fromInteger (n-1) - eb' :: HExpr - eb' = eSubst li (ICon i' (ICMethArg ty)) eb - -- bi' = if null bi then [] else tail bi - let m_orig_type :: Maybe IType - m_orig_type = fmap ((flip (!!) (fromInteger (n-1))) . fst . itGetArrows) - (BetterInfo.mi_orig_type bi) - maybe (return ()) (saveTopModPortType (id_to_vName i')) m_orig_type - (its, (d, ws1, wf1), (wd, ws2, wf2)) <- - iExpandMethod modId (n+1) (i':args) (pConj implicitCond p) clkRst (i, bi, eb') - let inps :: [VPort] - inps = vf_inputs wf1 - let wf1' :: VFieldInfo - wf1' = case wf1 of - (Method {}) -> wf1 { vf_inputs = ((id_to_vPort i'):inps) } - _ -> internalError "iExpandMethodLam: unexpected wf1" - return ((i', ty) : its, (d, ws1, wf1'), (wd, ws2, wf2)) + eb' :: HExpr + eb' = eSubst li (ICon i' (ICMethArg ty)) eb + (its, (d, ws1, wf1), (wd, ws2, wf2)) <- + iExpandMethod modId (n+1) (i':args) (pConj implicitCond p) clkRst (i, bi, tail ins, eb') + let inps :: [VPort] + inps = vf_inputs wf1 + let wf1' :: VFieldInfo + wf1' = case wf1 of + (Method {}) -> wf1 { vf_inputs = ((id_to_vPort i'):inps) } + _ -> internalError "iExpandMethodLam: unexpected wf1" + return ((i', ty) : its, (d, ws1, wf1'), (wd, ws2, wf2)) iExpandMethod' :: HPred -> HClock -> (Id, BetterInfo.BetterInfo, HExpr) -> Pred HeapData -> @@ -1155,14 +1154,6 @@ iExpandMethod' implicitCond curClk (i, bi, e0) p0 = do let rdyPort :: VPort rdyPort = BetterInfo.mi_ready bi - let mType :: Maybe IType - mType = fmap (snd . itGetArrows) (BetterInfo.mi_orig_type bi) - maybe (return ()) (\t -> do - maybe (return ()) (\(n,_) -> do - if (isActionType methType) then - maybe (return ()) (saveTopModPortType n) (getAVType t) - else saveTopModPortType n t) outputPort) mType - -- split wire sets for more accurate tracking return ([], ((IDef i (iGetType final_e) final_e []), final_ws, @@ -2128,6 +2119,24 @@ evalString e = do _ -> do e'' <- unheapAll e' errG (getIExprPosition e'', EStringNF (ppString e'')) +evalStringList :: HExpr -> G ([String], Position) +evalStringList e = do + e' <- evaleUH e + case e' of + IAps (ICon i _) _ [a] -> + if i == idCons noPosition then do + a' <- evaleUH a + case a' of + IAps (ICon _ (ICTuple {})) _ [e_h, e_t] -> do + (h, _) <- evalString e_h + (t, _) <- evalStringList e_t + return (h:t, getIExprPosition e') + _ -> internalError ("evalStringList Cons: " ++ showTypeless a') + -- We get primChr for Nil, since it's a no-argument constructor + else if i == idPrimChr then return ([], getIExprPosition e') + else internalError ("evalStringList con: " ++ show i) + _ -> nfError "evalStringList" e' + ----------------------------------------------------------------------------- evalHandle :: HExpr -> G Handle @@ -3117,6 +3126,11 @@ conAp' i (ICPrim _ PrimIsRawUndefined) _ (T t : E e : as) = do _ -> -- do traceM ("IsRawUndefined: False") return (P p iFalse) +conAp' i (ICPrim _ PrimMethod) _ [T t, E eInNames, E meth] = do + (inNames, _) <- evalStringList eInNames + P p meth' <- eval1 meth + return $ P p $ ICon (dummyId noPosition) $ ICMethod {iConType = t, iInputNames = inNames, iMethod = meth'} + -- XXX is this still needed? conAp' i (ICUndet { iConType = t }) e as | t == itClock = errG (getIdPosition i, EUndeterminedClock) @@ -4114,7 +4128,7 @@ getBuriedPreds (IAps a@(ICon _ (ICPrim _ PrimBOr)) b [e1, e2]) = do -- the following are followed because they are strict, -- and we want to unheap the references in their arguments getBuriedPreds (IAps a@(ICon _ p@(ICPrim _ _)) b es) = do - --traceM("getBuriedPreds: prim") + -- traceM("getBuriedPreds: prim") ps <- mapM getBuriedPreds es return (foldr1 pConj ps) getBuriedPreds (IAps a@(ICon _ (ICForeign { })) b es) = do @@ -5212,7 +5226,7 @@ reportNonSynthTypeInMethod modId methId methExpr = let str = "The interface method " ++ quote (pfpString methId) ++ " uses type " ++ quote (pfpString v) ++ " which is not in the Bits class." - in (modPos, EBadIfcType modName str) + in (modPos, EBadIfcType (Just modName) str) in case (getNonSynthTypes methExpr) of [] -> -- this shouldn't happen (modPos, EPolyField) @@ -5232,7 +5246,7 @@ reportNonSynthTypeInModuleArg modId modExpr = let str = "A parameter of the module uses the type " ++ quote (pfpString v) ++ " which is not in the Bits class." - in (modPos, EBadIfcType modName str) + in (modPos, EBadIfcType (Just modName) str) in case (getNonSynthTypes modExpr) of [] -> internalError ("IExpand: unexplained module with type parameter: " ++ diff --git a/src/comp/IExpandUtils.hs b/src/comp/IExpandUtils.hs index f61573ecd..f6e3f7ec1 100644 --- a/src/comp/IExpandUtils.hs +++ b/src/comp/IExpandUtils.hs @@ -16,7 +16,7 @@ module IExpandUtils( pushIfcSchedNameScope, popIfcSchedNameScope, setIfcSchedNameScopeProgress, IfcElabProgress(..), addSubmodComments, {-getSubmodComments,-} - addPort, getPortWires, savePortType, saveTopModPortType, + addPort, getPortWires, savePortType, saveRules, getSavedRules, clearSavedRules, replaceSavedRules, setBackendSpecific, cacheDef, addStateVar, step, updHeap, getHeap, {- filterHeapPtrs, -} @@ -35,7 +35,7 @@ module IExpandUtils( addGateUsesToInhigh, addGateInhighAttributes, chkClkArgGateWires, chkClkAncestry, chkClkSiblings, getInputResetClockDomain, setInputResetClockDomain, - chkInputClockPragmas, + chkInputClockPragmas, chkIfcPortNames, getBoundaryClock, getBoundaryClocks, boundaryClockToName, getBoundaryReset, getBoundaryResets, boundaryResetToName, getInputResets, makeInputClk, makeInputRstn, makeOutputClk, makeOutputRstn, @@ -102,6 +102,7 @@ import IWireSet import Pragma(PProp(..), SPIdMap, substSchedPragmaIds, extractSchedPragmaIds, removeSchedPragmaIds) import Util +import Verilog(vKeywords, vIsValidIdent) import IOUtil(progArgs) import ISyntaxXRef(mapIExprPosition, mapIExprPosition2) @@ -1234,9 +1235,6 @@ savePortType minst port t = do old_map put s { portTypeMap = new_map } -saveTopModPortType :: VName -> IType -> G () -saveTopModPortType port t = savePortType Nothing port t - -- --------------- saveRules :: (HClock, HReset) -> IStateLoc -> HPred -> HExpr -> G () @@ -2023,6 +2021,95 @@ chkClkAncestry modName instName pos ancestors clockargnum_map = when (not (null err_pairs)) $ errG (pos, EClockArgAncestors modName instName err_pairs) +chkIfcPortNames :: ErrorHandle -> [IAbstractInput] -> [HEFace] -> VClockInfo -> VResetInfo -> IO () +chkIfcPortNames errh args ifcs (ClockInfo ci co _ _) (ResetInfo ri ro) = + when (not (null emsgs)) $ bsError errh emsgs + where + input_clock_ports i = + case lookup i ci of + Just (Just (VName o, Right (VName g))) -> [o, g] + Just (Just (VName o, Left _)) -> [o] + _ -> [] + output_clock_ports i = + case lookup i co of + Just (Just (VName o, Just (VName g, _))) -> [o, g] + Just (Just (VName o, Nothing)) -> [o] + _ -> [] + input_reset_ports i = + case lookup i ri of + Just (Just (VName r), _) -> [r] + _ -> [] + output_reset_ports i = + case lookup i ro of + Just (Just (VName r), _) -> [r] + _ -> [] + + arg_port_names = [ (getIdBaseString i, i) | IAI_Port (i, _) <- args ] + arg_inout_names = [ (getIdBaseString i, i) | IAI_Inout i _ <- args ] + arg_clock_names = [ (n, i) | IAI_Clock i _ <- args, n <- input_clock_ports i ] + arg_reset_names = [ (n, i) | IAI_Reset i <- args, n <- input_reset_ports i ] + + default_clock_names = [ (n, idDefaultClock) | n <- input_clock_ports idDefaultClock ] + default_reset_names = [ (n, idDefaultReset) | n <- input_reset_ports idDefaultReset ] + + arg_names = sort $ + arg_port_names ++ arg_inout_names ++ arg_clock_names ++ arg_reset_names ++ + default_clock_names ++ default_reset_names + + ifc_port_names = + [ (n, i) + | IEFace {ief_fieldinfo = Method i _ _ _ ins out en} <- ifcs, + (VName n, _) <- ins ++ maybeToList out ++ maybeToList en ] + ifc_inout_names = + [ (n, i) | IEFace {ief_fieldinfo = Inout i (VName n) _ _} <- ifcs ] + ifc_clock_names = + [ (n, i) | IEFace {ief_fieldinfo = Clock i} <- ifcs, n <- output_clock_ports i ] + ifc_reset_names = + [ (n, i) | IEFace {ief_fieldinfo = Reset i} <- ifcs, n <- output_reset_ports i ] + ifc_names = sort $ ifc_port_names ++ ifc_inout_names ++ ifc_clock_names ++ ifc_reset_names + + -- --------------- + -- check that no ifc port name clashes with another port name and + -- check that no ifc port name clashes with a Verilog keyword and + -- check that each ifc port name is a valid Verilog identifier + ifc_same_name = filter (\xs -> (length xs) > 1) $ + groupBy (\(n1,_) (n2,_) -> n1 == n2) ifc_names + ifc_kw_clash = filter (\(n,_) -> n `elem` vKeywords) ifc_names + ifc_bad_ident = filter (\(n,_) -> not (vIsValidIdent n)) ifc_names + emsgs0 = let mkErr xs = + let ns = [(n, getPosition i, getIdBaseString i) + | (n,i) <- xs ] + in case ns of + ((v,p1,m1):(_,p2,m2):_) -> + (p1, EPortNamesClashFromMethod m1 m2 v p2) + _ -> internalError ("emsg0: impossible") + in map mkErr ifc_same_name + emsgs1 = let mkErr (n,i) = (getPosition i, + EPortKeywordClashFromMethod + (getIdBaseString i) n) + in map mkErr ifc_kw_clash + emsgs2 = let mkErr (n,i) = (getPosition i, + EPortNotValidIdentFromMethod + (getIdBaseString i) n) + in map mkErr ifc_bad_ident + + -- --------------- + -- check that no arg port clashes with an ifc port + ifc_ports_map = M.fromList ifc_names + + findIfcPortName (p, a) = + case M.lookup p ifc_ports_map of + Nothing -> Nothing + Just m -> Just (p, m, a) + + arg_ifc_dups = catMaybes $ map findIfcPortName arg_names + emsgs3 = let mkErr (p,m,a) = (getPosition a, + EPortNamesClashArgAndIfc + p (getIdBaseString a) (getIdBaseString m) (getPosition m)) + in map mkErr arg_ifc_dups + + emsgs = emsgs0 ++ emsgs1 ++ emsgs2 ++ emsgs3 + -- --------------- {-# INLINE newStateNo #-} diff --git a/src/comp/ISyntax.hs b/src/comp/ISyntax.hs index 6c823682f..4bb08b7f5 100644 --- a/src/comp/ISyntax.hs +++ b/src/comp/ISyntax.hs @@ -821,6 +821,8 @@ data IConInfo a = -- as an argument to PrimAddSchedPragmas (applied to rules). -- only exists before expansion | ICSchedPragmas { iConType :: IType, iPragmas :: [CSchedulePragma] } + + | ICMethod { iConType :: IType, iInputNames :: [String], iMethod :: IExpr a } | ICClock { iConType :: IType, iClock :: IClock a } | ICReset { iConType :: IType, iReset :: IReset a } -- iReset has effective type itBit1 | ICInout { iConType :: IType, iInout :: IInout a } @@ -870,6 +872,7 @@ ordC (ICAttrib { }) = 28 ordC (ICPosition { }) = 29 ordC (ICType { }) = 30 ordC (ICPred { }) = 31 +ordC (ICMethod { }) = 32 instance Eq (IConInfo a) where x == y = cmpC x y == EQ @@ -914,6 +917,8 @@ cmpC c1 c2 = ICIFace { ifcTyId = ti1, ifcIds = is1 } -> compare (ti1, is1) (ifcTyId c2, ifcIds c2) ICRuleAssert { iAsserts = asserts } -> compare asserts (iAsserts c2) ICSchedPragmas { iPragmas = pragmas } -> compare pragmas (iPragmas c2) + ICMethod { iInputNames = inames1, iMethod = meth1 } -> + compare (inames1, meth1) (iInputNames c2, iMethod c2) -- the ICon Id is not sufficient for equality comparison for Clk/Rst ICClock { iClock = clock1 } -> compare clock1 (iClock c2) ICReset { iReset = reset1 } -> compare reset1 (iReset c2) @@ -1238,6 +1243,7 @@ instance NFData (IConInfo a) where rnf (ICIFace x1 x2 x3) = rnf3 x1 x2 x3 rnf (ICRuleAssert x1 x2) = rnf2 x1 x2 rnf (ICSchedPragmas x1 x2) = rnf2 x1 x2 + rnf (ICMethod x1 x2 x3) = rnf3 x1 x2 x3 rnf (ICClock x1 x2) = rnf2 x1 x2 rnf (ICReset x1 x2) = rnf2 x1 x2 rnf (ICInout x1 x2) = rnf2 x1 x2 @@ -1459,6 +1465,7 @@ showTypelessCI (ICValue {iConType = t, iValDef = e}) = "(ICValue)" showTypelessCI (ICIFace {iConType = t, ifcTyId = i, ifcIds = ids}) = "(ICIFace _ " ++ (show i) ++ " " ++ (show ids) ++ ")" showTypelessCI (ICRuleAssert {iConType = t, iAsserts = rps}) = "(ICRuleAssert _ " ++ (show rps) ++ ")" showTypelessCI (ICSchedPragmas {iConType = t, iPragmas = sps}) = "(ICSchedPragmas _ " ++ (show sps) ++ ")" +showTypelessCI (ICMethod {iConType = t, iInputNames = ins, iMethod = m }) = "(ICMethod " ++ (show ins) ++ " " ++ (ppReadable m) ++ ")" showTypelessCI (ICClock {iConType = t, iClock = clock}) = "(ICClock)" showTypelessCI (ICReset {iConType = t, iReset = reset}) = "(ICReset)" showTypelessCI (ICInout {iConType = t, iInout = inout}) = "(ICInout)" diff --git a/src/comp/IfcBetterInfo.hs b/src/comp/IfcBetterInfo.hs index d7a37c96a..8baded88b 100644 --- a/src/comp/IfcBetterInfo.hs +++ b/src/comp/IfcBetterInfo.hs @@ -17,9 +17,6 @@ import Pragma import PPrint import IdPrint import VModInfo -import FStringCompat(mkFString) -import ISyntax -import IConv(iConvT) -- import Util(traces) @@ -31,9 +28,7 @@ data BetterInfo = BetterMethodInfo mi_result :: VPort, -- possible rename for method result mi_ready :: VPort, -- for ready signal mi_enable :: VPort, -- for enable signal - mi_prefix :: Id, -- default prefix for arguments (which are not found in classic) - mi_args :: [Id], -- for arguments - mi_orig_type :: Maybe IType -- original (unwrapped) field type + mi_prefix :: Id -- default prefix for arguments (which are not found in classic) } -- XXX Note that the following are unused -- XXX (this package needs re-thinking) @@ -57,9 +52,7 @@ noMethodInfo fieldId = BetterMethodInfo {mi_id = fieldId, mi_result = id_to_vPort fieldId, mi_ready = id_to_vPort $ mkRdyId fieldId, mi_enable = id_to_vPort $ mkEnableId fieldId, - mi_prefix = fieldId, - mi_args = [], - mi_orig_type = Nothing + mi_prefix = fieldId } @@ -68,9 +61,7 @@ instance PPrint BetterInfo where ( printMaybe d i "Result:" (mi_result info) <> printMaybe d i "Ready:" (mi_ready info) <> printMaybe d i "Enable:" (mi_enable info) <> - text "Prefix:" <> pPrint d i (mi_prefix info) <> - text "Args:" <> pPrint d i (mi_args info) <> - printMaybe d i "Original type:" (mi_orig_type info) + text "Prefix:" <> pPrint d i (mi_prefix info) ) printMaybe :: PPrint a => PDetail -> Int -> String -> a -> Doc @@ -105,22 +96,7 @@ fieldInfoToBetterInfo flags symTab (fieldId, Just fi) = mi_result = maybe (id_to_vPort fieldId) (str_to_vPort) mres, mi_ready = maybe (id_to_vPort $ mkRdyId fieldId) str_to_vPort mrdy, mi_enable = maybe (id_to_vPort $ mkEnableId fieldId) str_to_vPort men, - mi_prefix = maybe fieldId (setIdBaseString fieldId) mprefix, - mi_args = args, - mi_orig_type = fmap (iConvT flags symTab) (fi_orig_type fi) + mi_prefix = maybe fieldId (setIdBaseString fieldId) mprefix } where prags = fi_pragmas fi - (mprefix,mres,mrdy,men,rawargs,_,_) = getMethodPragmaInfo prags - args = genArgNames mprefix fieldId rawargs - - --- Create a list of Ids for method argument names --- Used by IExpand thru IfcbetterNames maybe move it here --- Note that this only uses IPrefixStr and iArgNames, which must be --- kept on the FieldInfo in the SymTab -genArgNames :: Maybe String -> Id -> [Id] -> [Id] -genArgNames mprefix fieldId ids = map (addPrefix mprefix fieldId) ids - where addPrefix :: Maybe String -> Id -> Id -> Id - addPrefix Nothing fid aid = mkUSId fid aid - addPrefix (Just "") _ aid = aid - addPrefix (Just pstr) _ aid = mkIdPre (mkFString $ pstr ++ "_" ) aid + (mprefix,mres,mrdy,men,_,_,_) = getMethodPragmaInfo prags diff --git a/src/comp/MakeSymTab.hs b/src/comp/MakeSymTab.hs index 51d9d21c3..39ef7bc4f 100644 --- a/src/comp/MakeSymTab.hs +++ b/src/comp/MakeSymTab.hs @@ -602,7 +602,7 @@ chkTopDef r mi isDep (Cprimitive i ct) = do chkTopDef r mi isDep (CIValueSign i ct) = do sc <- mkSchemeWithSymTab r ct return [(i, VarInfo VarDefn (i :>: sc) (isDep i))] -chkTopDef r mi isDep (Cforeign i qt on ops) = do +chkTopDef r mi isDep (Cforeign i qt on ops ni) = do sc@(Forall _ (_ :=> t)) <- mkSchemeWithSymTab r qt let name = case on of Just s -> s @@ -622,7 +622,9 @@ chkTopDef r mi isDep (Cforeign i qt on ops) = do in (all isGoodArg args) && (isGoodResult res) let i' = qual mi i - if isGoodType (expandSyn t) then + -- This check is skipped for noinline-created foreign functions, since their type is + -- determined by the WrapField type class, and a bad foreign type will raise an error in typecheck. + if ni || isGoodType (expandSyn t) then return [(i', VarInfo (VarForg name ops) (i' :>: sc) (isDep i))] else throwError (getPosition i, EForeignNotBit (pfpString i) (pfpString t)) diff --git a/src/comp/Parser/Classic/CParser.hs b/src/comp/Parser/Classic/CParser.hs index 6b2173425..6e37b20b6 100644 --- a/src/comp/Parser/Classic/CParser.hs +++ b/src/comp/Parser/Classic/CParser.hs @@ -406,7 +406,7 @@ pVarDefn = (pVarId +.+ dc ..+ pQType +.. dsm `into` \(var, typ) -> pClauses1 v pTyDefn :: Bool -> CParser CDefn pTyDefn b = l L_foreign ..+ pVarId +.+ dc ..+ pQType +.+ opt (eq ..+ pString) +.+ opt (cm ..+ lp ..+ many pString +.+ pForeignRes +.. rp) - >>>>> Cforeign + >>>>> (\ i qt on ops -> Cforeign i qt on ops False) ||! l L_primitive ..+ pVarId +.+ dc ..+ pQType >>> Cprimitive -- ||! l L_primitive ..+ l L_class ..+ pPreds +.+ pTyConIdK +.+ many pTyVarId +.+ pFunDeps >>>>> CprimClass ||! l L_primitive ..+ l L_type ..+ pTyConId +.+ dc ..+ pKind >>- (\ (i, k) -> CprimType (IdKind i k)) diff --git a/src/comp/Parser/Classic/Warnings.hs b/src/comp/Parser/Classic/Warnings.hs index 7f68511da..ea0b447d5 100644 --- a/src/comp/Parser/Classic/Warnings.hs +++ b/src/comp/Parser/Classic/Warnings.hs @@ -32,7 +32,7 @@ classicWarnings (CPackage _ _ _ _ ds _) = concatMap getWarnings ds getBound (CValue i _) = [i] getBound (CValueSign (CDef i _ _)) = [i] getBound (CValueSign (CDefT i _ _ _)) = [i] - getBound (Cforeign i _ _ _) = [i] + getBound (Cforeign i _ _ _ _) = [i] getBound (Cprimitive i _) = [i] getBound (CprimType {}) = [] getBound (CPragma {}) = [] diff --git a/src/comp/PragmaCheck.hs b/src/comp/PragmaCheck.hs index 56fdeff33..bd7701396 100644 --- a/src/comp/PragmaCheck.hs +++ b/src/comp/PragmaCheck.hs @@ -11,17 +11,15 @@ import Control.Monad(msum) import Data.List(groupBy, sort, partition, nub, intersect) import Data.Maybe(listToMaybe, mapMaybe, catMaybes, fromMaybe) -import Util(thd, fst3, headOrErr, fromJustOrErr) +import Util(thd, fst3, headOrErr) import Verilog(vKeywords, vIsValidIdent) -import Error(internalError, EMsg, ErrMsg(..)) +import Error(EMsg, ErrMsg(..)) import ErrorMonad(ErrorMonad(..)) -import PFPrint import Position import Id -import PreIds(idDefaultClock, idDefaultReset, idCLK, idCLK_GATE, - idPrimAction, idActionValue_, mk_no) +import PreIds(idDefaultClock, idDefaultReset, idCLK, idCLK_GATE, mk_no) import FStringCompat import PreStrings(fsUnderscore) @@ -29,7 +27,7 @@ import Flags(Flags(..)) import Pragma import CType -import Type(tClock, tReset, tInout_) +import Type(tClock, tReset) -- ============================== @@ -559,85 +557,9 @@ checkModulePortNames flgs pos pps vtis ftps = isClkField (_,t,_) = t == tClock isRstField (_,t,_) = t == tReset - isInoutField (_,t,_) = case t of - (TAp tt _) | (tt == tInout_) -> True - _ -> False - - getMString :: Maybe String -> String - getMString (Just str) = str - getMString Nothing = internalError ("getMString: empty field") (clk_fs, other_fs) = partition isClkField ftps - (rst_fs, other_fs') = partition isRstField other_fs - (iot_fs, method_fs) = partition isInoutField other_fs' - - ifc_clock_ports = - let mkClockPorts (i,_,ps) = - let mpref = getClockPragmaInfo ps - -- convert to Id and back, to reuse "mkPortName" - pref_id = mk_homeless_id $ getMString $ mpref - osc = mkPortName idCLK osc_prefix Nothing pref_id - gate = mkPortName idCLK_GATE gate_prefix Nothing pref_id - in [(getIdBaseString osc, i), - (getIdBaseString gate, i)] - in concatMap mkClockPorts clk_fs - - ifc_reset_ports = - let mkResetPort (i,_,ps) = - let mpref = getResetPragmaInfo ps - -- convert to Id and back, to reuse "mkPortName" - pref_id = mk_homeless_id $ getMString $ mpref - p = mkPortName idrstn rst_prefix Nothing pref_id - in (getIdBaseString p, i) - in map mkResetPort rst_fs - - ifc_inout_ports = - let mkInoutPort (i,t,ps) = - let pref = getMString $ getInoutPragmaInfo ps - in (pref, i) - in map mkInoutPort iot_fs - - ifc_method_ports = - let mkMethodPorts (i,t,ps) = - let resType = getRes t - resTypeId = fromJustOrErr - ("ifc_method_ports: " ++ ppReadable t) - (leftCon resType) - -- XXX can PrimAction ever occur? - -- XXX (Maybe if explicitly written?) - -- The types Action and ActionValue (which should be the - -- only types written by the user) become ActionValue_ - -- in the flattened interface (with Action being size 0). - -- So ActionValue_ should be only type seen. - isPA = (qualEq resTypeId idPrimAction) - isAV = (qualEq resTypeId idActionValue_) - -- If the user wrote "Action" the flattened ifc is - -- ActionValue_#(0). If the user wrote ActionValue#(t) - -- then the flattened ifc is ActionValue#(sz), where - -- "sz" is a variable reference in context Bits#(t,sz). - -- If GenWrap did ctxReduce, then these variables would - -- go away (if not, then we'd error, as iExpand does - -- now). In the meantime, just look for explicit 0. - isAV0 = case resType of - (TAp (TCon (TyCon av _ _)) (TCon (TyNum n _))) - | qualEq av idActionValue_ -> (n == 0) - _ -> False - (mpref, mres, mrdy, men, argids, ar, ae) = - getMethodPragmaInfo ps - res = if (isPA || isAV0) then [] else [getMString mres] - rdy = if (ar) then [] else [getMString mrdy] - en = if (not ae) && (isAV || isPA) - then [getMString men] else [] - argToName :: String -> Id -> String - argToName pstr aid = joinStrings_ pstr (getIdString aid) - args = map (argToName (getMString mpref)) argids - in - if (isRdyId i) then [] - else zip (res ++ rdy ++ en ++ args) (repeat i) - in concatMap mkMethodPorts method_fs - - all_ifc_info = ifc_clock_ports ++ ifc_reset_ports ++ - ifc_inout_ports ++ ifc_method_ports + (rst_fs, _) = partition isRstField other_fs -- --------------- -- check that no arg port name clashes with another port name and @@ -663,52 +585,6 @@ checkModulePortNames flgs pos pps vtis ftps = emsgs2 = let mkErr (n,i) = (getPosition i, EPortNotValidIdent n) in map mkErr arg_bad_ident - -- --------------- - -- check that no ifc port name clashes with another port name and - -- check that no ifc port name clashes with a Verilog keyword and - -- check that each ifc port name is a valid Verilog identifier - - ifc_names = sort all_ifc_info - ifc_same_name = filter (\xs -> (length xs) > 1) $ - groupBy (\(n1,_) (n2,_) -> n1 == n2) ifc_names - ifc_kw_clash = filter (\(n,_) -> n `elem` vKeywords) ifc_names - ifc_bad_ident = filter (\(n,_) -> not (vIsValidIdent n)) ifc_names - emsgs3 = let mkErr xs = - let ns = [(n, getPosition i, getIdBaseString i) - | (n,i) <- xs ] - in case ns of - ((v,p1,m1):(_,p2,m2):_) -> - (p1, EPortNamesClashFromMethod m1 m2 v p2) - _ -> internalError ("emsg3: impossible") - in map mkErr ifc_same_name - emsgs4 = let mkErr (n,i) = (getPosition i, - EPortKeywordClashFromMethod - (getIdBaseString i) n) - in map mkErr ifc_kw_clash - emsgs5 = let mkErr (n,i) = (getPosition i, - EPortNotValidIdentFromMethod - (getIdBaseString i) n) - in map mkErr ifc_bad_ident - - -- --------------- - -- check that no arg port clashes with an ifc port - - - ifc_ports_map = M.fromList ifc_names - - findIfcPortName api@(API { api_port = Just p }) = - case (M.lookup (getIdBaseString p) ifc_ports_map) of - Nothing -> Nothing - Just m -> Just (p, m, getAPIArgName api) - findIfcPortName (API { api_port = Nothing }) = Nothing - - arg_ifc_dups = catMaybes $ map findIfcPortName all_arg_info - emsgs6 = let mkErr (p,m,a) = (pos, - EPortNamesClashArgAndIfc - (pfpString p) (pfpString a) - (pfpString m) (getPosition m)) - in map mkErr arg_ifc_dups - -- --------------- -- warn if a prefix is supplied but never used @@ -755,8 +631,7 @@ checkModulePortNames flgs pos pps vtis ftps = -- report any errors or warnings -- report all errors, since none trump any others - emsgs = emsgs0 ++ emsgs1 ++ emsgs2 ++ emsgs3 ++ - emsgs4 ++ emsgs5 ++ emsgs6 + emsgs = emsgs0 ++ emsgs1 ++ emsgs2 wmsgs = wmsgs0 ++ wmsgs1 @@ -768,12 +643,3 @@ checkModulePortNames flgs pos pps vtis ftps = -- ============================== - --- XXX copied from GenWrap --- Join string together with an underscore if either is not empty. -joinStrings_ :: String -> String -> String -joinStrings_ "" s2 = s2 -joinStrings_ s1 "" = s1 -joinStrings_ s1 s2 = s1 ++ "_" ++ s2 - --- ============================== diff --git a/src/comp/PreIds.hs b/src/comp/PreIds.hs index 984ab6990..9036e06c9 100644 --- a/src/comp/PreIds.hs +++ b/src/comp/PreIds.hs @@ -236,6 +236,12 @@ idPolyWrapField = mk_no fsPolyWrapField idLiftModule :: Id idLiftModule = prelude_id_no fsLiftModule +idWrapField, idFromWrapField, idToWrapField, idSaveFieldPortTypes :: Id +idWrapField = prelude_id_no fsWrapField +idFromWrapField = prelude_id_no fsFromWrapField +idToWrapField = prelude_id_no fsToWrapField +idSaveFieldPortTypes = prelude_id_no fsSaveFieldPortTypes + -- Used by desugaring id_lam, id_if, id_read, id_write :: Position -> Id id_lam pos = mkId pos fs_lam @@ -303,14 +309,13 @@ idSJump pos = mkId pos fsSJump idSNamed pos = mkId pos fsSNamed idS pos = mkId pos fsS idStmt pos = mkId pos fsStmt -idSBreak, idSContinue, idSReturn, idCons, idConcat :: Position -> Id +idSBreak, idSContinue, idSReturn, idCons :: Position -> Id idSBreak pos = mkId pos fsSBreak idSContinue pos = mkId pos fsSContinue idSReturn pos = mkId pos fsSReturn -idCons pos = mkId pos fsCons -idConcat pos = mkId pos fsConcat +idCons pos = prelude_id pos fsCons idNil, idNothing, idSprime :: Position -> Id -idNil pos = mkId pos fsNil +idNil pos = prelude_id pos fsNil idNothing pos = mkId pos fsNothing idSprime pos = mkId pos fsSprime diff --git a/src/comp/PreStrings.hs b/src/comp/PreStrings.hs index fa17548ab..c4e2efbcf 100644 --- a/src/comp/PreStrings.hs +++ b/src/comp/PreStrings.hs @@ -345,6 +345,10 @@ fsMetaConsNamed = mkFString "MetaConsNamed" fsMetaConsAnon = mkFString "MetaConsAnon" fsMetaField = mkFString "MetaField" fsPolyWrapField = mkFString "val" +fsWrapField = mkFString "WrapField" +fsFromWrapField = mkFString "fromWrapField" +fsToWrapField = mkFString "toWrapField" +fsSaveFieldPortTypes = mkFString "saveFieldPortTypes" -- XXX low ASCII only, please... sAcute = "__" @@ -388,7 +392,6 @@ fsSBreak = mkFString "SBreak" fsSContinue = mkFString "SContinue" fsSReturn = mkFString "SReturn" fsCons = mkFString "Cons" -fsConcat = mkFString "concat" fsNil = mkFString "Nil" fsNothing = mkFString "Nothing" fsSprime = mkFString "_s__" diff --git a/src/comp/Prim.hs b/src/comp/Prim.hs index dbfc1d331..1702b4d50 100644 --- a/src/comp/Prim.hs +++ b/src/comp/Prim.hs @@ -64,6 +64,8 @@ data PrimOp = | PrimInoutCast | PrimInoutUncast + | PrimMethod + | PrimIf | PrimMux | PrimPriMux @@ -354,6 +356,7 @@ toPrim i = tp (getIdBaseString i) -- XXXXX tp "primBOr" = PrimBOr tp "primInoutCast" = PrimInoutCast tp "primInoutUncast" = PrimInoutUncast + tp "primMethod" = PrimMethod tp "primIntegerToBit" = PrimIntegerToBit tp "primIntegerToUIntBits" = PrimIntegerToUIntBits tp "primIntegerToIntBits" = PrimIntegerToIntBits @@ -671,6 +674,7 @@ instance NFData PrimOp where rnf PrimBOr = () rnf PrimInoutCast = () rnf PrimInoutUncast = () + rnf PrimMethod = () rnf PrimIf = () rnf PrimMux = () rnf PrimPriMux = () diff --git a/src/comp/TCheck.hs b/src/comp/TCheck.hs index 74b62ffef..036cfcf67 100644 --- a/src/comp/TCheck.hs +++ b/src/comp/TCheck.hs @@ -2639,7 +2639,7 @@ tiExpl''' as0 i sc alts me (oqt@(oqs :=> ot), vts) = do -- Were any contexts without variables left unsatisfied? if not (null uds) then -- Report reduction errors - handleContextReduction (getPosition i) uds + handleContextReduction Nothing (getPosition i) uds else -- No ambiguous variables, so... -- Produce the return values (deferred preds, CDefl) diff --git a/src/comp/TypeCheck.hs b/src/comp/TypeCheck.hs index 0de5020b9..eae82833a 100644 --- a/src/comp/TypeCheck.hs +++ b/src/comp/TypeCheck.hs @@ -72,7 +72,7 @@ tiOneDef :: CDefn -> TI CDefn tiOneDef d@(CValueSign (CDef i t s)) = do --trace ("TC " ++ ppReadable i) $ return () (rs, ~(CLValueSign d' _)) <- tiExpl nullAssump (i, t, s, []) - checkTopPreds d rs + checkTopPreds (Just i) d rs s <- getSubst' clearSubst return (CValueSign (apSub s d')) @@ -91,7 +91,7 @@ tiOneDef d@(Cclass incoh cps ik is fd fs) = do fqt' = CQType fps' fty (rs, ~(CLValueSign (CDefT _ _ _ fcs') _)) <- tiExpl nullAssump (fid, fqt', fcs, []) - checkTopPreds fid rs + checkTopPreds (Just fid) fid rs clearSubst return (f { cf_default = fcs' }) fs' <- mapM tiF fs @@ -113,9 +113,9 @@ getSubst' = do if s == s then return s else internalError "TypeCheck.getSubst': s /= s (WTF!?)" -- Any predicates at the top level should be reported as an error -checkTopPreds :: (HasPosition a, PPrint a) => a -> [VPred] -> TI () -checkTopPreds _ [] = return () -checkTopPreds a ps = do +checkTopPreds :: (HasPosition a, PPrint a) => Maybe Id -> a -> [VPred] -> TI () +checkTopPreds _ _ [] = return () +checkTopPreds mid a ps = do -- reduce the predicates as much as possible (ps', ls) <- satisfy [] ps if null ps' then @@ -123,7 +123,7 @@ checkTopPreds a ps = do internalError ("checkTopPreds " ++ ppReadable (a, ps)) else do addExplPreds [] -- add en empty context - handleContextReduction (getPosition a) ps' + handleContextReduction mid (getPosition a) ps' -- typecheck an expression as a top-level object -- returning any unsatisfied preds diff --git a/src/comp/bluetcl.hs b/src/comp/bluetcl.hs index 185545a3d..3edca23b7 100644 --- a/src/comp/bluetcl.hs +++ b/src/comp/bluetcl.hs @@ -826,7 +826,7 @@ tclDefs xs = internalError $ "tclDefs: grammar mismatch: " ++ (show xs) -- XXX the argument names and we could display them. displayCDefn :: CDefn -> [HTclObj] displayCDefn (CIValueSign i cqt) = [displayTypeSignature i cqt] -displayCDefn (Cforeign i cqt _ _) = [displayTypeSignature i cqt] +displayCDefn (Cforeign i cqt _ _ _) = [displayTypeSignature i cqt] displayCDefn (Cprimitive i cqt) = [displayTypeSignature i cqt] displayCDefn (CValue i _) = internalError ("displayCDefn: unexpected CValue: " ++ ppReadable i) diff --git a/testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp b/testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp index 82b0d4347..1bd8faafb 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp +++ b/testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp @@ -18,8 +18,8 @@ if { $ctest == 1 } { # backend, and only then if the user has specified that it's OK # for the Verilog and Bluesim backends to diverge). # - find_regexp mkTop.cxx {2047u \& \(\(\(\(\(tUInt32\)\(\(tUInt8\)0u\)\) << 3u\) \| \(\(\(tUInt32\)\(DEF_cond__h[0-9]+\)\) << 2u\)\) \| \(tUInt32\)\(DEF_v__h178\)\);} - find_regexp mkTop.cxx {DEF_v__h178 = DEF_AVMeth_s_m;} + find_regexp mkTop.cxx {2047u \& \(\(\(\(\(tUInt32\)\(\(tUInt8\)0u\)\) << 3u\) \| \(\(\(tUInt32\)\(DEF_cond__h[0-9]+\)\) << 2u\)\) \| \(tUInt32\)\(DEF_v__h195\)\);} + find_regexp mkTop.cxx {DEF_v__h195 = DEF_AVMeth_s_m;} } # Also test that BSC fully initializes DEF_AVMeth_s_m diff --git a/testsuite/bsc.bugs/bluespec_inc/b292/mkDesign.v.expected b/testsuite/bsc.bugs/bluespec_inc/b292/mkDesign.v.expected index 7d9339f4a..f10ea3502 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b292/mkDesign.v.expected +++ b/testsuite/bsc.bugs/bluespec_inc/b292/mkDesign.v.expected @@ -140,11 +140,11 @@ module mkDesign(clk, i_enable && i_count != 4'd4 ; // remaining internal signals + assign x__h778 = i_count + 4'd1 ; assign x__h592 = { 4'b0, shift_and_add_a } ; assign x__h508 = i_acc + i_multiplicand ; assign x__h704 = { 1'd0, i_mult[3:1] } ; assign x__h741 = { i_multiplicand[6:0], 1'd0 } ; - assign x__h778 = i_count + 4'd1 ; // handling of inlined registers diff --git a/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs b/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs new file mode 100644 index 000000000..b54196d3e --- /dev/null +++ b/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs @@ -0,0 +1,14 @@ +package NestedIfcIntegerArg where + +interface Foo = + put :: Integer -> Action + +interface Bar = + f :: Foo + +{-# synthesize mkBar #-} +mkBar :: Module Bar +mkBar = module + interface + f = interface Foo + put _ = noAction diff --git a/testsuite/bsc.codegen/signature/signature.exp b/testsuite/bsc.codegen/signature/signature.exp index f560b908f..e33bf0603 100644 --- a/testsuite/bsc.codegen/signature/signature.exp +++ b/testsuite/bsc.codegen/signature/signature.exp @@ -10,6 +10,7 @@ compile_verilog_fail_error ProvisoMethod.bsv T0043 compile_verilog_fail_error NonBitsModuleArg.bsv T0043 compile_verilog_fail_error NonIfc.bsv T0043 compile_verilog_fail_error NonModule.bsv T0043 1 sysNonModule +compile_verilog_fail_error NestedIfcIntegerArg.bs T0043 # Test that types which are not simple constructors (but have arguments) # are also handled diff --git a/testsuite/bsc.codegen/vector_interfaces/WrapFieldRepeat.bs b/testsuite/bsc.codegen/vector_interfaces/WrapFieldRepeat.bs new file mode 100644 index 000000000..696f0811f --- /dev/null +++ b/testsuite/bsc.codegen/vector_interfaces/WrapFieldRepeat.bs @@ -0,0 +1,14 @@ +package WrapFieldRepeat where + +import Vector + +interface WrapFieldRepeat = + regs :: Vector 16 (Reg Bool) + +{-# verilog mkWrapFieldRepeat #-} +mkWrapFieldRepeat :: (IsModule m c) => m WrapFieldRepeat +mkWrapFieldRepeat = module + regs :: Vector 16 (Reg Bool) <- replicateM (mkReg True) + interface + regs = regs + diff --git a/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp b/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp index 8e919880d..4b6d1412e 100644 --- a/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp +++ b/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp @@ -6,3 +6,9 @@ compare_verilog mkClockVectorPassThrough.v compile_verilog_pass SizeZero.bsv +# We substitute _ for vector indices in the string types passed to WrapField in GenWrap.hs +# to ensure that theinstance dictionaries can be combined for vector-blasted interfaces. +# This relies on the -dtypecheck dump from wrapper compilation +# overwriting the original -dtypecheck dump. +compile_object_pass WrapFieldRepeat.bs {} "-dtypecheck=tcwrapper.out" +find_n_strings tcwrapper.out "Prelude.Bits Prelude.Bool 1" 2 diff --git a/testsuite/bsc.lib/Prelude/AppendTuple.bs b/testsuite/bsc.lib/Prelude/AppendTuple.bs new file mode 100644 index 000000000..ddb8a2b56 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/AppendTuple.bs @@ -0,0 +1,130 @@ +package AppendTuple where + +import CShow + +-- Test the AppendTuple type class + +{-# verilog sysAppendTuple #-} +sysAppendTuple :: Module Empty +sysAppendTuple = + module + counter :: Reg (UInt 5) <- mkReg 0 + + rules + "test0": when counter == 0 ==> action + $display "=== Testing AppendTuple ===" + -- Test appendTuple with two empty tuples + let u1 :: () + u1 = () + let u2 :: () + u2 = () + let result :: () + result = appendTuple u1 u2 + $display "appendTuple((), ()) = () [unit type]" + counter := counter + 1 + + "test1": when counter == 1 ==> action + -- Test appendTuple with unit type (left) + let t1 :: (Bool, Int 8) + t1 = (True, 42) + let t2 :: (Bool, Int 8) + t2 = appendTuple () t1 + $display "appendTuple((), (True, 42)) = " (cshow t2) + counter := counter + 1 + + "test2": when counter == 2 ==> action + -- Test appendTuple with unit type (right) + let t1 :: (Bool, Int 8) + t1 = (False, negate 10) + let t2 :: (Bool, Int 8) + t2 = appendTuple t1 () + $display "appendTuple((False, -10), ()) = " (cshow t2) + counter := counter + 1 + + "test3": when counter == 3 ==> action + -- Test append two 2-tuples to create 4-tuple + let t1 :: (Bool, Int 8) + t1 = (True, 5) + let t2 :: (UInt 4, Bit 3) + t2 = (12, 0b101) + let t4 :: (Bool, Int 8, UInt 4, Bit 3) + t4 = appendTuple t1 t2 + $display "appendTuple((True, 5), (12, 0b101)) = " (cshow t4) + counter := counter + 1 + + "test4": when counter == 4 ==> action + -- Test append single element and 2-tuple to create 3-tuple + let b :: Bool + b = False + let t2 :: (Int 8, UInt 4) + t2 = (negate 3, 7) + let t3 :: (Bool, Int 8, UInt 4) + t3 = appendTuple b t2 + $display "appendTuple(False, (-3, 7)) = " (cshow t3) + counter := counter + 1 + + "test5": when counter == 5 ==> action + -- Test append 3-tuple and single element to create 4-tuple + let t3 :: (Bool, Int 8, UInt 4) + t3 = (True, 20, 8) + let b :: Bit 5 + b = 0b11010 + let t4 :: (Bool, Int 8, UInt 4, Bit 5) + t4 = appendTuple t3 b + $display "appendTuple((True, 20, 8), 0b11010) = " (cshow t4) + counter := counter + 1 + + "test6": when counter == 6 ==> action + -- Test append 2-tuple and 3-tuple to create 5-tuple + let t2 :: (Bool, Int 8) + t2 = (False, 15) + let t3 :: (UInt 4, Bit 3, Int 16) + t3 = (6, 0b111, negate 100) + let t5 :: (Bool, Int 8, UInt 4, Bit 3, Int 16) + t5 = appendTuple t2 t3 + $display "appendTuple((False, 15), (6, 0b111, -100)) = " (cshow t5) + $display "" + $display "=== Testing splitTuple ===" + counter := counter + 1 + + "test7": when counter == 7 ==> action + -- Test splitTuple: 4-tuple into 2-tuple and 2-tuple + let t4 :: (Bool, Int 8, UInt 4, Bit 3) + t4 = (True, negate 15, 9, 0b110) + let split :: ((Bool, Int 8), (UInt 4, Bit 3)) + split = splitTuple t4 + $display "splitTuple((True, -15, 9, 0b110)) = " (cshow split) + counter := counter + 1 + + "test8": when counter == 8 ==> action + -- Test splitTuple: 3-tuple into single and 2-tuple + let t3 :: (Bool, Int 8, UInt 4) + t3 = (False, 33, 15) + let split :: (Bool, (Int 8, UInt 4)) + split = splitTuple t3 + $display "splitTuple((False, 33, 15)) = " (cshow split) + counter := counter + 1 + + "test9": when counter == 9 ==> action + -- Test splitTuple: 5-tuple into 2-tuple and 3-tuple + let t5 :: (Bool, Int 8, UInt 4, Bit 3, Int 16) + t5 = (True, 50, 11, 0b001, negate 200) + let split :: ((Bool, Int 8), (UInt 4, Bit 3, Int 16)) + split = splitTuple t5 + $display "splitTuple((True, 50, 11, 0b001, -200)) = " (cshow split) + $display "" + $display "=== Round-trip test ===" + counter := counter + 1 + + "test10": when counter == 10 ==> action + -- Test appendTuple and splitTuple round-trip + let t1 :: (Bool, Int 8) + t1 = (True, 42) + let t2 :: (UInt 4, Bit 5) + t2 = (13, 0b10101) + let t4 :: (Bool, Int 8, UInt 4, Bit 5) + t4 = appendTuple t1 t2 + let split :: ((Bool, Int 8), (UInt 4, Bit 5)) + split = splitTuple t4 + $display "appendTuple/splitTuple round-trip: " (cshow split) + $finish 0 diff --git a/testsuite/bsc.lib/Prelude/CurryTypeClass.bs b/testsuite/bsc.lib/Prelude/CurryTypeClass.bs new file mode 100644 index 000000000..462468604 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/CurryTypeClass.bs @@ -0,0 +1,129 @@ +----------------------------------------------------------------------- +-- Test for the Curry type class and curryN/uncurryN functions +----------------------------------------------------------------------- + +package CurryTypeClass where + +import Vector + +----------------------------------------------------------------------- +-- Test with Tuple2 +----------------------------------------------------------------------- + +add2Tuple :: (Int 32, Int 32) -> Int 32 +add2Tuple t = tpl_1 t + tpl_2 t + +add2 :: Int 32 -> Int 32 -> Int 32 +add2 a b = a + b + +testCurry2 :: Bool +testCurry2 = + let curried :: Int 32 -> Int 32 -> Int 32 + curried = curryN add2Tuple + result1 :: Int 32 + result1 = curried 5 10 + uncurried :: (Int 32, Int 32) -> Int 32 + uncurried = uncurryN add2 + result2 :: Int 32 + result2 = uncurried (5, 10) + in result1 == 15 && result2 == 15 + + +----------------------------------------------------------------------- +-- Test with Tuple3 +----------------------------------------------------------------------- + +add3Tuple :: (Int 32, Int 32, Int 32) -> Int 32 +add3Tuple t = tpl_1 t + tpl_2 t + tpl_3 t + +add3 :: Int 32 -> Int 32 -> Int 32 -> Int 32 +add3 a b c = a + b + c + +testCurry3 :: Bool +testCurry3 = + let curried :: Int 32 -> Int 32 -> Int 32 -> Int 32 + curried = curryN add3Tuple + result1 :: Int 32 + result1 = curried 1 2 3 + uncurried :: (Int 32, Int 32, Int 32) -> Int 32 + uncurried = uncurryN add3 + result2 :: Int 32 + result2 = uncurried (1, 2, 3) + in result1 == 6 && result2 == 6 + + +----------------------------------------------------------------------- +-- Test with Tuple4 +----------------------------------------------------------------------- + +add4Tuple :: (Int 32, Int 32, Int 32, Int 32) -> Int 32 +add4Tuple t = tpl_1 t + tpl_2 t + tpl_3 t + tpl_4 t + +add4 :: Int 32 -> Int 32 -> Int 32 -> Int 32 -> Int 32 +add4 a b c d = a + b + c + d + +testCurry4 :: Bool +testCurry4 = + let curried :: Int 32 -> Int 32 -> Int 32 -> Int 32 -> Int 32 + curried = curryN add4Tuple + result1 :: Int 32 + result1 = curried 1 2 3 4 + uncurried :: (Int 32, Int 32, Int 32, Int 32) -> Int 32 + uncurried = uncurryN add4 + result2 :: Int 32 + result2 = uncurried (1, 2, 3, 4) + in result1 == 10 && result2 == 10 + + +----------------------------------------------------------------------- +-- Test roundtrip: curryN . uncurryN = id and uncurryN . curryN = id +----------------------------------------------------------------------- + +testRoundtrip :: Bool +testRoundtrip = + -- Test that uncurrying then currying gets back the original behavior + let temp :: (Int 32, Int 32, Int 32) -> Int 32 + temp = uncurryN add3 + f1 :: Int 32 -> Int 32 -> Int 32 -> Int 32 + f1 = curryN temp + result1 :: Int 32 + result1 = f1 10 20 30 + -- Test that currying then uncurrying gets back the original behavior + f2 :: (Int 32, Int 32, Int 32) -> Int 32 + f2 = uncurryN (curryN add3Tuple) + result2 :: Int 32 + result2 = f2 (10, 20, 30) + in result1 == 60 && result2 == 60 + + +----------------------------------------------------------------------- +-- Test with unit tuple (special case) +----------------------------------------------------------------------- + +fromUnitTuple :: () -> Int 32 +fromUnitTuple _ = 42 + +testUnitTuple :: Bool +testUnitTuple = + let curried :: Int 32 + curried = curryN fromUnitTuple + in curried == 42 + + +----------------------------------------------------------------------- +-- Module for testing +----------------------------------------------------------------------- + +{-# verilog sysCurryTypeClass #-} +sysCurryTypeClass :: Module Empty +sysCurryTypeClass = + module + rules + "test": when True ==> + action + $display "Test Curry2: %b" testCurry2 + $display "Test Curry3: %b" testCurry3 + $display "Test Curry4: %b" testCurry4 + $display "Test Roundtrip: %b" testRoundtrip + $display "Test Unit Tuple: %b" testUnitTuple + $finish 0 diff --git a/testsuite/bsc.lib/Prelude/Prelude.exp b/testsuite/bsc.lib/Prelude/Prelude.exp index 0cc8d18e9..90f22806f 100644 --- a/testsuite/bsc.lib/Prelude/Prelude.exp +++ b/testsuite/bsc.lib/Prelude/Prelude.exp @@ -6,3 +6,6 @@ test_c_veri_bsv Eq2 compile_verilog_fail_no_internal_error Eq3 test_c_veri_bs_modules TuplePack {} +test_c_veri_bs_modules TupleSize {} +test_c_veri_bs_modules AppendTuple {} +test_c_veri_bs_modules CurryTypeClass {} diff --git a/testsuite/bsc.lib/Prelude/TupleSize.bs b/testsuite/bsc.lib/Prelude/TupleSize.bs new file mode 100644 index 000000000..8596eb9e6 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/TupleSize.bs @@ -0,0 +1,69 @@ +package TupleSize where + +-- Test the TupleSize type class by using it in proviso constraints + +-- Helper function that requires TupleSize constraint +tupleSize :: (TupleSize t n) => t -> Integer +tupleSize _ = valueOf n + +{-# verilog sysTupleSize #-} +sysTupleSize :: Module Empty +sysTupleSize = module + rules + "test": when True ==> action + $display "=== Testing TupleSize type class ===" + + -- Test TupleSize for unit type + let u :: () + u = () + let size0 = tupleSize u + $display "TupleSize of () = %0d (expected 0)" size0 + + -- Test TupleSize for single element (non-tuple) + let b :: Bool + b = True + let size1 = tupleSize b + $display "TupleSize of Bool = %0d (expected 1)" size1 + + -- Test TupleSize for 2-tuple + let t2 :: (Bool, Int 8) + t2 = (True, 0) + let size2 = tupleSize t2 + $display "TupleSize of Tuple2 = %0d (expected 2)" size2 + + -- Test TupleSize for 3-tuple + let t3 :: (Bool, Int 8, UInt 4) + t3 = (True, 0, 0) + let size3 = tupleSize t3 + $display "TupleSize of Tuple3 = %0d (expected 3)" size3 + + -- Test TupleSize for 4-tuple + let t4 :: (Bool, Int 8, UInt 4, Bit 5) + t4 = (True, 0, 0, 0) + let size4 = tupleSize t4 + $display "TupleSize of Tuple4 = %0d (expected 4)" size4 + + -- Test TupleSize for 5-tuple + let t5 :: (Bool, Int 8, UInt 4, Bit 5, Int 16) + t5 = (True, 0, 0, 0, 0) + let size5 = tupleSize t5 + $display "TupleSize of Tuple5 = %0d (expected 5)" size5 + + -- Test TupleSize for 6-tuple + let t6 :: (Bool, Int 8, UInt 4, Bit 5, Int 16, UInt 3) + t6 = (True, 0, 0, 0, 0, 0) + let size6 = tupleSize t6 + $display "TupleSize of Tuple6 = %0d (expected 6)" size6 + + -- Test TupleSize for 7-tuple + let t7 :: (Bool, Int 8, UInt 4, Bit 5, Int 16, UInt 3, Bit 2) + t7 = (True, 0, 0, 0, 0, 0, 0) + let size7 = tupleSize t7 + $display "TupleSize of Tuple7 = %0d (expected 7)" size7 + + -- Test TupleSize for 8-tuple + let t8 :: (Bool, Int 8, UInt 4, Bit 5, Int 16, UInt 3, Bit 2, Int 32) + t8 = (True, 0, 0, 0, 0, 0, 0, 0) + let size8 = tupleSize t8 + $display "TupleSize of Tuple8 = %0d (expected 8)" size8 + $finish 0 diff --git a/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected b/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected new file mode 100644 index 000000000..492bf6a4c --- /dev/null +++ b/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected @@ -0,0 +1,16 @@ +=== Testing AppendTuple === +appendTuple((), ()) = () [unit type] +appendTuple((), (True, 42)) = (True, 42) +appendTuple((False, -10), ()) = (False, -10) +appendTuple((True, 5), (12, 0b101)) = (True, 5, 12, 0x5) +appendTuple(False, (-3, 7)) = (False, -3, 7) +appendTuple((True, 20, 8), 0b11010) = (True, 20, 8, 0x1a) +appendTuple((False, 15), (6, 0b111, -100)) = (False, 15, 6, 0x7, -100) + +=== Testing splitTuple === +splitTuple((True, -15, 9, 0b110)) = ((True, -15), 9, 0x6) +splitTuple((False, 33, 15)) = (False, 33, 15) +splitTuple((True, 50, 11, 0b001, -200)) = ((True, 50), 11, 0x1, -200) + +=== Round-trip test === +appendTuple/splitTuple round-trip: ((True, 42), 13, 0x15) diff --git a/testsuite/bsc.lib/Prelude/sysCurryTypeClass.out.expected b/testsuite/bsc.lib/Prelude/sysCurryTypeClass.out.expected new file mode 100644 index 000000000..347740d19 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/sysCurryTypeClass.out.expected @@ -0,0 +1,5 @@ +Test Curry2: 1 +Test Curry3: 1 +Test Curry4: 1 +Test Roundtrip: 1 +Test Unit Tuple: 1 diff --git a/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected b/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected new file mode 100644 index 000000000..c04bed8cb --- /dev/null +++ b/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected @@ -0,0 +1,10 @@ +=== Testing TupleSize type class === +TupleSize of () = 0 (expected 0) +TupleSize of Bool = 1 (expected 1) +TupleSize of Tuple2 = 2 (expected 2) +TupleSize of Tuple3 = 3 (expected 3) +TupleSize of Tuple4 = 4 (expected 4) +TupleSize of Tuple5 = 5 (expected 5) +TupleSize of Tuple6 = 6 (expected 6) +TupleSize of Tuple7 = 7 (expected 7) +TupleSize of Tuple8 = 8 (expected 8) diff --git a/testsuite/bsc.lib/vector/ConcatTuple.bs b/testsuite/bsc.lib/vector/ConcatTuple.bs new file mode 100644 index 000000000..892d624e6 --- /dev/null +++ b/testsuite/bsc.lib/vector/ConcatTuple.bs @@ -0,0 +1,138 @@ +package ConcatTuple where + +import Vector + +-- Test the ConcatTuple type class + +{-# verilog sysConcatTuple #-} +sysConcatTuple :: Module Empty +sysConcatTuple = + module + counter :: Reg (UInt 6) <- mkReg 0 + + rules + "test0": when counter == 0 ==> action + $display "=== Testing ConcatTuple ===" + -- Test empty vector to unit type + let empty :: Vector 0 (Bool, Int 8) + empty = nil + let unit :: () + unit = concatTuple empty + $display "concatTuple(empty_vector) = () [unit type]" + counter := counter + 1 + + "test1": when counter == 1 ==> action + -- Test single element vector + let v1 :: Vector 1 (Bool, Int 8) + v1 = (True, 25) :> nil + let result :: (Bool, Int 8) + result = concatTuple v1 + $display "concatTuple([(True, 25)]) = (%b, %0d)" (tpl_1 result) (tpl_2 result) + counter := counter + 1 + + "test2": when counter == 2 ==> action + -- Test vector of 3 single elements to 3-tuple + let v3 :: Vector 3 (Int 8) + v3 = 10 :> 20 :> 30 :> nil + let t3 :: (Int 8, Int 8, Int 8) + t3 = concatTuple v3 + $display "concatTuple([10, 20, 30]) = (%0d, %0d, %0d)" (tpl_1 t3) (tpl_2 t3) (tpl_3 t3) + counter := counter + 1 + + "test3": when counter == 3 ==> action + -- Test vector of 4 single elements to 4-tuple + let v4 :: Vector 4 (UInt 4) + v4 = 1 :> 2 :> 3 :> 4 :> nil + let t4 :: (UInt 4, UInt 4, UInt 4, UInt 4) + t4 = concatTuple v4 + $display "concatTuple([1, 2, 3, 4]) = (%0d, %0d, %0d, %0d)" (tpl_1 t4) (tpl_2 t4) (tpl_3 t4) (tpl_4 t4) + counter := counter + 1 + + "test4": when counter == 4 ==> action + -- Test vector of 2 pairs to 4-tuple + let v2 :: Vector 2 (Bool, Int 8) + v2 = (True, 5) :> (False, negate 12) :> nil + let t4 :: (Bool, Int 8, Bool, Int 8) + t4 = concatTuple v2 + $display "concatTuple([(True, 5), (False, -12)]) = (%b, %0d, %b, %0d)" (tpl_1 t4) (tpl_2 t4) (tpl_3 t4) (tpl_4 t4) + counter := counter + 1 + + "test5": when counter == 5 ==> action + -- Test vector of 3 pairs to 6-tuple + let v3 :: Vector 3 (UInt 4, Bit 3) + v3 = (1, 0b001) :> (2, 0b010) :> (3, 0b011) :> nil + let t6 :: (UInt 4, Bit 3, UInt 4, Bit 3, UInt 4, Bit 3) + t6 = concatTuple v3 + $display "concatTuple([(1, 0b001), (2, 0b010), (3, 0b011)]) = (%0d, %b, %0d, %b, %0d, %b)" (tpl_1 t6) (tpl_2 t6) (tpl_3 t6) (tpl_4 t6) (tpl_5 t6) (tpl_6 t6) + counter := counter + 1 + + "test6": when counter == 6 ==> action + -- Test vector of 2 triples to 6-tuple + let v2 :: Vector 2 (Bool, Int 8, UInt 4) + v2 = (True, 10, 5) :> (False, negate 20, 8) :> nil + let t6 :: (Bool, Int 8, UInt 4, Bool, Int 8, UInt 4) + t6 = concatTuple v2 + $display "concatTuple([(True, 10, 5), (False, -20, 8)]) = (%b, %0d, %0d, %b, %0d, %0d)" (tpl_1 t6) (tpl_2 t6) (tpl_3 t6) (tpl_4 t6) (tpl_5 t6) (tpl_6 t6) + $display "" + $display "=== Testing unconcatTuple ===" + counter := counter + 1 + + "test7": when counter == 7 ==> action + -- Test 4-tuple to vector of 4 singles + let t4 :: (Int 8, Int 8, Int 8, Int 8) + t4 = (7, 8, 9, 10) + let v4 :: Vector 4 (Int 8) + v4 = unconcatTuple t4 + $display "unconcatTuple((7, 8, 9, 10)) = [%0d, %0d, %0d, %0d]" (v4 !! 0) (v4 !! 1) (v4 !! 2) (v4 !! 3) + counter := counter + 1 + + "test8": when counter == 8 ==> action + -- Test 4-tuple to vector of 2 pairs + let t4 :: (Bool, Int 8, Bool, Int 8) + t4 = (False, 100, True, negate 50) + let v2 :: Vector 2 (Bool, Int 8) + v2 = unconcatTuple t4 + $display "unconcatTuple((False, 100, True, -50)) = [(%b, %0d), (%b, %0d)]" (tpl_1 (v2 !! 0)) (tpl_2 (v2 !! 0)) (tpl_1 (v2 !! 1)) (tpl_2 (v2 !! 1)) + counter := counter + 1 + + "test9": when counter == 9 ==> action + -- Test 6-tuple to vector of 3 pairs + let t6 :: (UInt 4, Bit 2, UInt 4, Bit 2, UInt 4, Bit 2) + t6 = (5, 0b00, 10, 0b01, 15, 0b10) + let v3 :: Vector 3 (UInt 4, Bit 2) + v3 = unconcatTuple t6 + $display "unconcatTuple((5, 0b00, 10, 0b01, 15, 0b10)) = [(%0d, %b), (%0d, %b), (%0d, %b)]" (tpl_1 (v3 !! 0)) (tpl_2 (v3 !! 0)) (tpl_1 (v3 !! 1)) (tpl_2 (v3 !! 1)) (tpl_1 (v3 !! 2)) (tpl_2 (v3 !! 2)) + counter := counter + 1 + + "test10": when counter == 10 ==> action + -- Test 6-tuple to vector of 2 triples + let t6 :: (Bool, Int 8, UInt 4, Bool, Int 8, UInt 4) + t6 = (True, 15, 3, False, negate 25, 7) + let v2 :: Vector 2 (Bool, Int 8, UInt 4) + v2 = unconcatTuple t6 + $display "unconcatTuple((True, 15, 3, False, -25, 7)) = [(%b, %0d, %0d), (%b, %0d, %0d)]" (tpl_1 (v2 !! 0)) (tpl_2 (v2 !! 0)) (tpl_3 (v2 !! 0)) (tpl_1 (v2 !! 1)) (tpl_2 (v2 !! 1)) (tpl_3 (v2 !! 1)) + $display "" + $display "=== Round-trip test ===" + counter := counter + 1 + + "test11": when counter == 11 ==> action + -- Test concatTuple and unconcatTuple round-trip with singles + let v_orig :: Vector 5 (Int 8) + v_orig = 1 :> 2 :> 3 :> 4 :> 5 :> nil + let t5 :: (Int 8, Int 8, Int 8, Int 8, Int 8) + t5 = concatTuple v_orig + let v_restored :: Vector 5 (Int 8) + v_restored = unconcatTuple t5 + $display "concatTuple/unconcatTuple round-trip (singles): [%0d, %0d, %0d, %0d, %0d]" (v_restored !! 0) (v_restored !! 1) (v_restored !! 2) (v_restored !! 3) (v_restored !! 4) + counter := counter + 1 + + "test12": when counter == 12 ==> action + -- Test concatTuple and unconcatTuple round-trip with pairs + let v_orig :: Vector 3 (Bool, Int 8) + v_orig = (True, 11) :> (False, 22) :> (True, 33) :> nil + let t6 :: (Bool, Int 8, Bool, Int 8, Bool, Int 8) + t6 = concatTuple v_orig + let v_restored :: Vector 3 (Bool, Int 8) + v_restored = unconcatTuple t6 + $display "concatTuple/unconcatTuple round-trip (pairs): [(%b, %0d), (%b, %0d), (%b, %0d)]" (tpl_1 (v_restored !! 0)) (tpl_2 (v_restored !! 0)) (tpl_1 (v_restored !! 1)) (tpl_2 (v_restored !! 1)) (tpl_1 (v_restored !! 2)) (tpl_2 (v_restored !! 2)) + $finish 0 diff --git a/testsuite/bsc.lib/vector/libvector.exp b/testsuite/bsc.lib/vector/libvector.exp index 2e592d858..875843e73 100644 --- a/testsuite/bsc.lib/vector/libvector.exp +++ b/testsuite/bsc.lib/vector/libvector.exp @@ -12,3 +12,5 @@ test_c_veri_bsv FindIndex test_c_veri_bsv RotateBy test_c_veri_bsv ZeroVector test_c_veri_bsv FromChunksTest + +test_c_veri_bs_modules ConcatTuple {} diff --git a/testsuite/bsc.lib/vector/sysConcatTuple.out.expected b/testsuite/bsc.lib/vector/sysConcatTuple.out.expected new file mode 100644 index 000000000..a9c59ffed --- /dev/null +++ b/testsuite/bsc.lib/vector/sysConcatTuple.out.expected @@ -0,0 +1,18 @@ +=== Testing ConcatTuple === +concatTuple(empty_vector) = () [unit type] +concatTuple([(True, 25)]) = (1, 25) +concatTuple([10, 20, 30]) = (10, 20, 30) +concatTuple([1, 2, 3, 4]) = (1, 2, 3, 4) +concatTuple([(True, 5), (False, -12)]) = (1, 5, 0, -12) +concatTuple([(1, 0b001), (2, 0b010), (3, 0b011)]) = (1, 001, 2, 010, 3, 011) +concatTuple([(True, 10, 5), (False, -20, 8)]) = (1, 10, 5, 0, -20, 8) + +=== Testing unconcatTuple === +unconcatTuple((7, 8, 9, 10)) = [7, 8, 9, 10] +unconcatTuple((False, 100, True, -50)) = [(0, 100), (1, -50)] +unconcatTuple((5, 0b00, 10, 0b01, 15, 0b10)) = [(5, 00), (10, 01), (15, 10)] +unconcatTuple((True, 15, 3, False, -25, 7)) = [(1, 15, 3), (0, -25, 7)] + +=== Round-trip test === +concatTuple/unconcatTuple round-trip (singles): [1, 2, 3, 4, 5] +concatTuple/unconcatTuple round-trip (pairs): [(1, 11), (0, 22), (1, 33)] diff --git a/testsuite/bsc.mcd/Misc/ClockCheckCond.bsv.bsc-vcomp-out.expected b/testsuite/bsc.mcd/Misc/ClockCheckCond.bsv.bsc-vcomp-out.expected index 658bd9d0d..1c793d355 100644 --- a/testsuite/bsc.mcd/Misc/ClockCheckCond.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.mcd/Misc/ClockCheckCond.bsv.bsc-vcomp-out.expected @@ -6,7 +6,7 @@ Error: "ClockCheckCond.bsv", line 6, column 8: (G0007) Method calls by clock domain: Clock domain 1: default_clock: - the_y.read at "ClockCheckCond.bsv", line 2, column 18, + the_y.read at "ClockCheckCond.bsv", line 2, column 10, Clock domain 2: c: the_x.read at "ClockCheckCond.bsv", line 14, column 19, diff --git a/testsuite/bsc.mcd/Misc/ClockCheckCond.bsv.nocrossinfo.bsc-vcomp-out.expected b/testsuite/bsc.mcd/Misc/ClockCheckCond.bsv.nocrossinfo.bsc-vcomp-out.expected new file mode 100644 index 000000000..76d98baad --- /dev/null +++ b/testsuite/bsc.mcd/Misc/ClockCheckCond.bsv.nocrossinfo.bsc-vcomp-out.expected @@ -0,0 +1,16 @@ +checking package dependencies +compiling ClockCheckCond.bsv +code generation for sysClockCheckCond starts +Error: "ClockCheckCond.bsv", line 6, column 8: (G0007) + Reference across clock domain in method `out'. + Method calls by clock domain: + Clock domain 1: + default_clock: + the_y.read + Clock domain 2: + c: + the_x.read + During elaboration of the interface method `out' at "ClockCheckCond.bsv", + line 6, column 8. + During elaboration of `sysClockCheckCond' at "ClockCheckCond.bsv", line 6, + column 8. diff --git a/testsuite/bsc.mcd/Misc/mcd.exp b/testsuite/bsc.mcd/Misc/mcd.exp index 7d0fe1edb..331b5f9d6 100644 --- a/testsuite/bsc.mcd/Misc/mcd.exp +++ b/testsuite/bsc.mcd/Misc/mcd.exp @@ -57,6 +57,10 @@ compare_file ClockCheckRule2.bsv.bsc-vcomp-out compile_verilog_fail_error ClockCheckMethod.bsv G0007 1 "" "-cross-info" compare_file ClockCheckMethod.bsv.bsc-vcomp-out +compile_verilog_fail_error ClockCheckCond.bsv G0007 1 "" +copy ClockCheckCond.bsv.bsc-vcomp-out ClockCheckCond.bsv.nocrossinfo.bsc-vcomp-out +compare_file ClockCheckCond.bsv.nocrossinfo.bsc-vcomp-out + compile_verilog_fail_error ClockCheckCond.bsv G0007 1 "" "-cross-info" # even with the -cross-info flag, the positions here are not perfect # (we compare here against the imperfect, but we should fix it) (bug 1238) diff --git a/testsuite/bsc.names/portRenaming/conflicts/clock/ClockEnable.bsv b/testsuite/bsc.names/portRenaming/conflicts/clock/ClockEnable.bsv index dfc572448..6c5abb46d 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/clock/ClockEnable.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/clock/ClockEnable.bsv @@ -6,4 +6,6 @@ endinterface (* synthesize *) module mkClockEnable(Ifc); + method m = noAction; + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/clock/ClockResult.bsv b/testsuite/bsc.names/portRenaming/conflicts/clock/ClockResult.bsv index 937f80ea5..177411a5f 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/clock/ClockResult.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/clock/ClockResult.bsv @@ -6,4 +6,6 @@ endinterface (* synthesize *) module mkClockResult(Ifc); + method m = False; + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/clock/GateEnable.bsv b/testsuite/bsc.names/portRenaming/conflicts/clock/GateEnable.bsv index 37fcea71c..65ec4ea47 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/clock/GateEnable.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/clock/GateEnable.bsv @@ -6,4 +6,6 @@ endinterface (* synthesize *) module mkGateEnable(Ifc); + method m = noAction; + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargClock.bsv b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargClock.bsv index f397463f6..4e4d628c2 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargClock.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargClock.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModargClock ((*port="CLK_c"*)int c, Ifc i); + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargGate.bsv b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargGate.bsv index 0ba6c94c3..01d9aecd3 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargGate.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargGate.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModargGate ((*port="CLK_GATE_c"*)int c, Ifc i); + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargReset.bsv b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargReset.bsv index f3bc6d5d5..4677891de 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargReset.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargReset.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModargReset ((*port="RST_N_r"*)int r, Ifc i); + method r = noReset; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamClock.bsv b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamClock.bsv index c8e73a159..505b46068 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamClock.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamClock.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModparamClock #((*parameter="CLK_c"*)parameter int c) (Ifc); + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamGate.bsv b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamGate.bsv index 561a4829e..18ae8dc52 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamGate.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamGate.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModparamGate #((*parameter="CLK_GATE_c"*)parameter int c) (Ifc); + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamReset.bsv b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamReset.bsv index 5585103c3..7a4e7938c 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamReset.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamReset.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModparamReset #((*parameter="RST_N_r"*)parameter int r) (Ifc); + method r = noReset; endmodule diff --git a/testsuite/bsc.scheduler/urgency/IfcIfcWarning.bsv.bsc-sched-out.expected b/testsuite/bsc.scheduler/urgency/IfcIfcWarning.bsv.bsc-sched-out.expected index 27c0fa197..9644c77f8 100644 --- a/testsuite/bsc.scheduler/urgency/IfcIfcWarning.bsv.bsc-sched-out.expected +++ b/testsuite/bsc.scheduler/urgency/IfcIfcWarning.bsv.bsc-sched-out.expected @@ -8,7 +8,8 @@ order: [bar, baz] ----- === resources: -[(the_r.read, [(the_r.read, 1)]), (the_r.write, [(the_r.write x__h69, 1), (the_r.write x__h85, 1)])] +[(the_r.read, [(the_r.read, 1)]), + (the_r.write, [(the_r.write x__h108, 1), (the_r.write x__h134, 1)])] ----- diff --git a/testsuite/bsc.verilog/noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected b/testsuite/bsc.verilog/noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected index 06ba4d213..935cb5070 100644 --- a/testsuite/bsc.verilog/noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.verilog/noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected @@ -1,11 +1,12 @@ checking package dependencies compiling NoInline_ArgNotInBits.bsv -code generation for module_fnNoInline_ArgNotInBits starts +Error: Unknown position: (T0031) + The provisos for this expression could not be resolved because there are no + instances of the form: + Bits#(NoInline_ArgNotInBits::L, a__) + The proviso was implied by expressions at the following positions: + "NoInline_ArgNotInBits.bsv", line 4, column 15 Error: "NoInline_ArgNotInBits.bsv", line 4, column 15: (T0043) - Cannot synthesize `module_fnNoInline_ArgNotInBits': The interface method - `fnNoInline_ArgNotInBits' uses type `NoInline_ArgNotInBits::L' which is not - in the Bits class. - During elaboration of the interface method `fnNoInline_ArgNotInBits' at - "NoInline_ArgNotInBits.bsv", line 4, column 15. - During elaboration of `module_fnNoInline_ArgNotInBits' at - "NoInline_ArgNotInBits.bsv", line 4, column 15. + Cannot synthesize `module_fnNoInline_ArgNotInBits­': The interface method + `fnNoInline_ArgNotInBits' uses type(s) that are not in the Bits or + SplitPorts typeclasses: NoInline_ArgNotInBits::L diff --git a/testsuite/bsc.verilog/noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected b/testsuite/bsc.verilog/noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected index 02d3fb3c6..d2fe133e0 100644 --- a/testsuite/bsc.verilog/noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.verilog/noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected @@ -1,11 +1,18 @@ checking package dependencies compiling NoInline_ResNotInBits.bsv -code generation for module_fnNoInline_ResNotInBits starts +Error: Unknown position: (T0031) + The provisos for this expression could not be resolved because there are no + instances of the form: + Bits#(NoInline_ResNotInBits::L, a__) + The proviso was implied by expressions at the following positions: + "NoInline_ResNotInBits.bsv", line 4, column 12 Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0043) - Cannot synthesize `module_fnNoInline_ResNotInBits': The interface method - `fnNoInline_ResNotInBits' uses type `NoInline_ResNotInBits::L' which is not - in the Bits class. - During elaboration of the interface method `fnNoInline_ResNotInBits' at - "NoInline_ResNotInBits.bsv", line 4, column 12. - During elaboration of `module_fnNoInline_ResNotInBits' at - "NoInline_ResNotInBits.bsv", line 4, column 12. + Cannot synthesize `module_fnNoInline_ResNotInBits­': The interface method + `fnNoInline_ResNotInBits' uses type(s) that are not in the Bits or + SplitPorts typeclasses: NoInline_ResNotInBits::L +Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0029) + Signature mismatch (given too general): + given: + function b__ f(Bit#(1) x1) provisos (Bits#(NoInline_ResNotInBits::L, a__)) + deduced: + function Bit#(c__) f(Bit#(1) x1) provisos (Bits#(NoInline_ResNotInBits::L, c__)) diff --git a/testsuite/bsc.verilog/noinline/noinline.exp b/testsuite/bsc.verilog/noinline/noinline.exp index 78b24f4a2..bf7b15e7a 100644 --- a/testsuite/bsc.verilog/noinline/noinline.exp +++ b/testsuite/bsc.verilog/noinline/noinline.exp @@ -41,11 +41,7 @@ test_c_veri_bsv_modules \ module_testLessPatternsBSVFunction \ sysNoInline_LessPatternsThanArgs.out.expected -# The typedef fails because BSC doesn't expand the synonym before checking -# to see if the result type is in Bits, so the user gets a proviso error -# (bug 1466) -compile_verilog_pass_bug_error \ - NoInline_LessPatternsThanArgs_BSV_TypeDef.bsv T0031 +compile_verilog_pass NoInline_LessPatternsThanArgs_BSV_TypeDef.bsv # ----- diff --git a/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs b/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs new file mode 100644 index 000000000..85046dab3 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs @@ -0,0 +1,25 @@ +package ArgNamesPragma_PortNameConflict where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + z :: Bool + deriving (Bits) + +instance SplitPorts Foo (Port (Int 8), Port (Int 8), Port Bool) where + splitPorts f = (Port f.x, Port f.y, Port f.z) + unsplitPorts (Port x, Port y, Port z) = Foo { x=x; y=y; z=z; } + portNames _ base = Cons (base +++ "_x") $ Cons (base +++ "_y") $ Cons (base +++ "_z") Nil + +interface SplitTest = + putFoo :: Foo -> Bool -> Action {-# prefix = "fooIn", arg_names = ["f", "f_z"] #-} + +{-# synthesize sysArgNamesPragma_PortNameConflict #-} +sysArgNamesPragma_PortNameConflict :: Module SplitTest +sysArgNamesPragma_PortNameConflict = + module + interface + putFoo x y = $display "putFoo: " (cshow x) (cshow y) diff --git a/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..37bd887de --- /dev/null +++ b/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out.expected @@ -0,0 +1,7 @@ +checking package dependencies +compiling ArgNamesPragma_PortNameConflict.bs +code generation for sysArgNamesPragma_PortNameConflict starts +Error: "ArgNamesPragma_PortNameConflict.bs", line 21, column 0: (G0055) + Method `putFoo' generates a port with name `fooIn_f_z' which conflicts with + a port of the same name generated by method `putFoo' at location + "ArgNamesPragma_PortNameConflict.bs", line 21, column 0. diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs b/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs new file mode 100644 index 000000000..8fc5d1518 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs @@ -0,0 +1,25 @@ +package BadSplitInst_PortNameConflict where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + z :: Bool + deriving (Bits) + +instance SplitPorts Foo (Port (Int 8), Port (Int 8), Port Bool) where + splitPorts f = (Port f.x, Port f.y, Port f.z) + unsplitPorts (Port x, Port y, Port z) = Foo { x=x; y=y; z=z; } + portNames _ base = Cons (base +++ "_x") $ Cons (base +++ "_y") $ Cons (base +++ "_x") Nil + +interface SplitTest = + putFoo :: Foo -> Action {-# prefix = "fooIn" #-} + +{-# synthesize sysBadSplitInst_PortNameConflict #-} +sysBadSplitInst_PortNameConflict :: Module SplitTest +sysBadSplitInst_PortNameConflict = + module + interface + putFoo x = $display "putFoo: " (cshow x) diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..e825168aa --- /dev/null +++ b/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs.bsc-vcomp-out.expected @@ -0,0 +1,7 @@ +checking package dependencies +compiling BadSplitInst_PortNameConflict.bs +code generation for sysBadSplitInst_PortNameConflict starts +Error: "BadSplitInst_PortNameConflict.bs", line 21, column 0: (G0055) + Method `putFoo' generates a port with name `fooIn_1_x' which conflicts with + a port of the same name generated by method `putFoo' at location + "BadSplitInst_PortNameConflict.bs", line 21, column 0. diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs new file mode 100644 index 000000000..b6bd12629 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs @@ -0,0 +1,24 @@ +package BadSplitInst_TooManyPortNames where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance SplitPorts Foo (Port (Int 8), Port (Int 8)) where + splitPorts f = (Port f.x, Port f.y) + unsplitPorts (Port x, Port y) = Foo { x=x; y=y; } + portNames _ base = Cons (base +++ "_x") $ Cons (base +++ "_y") $ Cons (base +++ "_z") Nil + +interface SplitTest = + putFoo :: Foo -> Action {-# prefix = "fooIn" #-} + +{-# synthesize sysBadSplitInst_TooManyPortNames #-} +sysBadSplitInst_TooManyPortNames :: Module SplitTest +sysBadSplitInst_TooManyPortNames = + module + interface + putFoo x = $display "putFoo: " (cshow x) diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..f73317139 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected @@ -0,0 +1,8 @@ +checking package dependencies +compiling BadSplitInst_TooManyPortNames.bs +code generation for sysBadSplitInst_TooManyPortNames starts +Error: "BadSplitInst_TooManyPortNames.bs", line 17, column 12: (S0015) + Bluespec evaluation-time error: SplitPorts: fooIn_1 has 2 ports, but 3 port + names were given + During elaboration of `sysBadSplitInst_TooManyPortNames' at + "BadSplitInst_TooManyPortNames.bs", line 20, column 0. diff --git a/testsuite/bsc.verilog/splitports/DeepSplit.bs b/testsuite/bsc.verilog/splitports/DeepSplit.bs new file mode 100644 index 000000000..9cab5afea --- /dev/null +++ b/testsuite/bsc.verilog/splitports/DeepSplit.bs @@ -0,0 +1,77 @@ +package DeepSplit where + +import Vector +import BuildVector +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +struct Bar = + v :: Vector 3 Bool + w :: (Bool, UInt 16) + z :: Foo + -- No Bits instance needed + +struct Baz = + a :: Maybe Foo + b :: Bar + c :: Vector 3 (Vector 8 Foo, Bar) + d :: () + e :: Vector 0 Foo + -- No Bits instance needed + +struct Quix = + q :: Int 3 + v :: Bool + deriving (Bits) + +-- Don't recurse into Quix with DeepSplitPorts +instance DeepSplitPorts Quix (Port Quix) where + deepSplitPorts x = Port x + deepUnsplitPorts (Port x) = x + deepSplitPortNames _ base = Cons (base) Nil + +struct Zug = + qs :: Vector 2 Quix + blob :: Bool + +interface SplitTest = + putFoo :: DeepSplit Foo -> Action + putBar :: DeepSplit Bar -> Action {-# prefix = "PUT_BAR" #-} + putFooBar :: DeepSplit Foo -> DeepSplit Bar -> Action {-# arg_names = ["fooIn", "barIn"] #-} + putFoos :: DeepSplit (Vector 50 Foo) -> Action + putBaz :: DeepSplit Baz -> Action + putZug :: DeepSplit Zug -> Action + + +{-# synthesize mkDeepSplitTest #-} +mkDeepSplitTest :: Module SplitTest +mkDeepSplitTest = + module + interface + putFoo (DeepSplit x) = $display "putFoo: " (cshow x) + putBar (DeepSplit x) = $display "putBar: " (cshow x) + putFooBar (DeepSplit x) (DeepSplit y) = $display "putFooBar: " (cshow x) " " (cshow y) + putFoos (DeepSplit x) = $display "putFoos: " (cshow x) + putBaz (DeepSplit x) = $display "putBaz: " (cshow x) + putZug (DeepSplit x) = $display "putZug: " (cshow x) + +{-# synthesize sysDeepSplit #-} +sysDeepSplit :: Module Empty +sysDeepSplit = + module + s <- mkDeepSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFoo $ DeepSplit $ Foo { x = 1; y = 2; } + when i == 1 ==> s.putBar $ DeepSplit $ Bar { v = vec True False True; w = (True, 0x1234); z = Foo { x = 3; y = 4; } } + when i == 2 ==> s.putFooBar (DeepSplit $ Foo { x = 5; y = 6; }) (DeepSplit $ Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) + when i == 3 ==> s.putFoos $ DeepSplit $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } + when i == 4 ==> s.putBaz $ DeepSplit $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } + when i == 5 ==> s.putZug $ DeepSplit $ Zug { qs = vec (Quix { q = 1; v = True }) (Quix { q = 2; v = False }); blob = False; } + when i == 6 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/InstanceSplit.bs b/testsuite/bsc.verilog/splitports/InstanceSplit.bs new file mode 100644 index 000000000..83c2ce7da --- /dev/null +++ b/testsuite/bsc.verilog/splitports/InstanceSplit.bs @@ -0,0 +1,76 @@ +package InstanceSplit where + +import Vector +import BuildVector +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance SplitPorts Foo (Port (Int 8), Port Bool, Port (Bit 7)) where + splitPorts x = (Port x.x, Port (x.y > 0), Port $ truncate $ pack x.y) + unsplitPorts (Port x, Port s, Port y) = Foo { x = x; y = (if s then id else negate) $ unpack $ zeroExtend y; } + portNames _ base = Cons (base +++ "_x") $ Cons (base +++ "_ysign") $ Cons (base +++ "_yvalue") Nil + +struct Bar = + v :: Vector 3 Bool + w :: (Bool, UInt 16) + z :: Foo + deriving (Bits) + +-- XXX would be nice to be able to derive this +instance (ShallowSplitPorts Bar p) => SplitPorts Bar p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +struct Baz = + a :: Maybe Foo + b :: Bar + c :: Vector 3 (Vector 8 Foo, Bar) + d :: () + e :: Vector 0 Foo + -- No Bits instance needed + +-- XXX would be nice to be able to derive this +instance (ShallowSplitPorts Baz p) => SplitPorts Baz p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +interface SplitTest = + putFoo :: Foo -> Action + putBar :: Bar -> Action {-# prefix = "PUT_BAR" #-} + putFooBar :: Foo -> Bar -> Action {-# arg_names = ["fooIn", "barIn"] #-} + putFoos :: (Vector 50 Foo) -> Action + putBaz :: Baz -> Action + + +{-# synthesize mkInstanceSplitTest #-} +mkInstanceSplitTest :: Module SplitTest +mkInstanceSplitTest = + module + interface + putFoo x = $display "putFoo: " (cshow x) + putBar x = $display "putBar: " (cshow x) + putFooBar x y = $display "putFooBar: " (cshow x) " " (cshow y) + putFoos x = $display "putFoos: " (cshow x) + putBaz x = $display "putBaz: " (cshow x) + +{-# synthesize sysInstanceSplit #-} +sysInstanceSplit :: Module Empty +sysInstanceSplit = + module + s <- mkInstanceSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFoo $ Foo { x = 1; y = 2; } + when i == 1 ==> s.putBar $ Bar { v = vec True False True; w = (True, 0x1234); z = Foo { x = 3; y = 4; } } + when i == 2 ==> s.putFooBar (Foo { x = 5; y = 6; }) (Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) + when i == 3 ==> s.putFoos $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } + when i == 4 ==> s.putBaz $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } + when i == 5 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/Makefile b/testsuite/bsc.verilog/splitports/Makefile new file mode 100644 index 000000000..b953e8132 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/Makefile @@ -0,0 +1,5 @@ +# for "make clean" to work everywhere + +CONFDIR = $(realpath ../..) + +include $(CONFDIR)/clean.mk diff --git a/testsuite/bsc.verilog/splitports/PortNameConflict.bs b/testsuite/bsc.verilog/splitports/PortNameConflict.bs new file mode 100644 index 000000000..145bb557c --- /dev/null +++ b/testsuite/bsc.verilog/splitports/PortNameConflict.bs @@ -0,0 +1,34 @@ +package PortNameConflict where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance (ShallowSplitPorts Foo p) => SplitPorts Foo p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +struct Bar = + f :: Foo + f_x :: Int 16 + deriving (Bits) + +instance (ShallowSplitPorts Bar p) => SplitPorts Bar p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +interface SplitTest = + putBar :: Bar -> Action {-# prefix = "barIn" #-} + +{-# synthesize sysPortNameConflict #-} +sysPortNameConflict :: Module SplitTest +sysPortNameConflict = + module + interface + putBar x = $display "putBar: " (cshow x) diff --git a/testsuite/bsc.verilog/splitports/PortNameConflict.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/PortNameConflict.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..be3183ec8 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/PortNameConflict.bs.bsc-vcomp-out.expected @@ -0,0 +1,7 @@ +checking package dependencies +compiling PortNameConflict.bs +code generation for sysPortNameConflict starts +Error: "PortNameConflict.bs", line 30, column 0: (G0055) + Method `putBar' generates a port with name `barIn_1_f_x' which conflicts + with a port of the same name generated by method `putBar' at location + "PortNameConflict.bs", line 30, column 0. diff --git a/testsuite/bsc.verilog/splitports/ShallowSplit.bs b/testsuite/bsc.verilog/splitports/ShallowSplit.bs new file mode 100644 index 000000000..1c96ac47b --- /dev/null +++ b/testsuite/bsc.verilog/splitports/ShallowSplit.bs @@ -0,0 +1,59 @@ +package ShallowSplit where + +import Vector +import BuildVector +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +struct Bar = + v :: Vector 3 Bool + w :: (Bool, UInt 16) + z :: Foo + deriving (Bits) + +struct Baz = + a :: Maybe Foo + b :: Bar + c :: Vector 3 (Vector 8 Foo, Bar) + d :: () + e :: Vector 0 Foo + -- No Bits instance needed + +interface SplitTest = + putFoo :: ShallowSplit Foo -> Action + putBar :: ShallowSplit Bar -> Action {-# prefix = "PUT_BAR" #-} + putFooBar :: ShallowSplit Foo -> ShallowSplit Bar -> Action {-# arg_names = ["fooIn", "barIn"] #-} + putFoos :: ShallowSplit (Vector 50 Foo) -> Action + putBaz :: ShallowSplit Baz -> Action + + +{-# synthesize mkShallowSplitTest #-} +mkShallowSplitTest :: Module SplitTest +mkShallowSplitTest = + module + interface + putFoo (ShallowSplit x) = $display "putFoo: " (cshow x) + putBar (ShallowSplit x) = $display "putBar: " (cshow x) + putFooBar (ShallowSplit x) (ShallowSplit y) = $display "putFooBar: " (cshow x) " " (cshow y) + putFoos (ShallowSplit x) = $display "putFoos: " (cshow x) + putBaz (ShallowSplit x) = $display "putBaz: " (cshow x) + +{-# synthesize sysShallowSplit #-} +sysShallowSplit :: Module Empty +sysShallowSplit = + module + s <- mkShallowSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFoo $ ShallowSplit $ Foo { x = 1; y = 2; } + when i == 1 ==> s.putBar $ ShallowSplit $ Bar { v = vec True False True; w = (True, 0x1234); z = Foo { x = 3; y = 4; } } + when i == 2 ==> s.putFooBar (ShallowSplit $ Foo { x = 5; y = 6; }) (ShallowSplit $ Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) + when i == 3 ==> s.putFoos $ ShallowSplit $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } + when i == 4 ==> s.putBaz $ ShallowSplit $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } + when i == 5 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/SomeArgNames.bs b/testsuite/bsc.verilog/splitports/SomeArgNames.bs new file mode 100644 index 000000000..fd2b871fe --- /dev/null +++ b/testsuite/bsc.verilog/splitports/SomeArgNames.bs @@ -0,0 +1,46 @@ +package SomeArgNames where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance (ShallowSplitPorts Foo p) => SplitPorts Foo p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +struct Bar = + f :: Foo + b :: Bool + deriving (Bits) + +instance (ShallowSplitPorts Bar p) => SplitPorts Bar p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +interface SplitTest = + putFooBar :: Foo -> Bar -> Action {-# arg_names = ["fooIn"] #-} + +{-# synthesize mkSomeArgNamesSplitTest #-} +mkSomeArgNamesSplitTest :: Module SplitTest +mkSomeArgNamesSplitTest = + module + interface + putFooBar x y = $display "putFooBar: " (cshow x) " " (cshow y) + +{-# synthesize sysSomeArgNames #-} +sysSomeArgNames :: Module Empty +sysSomeArgNames = + module + s <- mkSomeArgNamesSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFooBar (Foo { x = 5; y = 6; }) (Bar { f = Foo { x = 7; y = 8; }; b = True; }) + when i == 1 ==> $finish + diff --git a/testsuite/bsc.verilog/splitports/TooManyArgNames.bs b/testsuite/bsc.verilog/splitports/TooManyArgNames.bs new file mode 100644 index 000000000..9a97f196f --- /dev/null +++ b/testsuite/bsc.verilog/splitports/TooManyArgNames.bs @@ -0,0 +1,46 @@ +package TooManyArgNames where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance (ShallowSplitPorts Foo p) => SplitPorts Foo p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +struct Bar = + f :: Foo + b :: Bool + deriving (Bits) + +instance (ShallowSplitPorts Bar p) => SplitPorts Bar p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +interface SplitTest = + putFooBar :: Foo -> Bar -> Action {-# arg_names = ["fooIn1", "fooIn2", "fooIn3", "fooIn4"] #-} + +{-# synthesize mkTooManyArgNamesSplitTest #-} +mkTooManyArgNamesSplitTest :: Module SplitTest +mkTooManyArgNamesSplitTest = + module + interface + putFooBar x y = $display "putFooBar: " (cshow x) " " (cshow y) + +{-# synthesize sysTooManyArgNames #-} +sysTooManyArgNames :: Module Empty +sysTooManyArgNames = + module + s <- mkTooManyArgNamesSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFooBar (Foo { x = 5; y = 6; }) (Bar { f = Foo { x = 7; y = 8; }; b = True; }) + when i == 1 ==> $finish + diff --git a/testsuite/bsc.verilog/splitports/TooManyArgNames.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/TooManyArgNames.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..ca84b40ce --- /dev/null +++ b/testsuite/bsc.verilog/splitports/TooManyArgNames.bs.bsc-vcomp-out.expected @@ -0,0 +1,10 @@ +checking package dependencies +compiling TooManyArgNames.bs +code generation for mkTooManyArgNamesSplitTest starts +Error: "TooManyArgNames.bs", line 27, column 29: (S0015) + Bluespec evaluation-time error: 2 excess arg_names provided for method + putFooBar + During elaboration of the interface method `putFooBar' at + "TooManyArgNames.bs", line 30, column 0. + During elaboration of `mkTooManyArgNamesSplitTest' at "TooManyArgNames.bs", + line 30, column 0. diff --git a/testsuite/bsc.verilog/splitports/splitports.exp b/testsuite/bsc.verilog/splitports/splitports.exp new file mode 100644 index 000000000..0987ba1ba --- /dev/null +++ b/testsuite/bsc.verilog/splitports/splitports.exp @@ -0,0 +1,66 @@ + +test_c_veri ShallowSplit +if { $vtest == 1 } { + find_regexp mkShallowSplitTest.v {input \[7 : 0\] putFoo_1_x;} + find_regexp mkShallowSplitTest.v {input \[15 : 0\] PUT_BAR_1_z;} + find_regexp mkShallowSplitTest.v {input \[7 : 0\] putFooBar_fooIn_y;} + find_regexp mkShallowSplitTest.v {input \[16 : 0\] putFooBar_barIn_w;} + find_regexp mkShallowSplitTest.v {input \[15 : 0\] putFoos_1_0;} + find_regexp mkShallowSplitTest.v {input \[15 : 0\] putFoos_1_49;} + find_regexp mkShallowSplitTest.v {input \[16 : 0\] putBaz_1_a;} + find_regexp mkShallowSplitTest.v {input \[491 : 0\] putBaz_1_c;} +} + +test_c_veri DeepSplit +if { $vtest == 1 } { + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putFoo_1_x;} + find_regexp mkDeepSplitTest.v {input PUT_BAR_1_v_2;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] PUT_BAR_1_z_y;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putFooBar_fooIn_y;} + find_regexp mkDeepSplitTest.v {input putFooBar_barIn_v_2;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putFoos_1_0_x;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putFoos_1_49_y;} + find_regexp mkDeepSplitTest.v {input \[16 : 0\] putBaz_1_a;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putBaz_1_c_2_1_7_y;} + find_regexp mkDeepSplitTest.v {input \[15 : 0\] putBaz_1_c_2_2_w_2;} + find_regexp mkDeepSplitTest.v {input \[3 : 0\] putZug_1_qs_1;} +} + +test_c_veri InstanceSplit +if { $vtest == 1 } { + find_regexp mkInstanceSplitTest.v {input \[7 : 0\] putFoo_1_x;} + find_regexp mkInstanceSplitTest.v {input putFoo_1_ysign;} + find_regexp mkInstanceSplitTest.v {input \[6 : 0\] putFoo_1_yvalue;} + find_regexp mkInstanceSplitTest.v {input \[7 : 0\] PUT_BAR_1_z_x;} + find_regexp mkInstanceSplitTest.v {input \[6 : 0\] putFooBar_fooIn_yvalue;} + find_regexp mkInstanceSplitTest.v {input \[16 : 0\] putFooBar_barIn_w;} + find_regexp mkInstanceSplitTest.v {input \[799 : 0\] putFoos_1;} + find_regexp mkInstanceSplitTest.v {input \[16 : 0\] putBaz_1_a;} + find_regexp mkInstanceSplitTest.v {input \[491 : 0\] putBaz_1_c;} +} + +# Supplying an arg_names pragma that is shorter than the number of arguments +# is currently supported: +test_c_veri SomeArgNames +if { $vtest == 1 } { + find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_fooIn_x;} + find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_fooIn_y;} + find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_2_f_x;} + find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_2_f_y;} + find_regexp mkSomeArgNamesSplitTest.v {input putFooBar_2_b;} +} + +compile_verilog_fail_error TooManyArgNames.bs S0015 +compare_file TooManyArgNames.bs.bsc-vcomp-out + +compile_verilog_fail_error PortNameConflict.bs G0055 +compare_file PortNameConflict.bs.bsc-vcomp-out + +compile_verilog_fail_error ArgNamesPragma_PortNameConflict.bs G0055 +compare_file ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out + +compile_verilog_fail_error BadSplitInst_PortNameConflict.bs G0055 +compare_file BadSplitInst_PortNameConflict.bs.bsc-vcomp-out + +compile_verilog_fail_error BadSplitInst_TooManyPortNames.bs S0015 +compare_file BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out diff --git a/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected b/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected new file mode 100644 index 000000000..fa26cd6e1 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected @@ -0,0 +1,6 @@ +putFoo: Foo {x= 1; y= 2} +putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} +putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} +putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] +putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} +putZug: Zug {qs=[Quix {q= 1; v=True}, Quix {q= 2; v=False}]; blob=False} diff --git a/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected b/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected new file mode 100644 index 000000000..bb4f2dc03 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected @@ -0,0 +1,5 @@ +putFoo: Foo {x= 1; y= 2} +putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} +putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} +putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] +putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} diff --git a/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected b/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected new file mode 100644 index 000000000..bb4f2dc03 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected @@ -0,0 +1,5 @@ +putFoo: Foo {x= 1; y= 2} +putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} +putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} +putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] +putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} diff --git a/testsuite/bsc.verilog/splitports/sysSomeArgNames.out.expected b/testsuite/bsc.verilog/splitports/sysSomeArgNames.out.expected new file mode 100644 index 000000000..09b08a778 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/sysSomeArgNames.out.expected @@ -0,0 +1 @@ +putFooBar: Foo {x= 5; y= 6} Bar {f=Foo {x= 7; y= 8}; b=True}