diff --git a/clash-cosim/src/Clash/CoSim/DSLParser.hs b/clash-cosim/src/Clash/CoSim/DSLParser.hs index 8729d6c9f1..41ceeb1d6f 100644 --- a/clash-cosim/src/Clash/CoSim/DSLParser.hs +++ b/clash-cosim/src/Clash/CoSim/DSLParser.hs @@ -129,11 +129,9 @@ dslParser = -- The parser will detect a module name if it is mentioned as the first thing -- followed by at least three dashes on the following line. For example: -- --- @ --- MODULE: my_module_name --- ---------- --- --- @ +-- > MODULE: my_module_name +-- > ---------- +-- > parse :: String -> Either ParseError (Maybe String, CoSimDSL) diff --git a/clash-ffi/src/Clash/FFI/VPI/Object/Value/Parse.hs b/clash-ffi/src/Clash/FFI/VPI/Object/Value/Parse.hs index 221ae734ec..b5a0e8e5ae 100644 --- a/clash-ffi/src/Clash/FFI/VPI/Object/Value/Parse.hs +++ b/clash-ffi/src/Clash/FFI/VPI/Object/Value/Parse.hs @@ -86,9 +86,7 @@ parseBinStr bitSize bin = do -- -- Consider the following bit string: -- --- @ --- 9'b.0.1.1001 --- @ +-- > 9'b.0.1.1001 -- -- Attempting to read this as octal or hexadecimal results in a loss of -- precision in the value, giving @XX1@ and @xX9@. When @\'X\'@ (or @\'Z\'@) diff --git a/clash-lib/src/Clash/Netlist/Util.hs b/clash-lib/src/Clash/Netlist/Util.hs index 8364b1c254..0103ec2666 100644 --- a/clash-lib/src/Clash/Netlist/Util.hs +++ b/clash-lib/src/Clash/Netlist/Util.hs @@ -1168,15 +1168,13 @@ declareUseOnce u i = usageMap %= Map.alter go (Id.toText i) -- | Declare uses which occur as a result of a component being instantiated, -- for example the following design (verilog) -- --- @ --- module f ( input p; output reg r ) ... endmodule --- --- module top ( ... ) --- ... --- f f_inst ( .p(p), .r(foo)); --- ... --- endmodule --- @ +-- > module f ( input p; output reg r ) ... endmodule +-- > +-- > module top ( ... ) +-- > ... +-- > f f_inst ( .p(p), .r(foo)); +-- > ... +-- > endmodule -- -- would declare a usage of foo, since it is assigned by @f_inst@. -- diff --git a/clash-lib/src/Clash/Normalize/Transformations/Case.hs b/clash-lib/src/Clash/Normalize/Transformations/Case.hs index cd3643951a..c2439c5747 100644 --- a/clash-lib/src/Clash/Normalize/Transformations/Case.hs +++ b/clash-lib/src/Clash/Normalize/Transformations/Case.hs @@ -454,18 +454,20 @@ matchLiteralContructor c _ _ = -- | Remove non-reachable alternatives. For example, consider: -- --- data STy ty where --- SInt :: Int -> STy Int --- SBool :: Bool -> STy Bool +-- @ +-- data STy ty where +-- SInt :: Int -> STy Int +-- SBool :: Bool -> STy Bool -- --- f :: STy ty -> ty --- f (SInt b) = b + 1 --- f (SBool True) = False --- f (SBool False) = True --- {-# NOINLINE f #-} +-- f :: STy ty -> ty +-- f (SInt b) = b + 1 +-- f (SBool True) = False +-- f (SBool False) = True +-- {\-\# NOINLINE f \#-\} -- --- g :: STy Int -> Int --- g = f +-- g :: STy Int -> Int +-- g = f +-- @ -- -- @f@ is always specialized on @STy Int@. The SBool alternatives are therefore -- unreachable. Additional information can be found at: @@ -498,7 +500,7 @@ caseElemNonReachable _ e = return e -- GHC generates Core that looks like: -- -- @ --- f = \(x :: Unsigned 4) -> case x == fromInteger 3 of +-- f = \\(x :: Unsigned 4) -> case x == fromInteger 3 of -- False -> case x == fromInteger 2 of -- False -> case x == fromInteger 1 of -- False -> case x == fromInteger 0 of @@ -515,7 +517,7 @@ caseElemNonReachable _ e = return e -- This transformation transforms the above Core to the saner: -- -- @ --- f = \(x :: Unsigned 4) -> case x of +-- f = \\(x :: Unsigned 4) -> case x of -- _ -> error "incomplete case" -- 0 -> fromInteger 3 -- 1 -> fromInteger 2 diff --git a/clash-lib/src/Clash/Normalize/Transformations/Cast.hs b/clash-lib/src/Clash/Normalize/Transformations/Cast.hs index 222a5a91fe..7fc54030f3 100644 --- a/clash-lib/src/Clash/Normalize/Transformations/Cast.hs +++ b/clash-lib/src/Clash/Normalize/Transformations/Cast.hs @@ -42,7 +42,7 @@ import Clash.Util (ClashException(..), curLoc) -- transforms to: -- @ -- y = f' a --- where f' x' = (\x -> g x) (cast x') +-- where f' x' = (\\x -> g x) (cast x') -- @ -- -- The reason d'etre for this transformation is that we hope to end up with diff --git a/clash-lib/src/Clash/Normalize/Transformations/MultiPrim.hs b/clash-lib/src/Clash/Normalize/Transformations/MultiPrim.hs index 6687747ccb..a934bc9d99 100644 --- a/clash-lib/src/Clash/Normalize/Transformations/MultiPrim.hs +++ b/clash-lib/src/Clash/Normalize/Transformations/MultiPrim.hs @@ -58,7 +58,7 @@ import Clash.Rewrite.Util (changed) -- will be rewritten to: -- -- @ --- \(x :: a) -> +-- \\(x :: a) -> -- let -- r = prim @a @b @c x r0 r1 -- With 'Clash.Core.Term.MultiPrim' -- r0 = c$multiPrimSelect r0 r diff --git a/clash-lib/src/Clash/Normalize/Transformations/Specialize.hs b/clash-lib/src/Clash/Normalize/Transformations/Specialize.hs index 1550eb3668..e828fc6c4a 100644 --- a/clash-lib/src/Clash/Normalize/Transformations/Specialize.hs +++ b/clash-lib/src/Clash/Normalize/Transformations/Specialize.hs @@ -141,7 +141,7 @@ import Clash.Util (ClashException(..)) -- Imagine -- -- @ --- (\x -> e) u +-- (\\x -> e) u -- @ -- -- where @u@ has a free variable named @x@, rewriting this to: diff --git a/clash-lib/src/Clash/Primitives/DSL.hs b/clash-lib/src/Clash/Primitives/DSL.hs index 79a03e2869..6a5bf63874 100644 --- a/clash-lib/src/Clash/Primitives/DSL.hs +++ b/clash-lib/src/Clash/Primitives/DSL.hs @@ -842,14 +842,12 @@ instHO bbCtx fPos (resTy, bbResTy) argsWithTypes = do -- -- A typical result is that a -- --- @ --- component fifo port --- ( rst : in std_logic --- ... --- ; full : out std_logic --- ; empty : out std_logic ); --- end component; --- @ +-- > component fifo port +-- > ( rst : in std_logic +-- > ... +-- > ; full : out std_logic +-- > ; empty : out std_logic ); +-- > end component; -- -- declaration would be added in the appropriate place. compInBlock @@ -1068,9 +1066,7 @@ notExpr nm aExpr = do -- | Creates a BV that produces the following vhdl: -- --- @ --- (0 to n => ARG) --- @ +-- > (0 to n => ARG) -- -- TODO: Implement for (System)Verilog pureToBV @@ -1090,9 +1086,7 @@ pureToBV nm n arg = do -- | Creates a BV that produces the following vhdl: -- --- @ --- std_logic_vector(resize(ARG, n)) --- @ +-- > std_logic_vector(resize(ARG, n)) -- -- TODO: Implement for (System)Verilog pureToBVResized diff --git a/clash-prelude/src/Clash/Annotations/Primitive.hs b/clash-prelude/src/Clash/Annotations/Primitive.hs index c98e764d18..b326b220f2 100644 --- a/clash-prelude/src/Clash/Annotations/Primitive.hs +++ b/clash-prelude/src/Clash/Annotations/Primitive.hs @@ -201,10 +201,8 @@ data HDL -- -- You create a package which has a @myfancyip.cabal@ file with the following stanza: -- --- @ --- data-files: path\/to\/MyFancyIP.primitives --- cpp-options: -DCABAL --- @ +-- > data-files: path/to/MyFancyIP.primitives +-- > cpp-options: -DCABAL -- -- and a @MyFancyIP.hs@ module with the simulation definition and primitive. -- diff --git a/clash-prelude/src/Clash/Annotations/SynthesisAttributes.hs b/clash-prelude/src/Clash/Annotations/SynthesisAttributes.hs index 1c6183f5a2..6528e11123 100644 --- a/clash-prelude/src/Clash/Annotations/SynthesisAttributes.hs +++ b/clash-prelude/src/Clash/Annotations/SynthesisAttributes.hs @@ -41,11 +41,9 @@ type Annotate (a :: Type) (attrs :: k) = a -- | Synthesis attributes are directives passed to synthesis tools, such as -- Quartus. An example of such an attribute in VHDL: -- --- @ --- attribute chip_pin : string; --- attribute chip_pin of sel : signal is \"C4\"; --- attribute chip_pin of data : signal is "D1, D2, D3, D4"; --- @ +-- > attribute chip_pin : string; +-- > attribute chip_pin of sel : signal is "C4"; +-- > attribute chip_pin of data : signal is "D1, D2, D3, D4"; -- -- This would instruct the synthesis tool to map the wire /sel/ to pin /C4/, and -- wire /data/ to pins /D1/, /D2/, /D3/, and /D4/. To achieve this in Clash, /Attr/s @@ -92,7 +90,7 @@ type Annotate (a :: Type) (attrs :: k) = a -- @ -- f :: Signal System Bool \`Annotate\` 'StringAttr \"chip_pin\" \"C4\" -- -> Signal System Bool --- f x = id x -- Using a lambda, i.e. f = \x -> id x also works +-- f x = id x -- Using a lambda, i.e. f = \\x -> id x also works -- @ -- -- will reliably show the annotation in the generated HDL, but diff --git a/clash-prelude/src/Clash/Annotations/TopEntity.hs b/clash-prelude/src/Clash/Annotations/TopEntity.hs index 7c71c3457a..57e5313e7b 100644 --- a/clash-prelude/src/Clash/Annotations/TopEntity.hs +++ b/clash-prelude/src/Clash/Annotations/TopEntity.hs @@ -62,11 +62,11 @@ module Blinker where import Clash.Prelude import Clash.Intel.ClockGen --- Define a synthesis domain with a clock with a period of 20000 /ps/. Signal +-- Define a synthesis domain with a clock with a period of 20000 \/ps\/. Signal -- coming from the reset button is low when pressed, and high when not pressed. 'Clash.Explicit.Signal.createDomain' vSystem{vName=\"DomInput\", vPeriod=20000, vResetPolarity=ActiveLow} --- Define a synthesis domain with a clock with a period of 50000 /ps/. +-- Define a synthesis domain with a clock with a period of 50000 \/ps\/. 'Clash.Explicit.Signal.createDomain' vSystem{vName=\"Dom50\", vPeriod=50000} topEntity @@ -117,31 +117,29 @@ blinkerT (leds,mode,cntr) key1R = ((leds',mode',cntr'),leds) The Clash compiler would normally generate the following @topEntity.vhdl@ file: -@ --- Automatically generated VHDL-93 -library IEEE; -use IEEE.STD_LOGIC_1164.ALL; -use IEEE.NUMERIC_STD.ALL; -use IEEE.MATH_REAL.ALL; -use std.textio.all; -use work.all; -use work.Blinker_topEntity_types.all; - -entity topEntity is - port(-- clock - clk20 : in Blinker_topEntity_types.clk_DomInput; - -- reset - rstBtn : in Blinker_topEntity_types.rst_DomInput; - -- enable - enaBtn : in Blinker_topEntity_types.en_Dom50; - modeBtn : in std_logic; - result : out std_logic_vector(7 downto 0)); -end; - -architecture structural of topEntity is - ... -end; -@ +> -- Automatically generated VHDL-93 +> library IEEE; +> use IEEE.STD_LOGIC_1164.ALL; +> use IEEE.NUMERIC_STD.ALL; +> use IEEE.MATH_REAL.ALL; +> use std.textio.all; +> use work.all; +> use work.Blinker_topEntity_types.all; +> +> entity topEntity is +> port(-- clock +> clk20 : in Blinker_topEntity_types.clk_DomInput; +> -- reset +> rstBtn : in Blinker_topEntity_types.rst_DomInput; +> -- enable +> enaBtn : in Blinker_topEntity_types.en_Dom50; +> modeBtn : in std_logic; +> result : out std_logic_vector(7 downto 0)); +> end; +> +> architecture structural of topEntity is +> ... +> end; However, if we add the following 'Synthesize' annotation in the file: @@ -159,31 +157,29 @@ However, if we add the following 'Synthesize' annotation in the file: The Clash compiler will generate the following @blinker.vhdl@ file instead: -@ --- Automatically generated VHDL-93 -library IEEE; -use IEEE.STD_LOGIC_1164.ALL; -use IEEE.NUMERIC_STD.ALL; -use IEEE.MATH_REAL.ALL; -use std.textio.all; -use work.all; -use work.blinker_types.all; - -entity blinker is - port(-- clock - CLOCK_50 : in blinker_types.clk_DomInput; - -- reset - KEY0 : in blinker_types.rst_DomInput; - -- enable - KEY1 : in blinker_types.en_Dom50; - KEY2 : in std_logic; - LED : out std_logic_vector(7 downto 0)); -end; - -architecture structural of blinker is - ... -end; -@ +> -- Automatically generated VHDL-93 +> library IEEE; +> use IEEE.STD_LOGIC_1164.ALL; +> use IEEE.NUMERIC_STD.ALL; +> use IEEE.MATH_REAL.ALL; +> use std.textio.all; +> use work.all; +> use work.blinker_types.all; +> +> entity blinker is +> port(-- clock +> CLOCK_50 : in blinker_types.clk_DomInput; +> -- reset +> KEY0 : in blinker_types.rst_DomInput; +> -- enable +> KEY1 : in blinker_types.en_Dom50; +> KEY2 : in std_logic; +> LED : out std_logic_vector(7 downto 0)); +> end; +> +> architecture structural of blinker is +> ... +> end; Where we now have: @@ -293,14 +289,12 @@ instance Lift TopEntity where -- -- Clash would normally generate the following VHDL entity: -- --- @ --- entity f is --- port(a : in signed(63 downto 0); --- b_0 : in signed(63 downto 0); --- b_1 : in boolean; --- result : out std_logic_vector(65 downto 0)); --- end; --- @ +-- > entity f is +-- > port(a : in signed(63 downto 0); +-- > b_0 : in signed(63 downto 0); +-- > b_1 : in boolean; +-- > result : out std_logic_vector(65 downto 0)); +-- > end; -- -- However, we can change this by using 'PortName's. So by: -- @@ -317,13 +311,11 @@ instance Lift TopEntity where -- -- we get: -- --- @ --- entity f is --- port(a : in signed(63 downto 0); --- b : in std_logic_vector(64 downto 0); --- res : out std_logic_vector(65 downto 0)); --- end; --- @ +-- > entity f is +-- > port(a : in signed(63 downto 0); +-- > b : in std_logic_vector(64 downto 0); +-- > res : out std_logic_vector(65 downto 0)); +-- > end; -- -- If we want to name fields for tuples/records we have to use 'PortProduct' -- @@ -340,15 +332,13 @@ instance Lift TopEntity where -- -- So that we get: -- --- @ --- entity f is --- port(a : in signed(63 downto 0); --- b : in signed(63 downto 0); --- c : in boolean; --- res_q : out std_logic_vector(64 downto 0); --- res_1 : out boolean); --- end; --- @ +-- > entity f is +-- > port(a : in signed(63 downto 0); +-- > b : in signed(63 downto 0); +-- > c : in boolean; +-- > res_q : out std_logic_vector(64 downto 0); +-- > res_1 : out boolean); +-- > end; -- -- Notice how we didn't name the second field of the result, and the second -- output port got 'PortProduct' name, \"res\", as a prefix for its name. diff --git a/clash-prelude/src/Clash/Examples.hs b/clash-prelude/src/Clash/Examples.hs index cb538c0a69..609e36450e 100644 --- a/clash-prelude/src/Clash/Examples.hs +++ b/clash-prelude/src/Clash/Examples.hs @@ -321,7 +321,7 @@ uartRX r\@(RxReg {..}) rx_in uld_rx_data rx_enable = 'flip' 'execState' r $ do rx_busy '.=' True rx_sample_cnt '.=' 1 rx_cnt '.=' 0 - -- Star of frame detected, Proceed with rest of data + -- Start of frame detected, proceed with rest of data 'when' _rx_busy $ do rx_sample_cnt '+=' 1 -- Logic to sample at middle of data diff --git a/clash-prelude/src/Clash/Explicit/BlockRam/File.hs b/clash-prelude/src/Clash/Explicit/BlockRam/File.hs index 5326be97f8..55922c07ff 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam/File.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam/File.hs @@ -11,26 +11,22 @@ Maintainer : QBayLogic B.V. Block RAM primitives that can be initialized with a data file. The BNF grammar for this data file is simple: -@ -FILE = LINE+ -LINE = BIT+ -BIT = '0' - | '1' -@ +> FILE = LINE+ +> LINE = BIT+ +> BIT = '0' +> | '1' Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@. For example, a data file @memory.bin@ containing the 9-bit unsigned numbers @7@ to @13@ looks like: -@ -000000111 -000001000 -000001001 -000001010 -000001011 -000001100 -000001101 -@ +> 000000111 +> 000001000 +> 000001001 +> 000001010 +> 000001011 +> 000001100 +> 000001101 Such a file can be produced with 'memFile': diff --git a/clash-prelude/src/Clash/Explicit/ROM/File.hs b/clash-prelude/src/Clash/Explicit/ROM/File.hs index 9432e579b8..ef48040892 100644 --- a/clash-prelude/src/Clash/Explicit/ROM/File.hs +++ b/clash-prelude/src/Clash/Explicit/ROM/File.hs @@ -10,26 +10,22 @@ Maintainer : QBayLogic B.V. ROMs initialized with a data file. The BNF grammar for this data file is simple: -@ -FILE = LINE+ -LINE = BIT+ -BIT = '0' - | '1' -@ +> FILE = LINE+ +> LINE = BIT+ +> BIT = '0' +> | '1' Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@. For example, a data file @memory.bin@ containing the 9-bit unsigned numbers @7@ to @13@ looks like: -@ -000000111 -000001000 -000001001 -000001010 -000001011 -000001100 -000001101 -@ +> 000000111 +> 000001000 +> 000001001 +> 000001010 +> 000001011 +> 000001100 +> 000001101 Such a file can be produced with 'memFile': diff --git a/clash-prelude/src/Clash/Explicit/Reset.hs b/clash-prelude/src/Clash/Explicit/Reset.hs index 772d84d301..8d7a400f81 100644 --- a/clash-prelude/src/Clash/Explicit/Reset.hs +++ b/clash-prelude/src/Clash/Explicit/Reset.hs @@ -184,36 +184,32 @@ unsafeAndReset (unsafeFromReset -> rst0) (unsafeFromReset -> rst1) = -- === __Implementation details__ -- 'resetSynchronizer' implements the following circuit for asynchronous domains: -- --- @ --- rst --- --------------------------------------+ --- | | --- +----v----+ +----v----+ --- deasserted | | | | --- ---------------> +-------> +--------> --- | | | | --- +---|> | +---|> | --- | | | | | | --- | +---------+ | +---------+ --- clk | | --- -----------------------------+ --- @ +-- > rst +-- > --------------------------------------+ +-- > | | +-- > +----v----+ +----v----+ +-- > deasserted | | | | +-- > ---------------> +-------> +--------> +-- > | | | | +-- > +---|> | +---|> | +-- > | | | | | | +-- > | +---------+ | +---------+ +-- > clk | | +-- > -----------------------------+ -- -- This corresponds to figure 3d at -- -- For synchronous domains two sequential dflipflops are used: -- --- @ --- +---------+ +---------+ --- rst | | | | --- ---------------> +-------> +--------> --- | | | | --- +---|> | +---|> | --- | | | | | | --- | +---------+ | +---------+ --- clk | | --- -----------------------------+ --- @ +-- > +---------+ +---------+ +-- > rst | | | | +-- > ---------------> +-------> +--------> +-- > | | | | +-- > +---|> | +---|> | +-- > | | | | | | +-- > | +---------+ | +---------+ +-- > clk | | +-- > -----------------------------+ -- resetSynchronizer :: forall dom diff --git a/clash-prelude/src/Clash/Explicit/Signal.hs b/clash-prelude/src/Clash/Explicit/Signal.hs index d4f4c1a45c..17b31fcee6 100644 --- a/clash-prelude/src/Clash/Explicit/Signal.hs +++ b/clash-prelude/src/Clash/Explicit/Signal.hs @@ -27,7 +27,7 @@ domain looks like: { _name:: 'GHC.TypeLits.Symbol' -- ^ Domain name , _period :: 'GHC.TypeLits.Nat' - -- ^ Clock period in /ps/ + -- ^ Clock period in \/ps\/ , _edge :: 'ActiveEdge' -- ^ Active edge of the clock , _reset :: 'ResetKind' @@ -46,8 +46,8 @@ made. Clash provides a standard implementation, called 'System', that is configured as follows: @ -instance KnownDomain "System" where - type KnownConf "System" = 'DomainConfiguration "System" 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh +instance KnownDomain 'System' where + type KnownConf 'System' = 'DomainConfiguration 'System' 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh knownDomain = 'SDomainConfiguration' SSymbol SNat 'SRising' 'SAsynchronous' 'SDefined' 'SActiveHigh' @ @@ -514,7 +514,7 @@ unsafeSynchronizer clk1 clk2 = -- cannot be done precisely and can lead to odd behavior. For example, -- -- @ --- sample $ unsafeSynchronizer @Dom2 @Dom7 . unsafeSynchronizer @Dom7 @Dom2 $ fromList [0..10] +-- sample $ unsafeSynchronizer \@Dom2 \@Dom7 . unsafeSynchronizer \@Dom7 \@Dom2 $ fromList [0..10] -- > [0,4,4,4,7,7,7,7,11,11,11.. -- @ -- @@ -917,9 +917,7 @@ sampleWithResetN nReset nSamples f = -- -- It prints a message of the form -- --- @ --- Signal sampled for N cycles until value X --- @ +-- > Signal sampled for N cycles until value X -- -- __NB__: This function is not synthesizable -- diff --git a/clash-prelude/src/Clash/Explicit/Testbench.hs b/clash-prelude/src/Clash/Explicit/Testbench.hs index d39e139954..86c83c051c 100644 --- a/clash-prelude/src/Clash/Explicit/Testbench.hs +++ b/clash-prelude/src/Clash/Explicit/Testbench.hs @@ -449,8 +449,8 @@ tbEnableGen = toEnable (pure True) -- where -- testInput = pure ((1 :> 2 :> 3 :> Nil) :> (4 :> 5 :> 6 :> Nil) :> Nil) -- expectedOutput = outputVerifier' ((1:>2:>3:>4:>5:>6:>Nil):>Nil) --- done = exposeClockResetEnable (expectedOutput (topEntity <$> testInput)) clk rst --- clk = 'tbSystemClockGen' (not <\$\> done) +-- done = exposeClockResetEnable (expectedOutput (topEntity \<\$> testInput)) clk rst +-- clk = 'tbSystemClockGen' (not \<\$> done) -- rst = systemResetGen -- @ tbSystemClockGen diff --git a/clash-prelude/src/Clash/Explicit/Verification.hs b/clash-prelude/src/Clash/Explicit/Verification.hs index 10e1c0e0c4..04967893ed 100644 --- a/clash-prelude/src/Clash/Explicit/Verification.hs +++ b/clash-prelude/src/Clash/Explicit/Verification.hs @@ -84,26 +84,22 @@ lit = Assertion IsNotTemporal . CvLit -- | Truth table for 'not': -- --- @ --- a | not a --- ------------ --- True | False --- False | True --- @ +-- > a | not a +-- > ------------ +-- > True | False +-- > False | True not :: AssertionValue dom a => a -> Assertion dom not (toAssertionValue -> a) = Assertion (isTemporal a) (CvNot (assertion a)) {-# INLINE not #-} -- | Truth table for 'and': -- --- @ --- a | b | a `and` b --- --------------|---------- --- False | False | False --- False | True | False --- True | False | False --- True | True | True --- @ +-- > a | b | a `and` b +-- > --------------|---------- +-- > False | False | False +-- > False | True | False +-- > True | False | False +-- > True | True | True and :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom and (toAssertionValue -> a) (toAssertionValue -> b) = Assertion @@ -113,14 +109,12 @@ and (toAssertionValue -> a) (toAssertionValue -> b) = -- | Truth table for 'or': -- --- @ --- a | b | a `or` b --- --------------|--------- --- False | False | False --- False | True | True --- True | False | True --- True | True | True --- @ +-- > a | b | a `or` b +-- > --------------|--------- +-- > False | False | False +-- > False | True | True +-- > True | False | True +-- > True | True | True or :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom or (toAssertionValue -> a) (toAssertionValue -> b) = Assertion @@ -131,14 +125,12 @@ or (toAssertionValue -> a) (toAssertionValue -> b) = -- | -- Truth table for 'implies': -- --- @ --- a | b | a `implies` b --- --------------|-------------- --- False | False | True --- False | True | True --- True | False | False --- True | True | True --- @ +-- > a | b | a `implies` b +-- > --------------|-------------- +-- > False | False | True +-- > False | True | True +-- > True | False | False +-- > True | True | True implies :: (AssertionValue dom a, AssertionValue dom b) => a -> b -> Assertion dom implies (toAssertionValue -> Assertion aTmp a) (toAssertionValue -> Assertion bTmp b) = Assertion (max aTmp bTmp) (CvImplies a b) @@ -146,14 +138,12 @@ implies (toAssertionValue -> Assertion aTmp a) (toAssertionValue -> Assertion bT -- | Truth table for 'next': -- --- @ --- a[n] | a[n+1] | a `implies` next a --- ---------------|------------------- --- False | False | True --- False | True | True --- True | False | False --- True | True | True --- @ +-- > a[n] | a[n+1] | a `implies` next a +-- > ---------------|------------------- +-- > False | False | True +-- > False | True | True +-- > True | False | False +-- > True | True | True -- -- where a[n] represents the value of @a@ at cycle @n@ and @a[n+1]@ represents -- the value of @a@ at cycle @n+1@. Cycle n is an arbitrary cycle. @@ -163,14 +153,12 @@ next = nextN 1 -- | Truth table for 'nextN': -- --- @ --- a[n] | a[n+m] | a `implies` next m a --- ---------------|--------------------- --- False | False | True --- False | True | True --- True | False | False --- True | True | True --- @ +-- > a[n] | a[n+m] | a `implies` next m a +-- > ---------------|--------------------- +-- > False | False | True +-- > False | True | True +-- > True | False | False +-- > True | True | True -- -- where a[n] represents the value of @a@ at cycle @n@ and a[n+m] represents -- the value of @a@ at cycle @n+m@. Cycle n is an arbitrary cycle. diff --git a/clash-prelude/src/Clash/Intel/ClockGen.hs b/clash-prelude/src/Clash/Intel/ClockGen.hs index 0ff0f3cab3..7e2a62ad9a 100644 --- a/clash-prelude/src/Clash/Intel/ClockGen.hs +++ b/clash-prelude/src/Clash/Intel/ClockGen.hs @@ -193,26 +193,22 @@ When type checking cannot infer the types of the tuple elements, or they have the wrong type, the GHC compiler will complain about satisfying @NumOutClocks@. The error message on GHC 9.4 and up is: -@ - • Cannot satisfy: clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks - (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst - ([...]) - DomInput) <= 18 - • In the expression: alteraPllSync clkIn rstIn -@ +> • Cannot satisfy: clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks +> (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst +> ([...]) +> DomInput) <= 18 +> • In the expression: alteraPllSync clkIn rstIn On older GHC versions, the error message is: -@ - • Couldn't match type ‘clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks - (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst - ([...]) - DomInput) - <=? 18’ - with ‘'True’ - arising from a use of ‘alteraPllSync’ - • In the expression: alteraPllSync clkIn rstIn -@ +> • Couldn't match type ‘clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks +> (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst +> ([...]) +> DomInput) +> <=? 18’ +> with ‘'True’ +> arising from a use of ‘alteraPllSync’ +> • In the expression: alteraPllSync clkIn rstIn The above error message is also emitted when trying to instantiate more than 18 output clocks, as it will fail to find an instance. As 'altpllSync' supports no @@ -220,18 +216,14 @@ more than 5 clocks, trying to instantiate between 6 and 18 output clocks will also cause a type checking error. On GHC 9.4 and up, the error for attempting to instantiate 6 clocks is: -@ - • Cannot satisfy: 6 <= 5 - • In the expression: altpllSync clkIn rstIn -@ +> • Cannot satisfy: 6 <= 5 +> • In the expression: altpllSync clkIn rstIn On older GHC versions, the error message is less clear: -@ - • Couldn't match type ‘'False’ with ‘'True’ - arising from a use of ‘altpllSync’ - • In the expression: altpllSync clkIn rstIn -@ +> • Couldn't match type ‘'False’ with ‘'True’ +> arising from a use of ‘altpllSync’ +> • In the expression: altpllSync clkIn rstIn -} {- $unsafe diff --git a/clash-prelude/src/Clash/Prelude/BlockRam/File.hs b/clash-prelude/src/Clash/Prelude/BlockRam/File.hs index 2ea4a68db0..a46c7329b4 100644 --- a/clash-prelude/src/Clash/Prelude/BlockRam/File.hs +++ b/clash-prelude/src/Clash/Prelude/BlockRam/File.hs @@ -11,26 +11,22 @@ Maintainer : QBayLogic B.V. Block RAM primitives that can be initialized with a data file. The BNF grammar for this data file is simple: -@ -FILE = LINE+ -LINE = BIT+ -BIT = '0' - | '1' -@ +> FILE = LINE+ +> LINE = BIT+ +> BIT = '0' +> | '1' Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@. For example, a data file @memory.bin@ containing the 9-bit unsigned numbers @7@ to @13@ looks like: -@ -000000111 -000001000 -000001001 -000001010 -000001011 -000001100 -000001101 -@ +> 000000111 +> 000001000 +> 000001001 +> 000001010 +> 000001011 +> 000001100 +> 000001101 Such a file can be produced with 'E.memFile': diff --git a/clash-prelude/src/Clash/Prelude/DataFlow.hs b/clash-prelude/src/Clash/Prelude/DataFlow.hs index 3041d36aaa..ade086ff62 100644 --- a/clash-prelude/src/Clash/Prelude/DataFlow.hs +++ b/clash-prelude/src/Clash/Prelude/DataFlow.hs @@ -75,11 +75,11 @@ The 'DataFlow' type is defined as: newtype DataFlow' dom iEn oEn i o = DF { df :: 'Signal' dom i -- Incoming data - -> 'Signal' dom iEn -- Flagged with /valid/ bits @iEn@. - -> 'Signal' dom oEn -- Incoming back-pressure, /ready/ edge. + -> 'Signal' dom iEn -- Flagged with \/valid\/ bits \@iEn\@. + -> 'Signal' dom oEn -- Incoming back-pressure, \/ready\/ edge. -> ( 'Signal' dom o -- Outgoing data. - , 'Signal' dom oEn -- Flagged with /valid/ bits @oEn@. - , 'Signal' dom iEn -- Outgoing back-pressure, /ready/ edge. + , 'Signal' dom oEn -- Flagged with \/valid\/ bits \@oEn\@. + , 'Signal' dom iEn -- Outgoing back-pressure, \/ready\/ edge. ) } @ @@ -122,11 +122,11 @@ newtype DataFlow dom iEn oEn i o -- -- @ -- 'Signal' dom i -- Incoming data. --- -> 'Signal' dom Bool -- Flagged with a single /valid/ bit. --- -> 'Signal' dom Bool -- Incoming back-pressure, /ready/ bit. +-- -> 'Signal' dom Bool -- Flagged with a single \/valid\/ bit. +-- -> 'Signal' dom Bool -- Incoming back-pressure, \/ready\/ bit. -- -> ( 'Signal' dom o -- Outgoing data. --- , 'Signal' dom oEn -- Flagged with a single /valid/ bit. --- , 'Signal' dom iEn -- Outgoing back-pressure, /ready/ bit. +-- , 'Signal' dom oEn -- Flagged with a single \/valid\/ bit. +-- , 'Signal' dom iEn -- Outgoing back-pressure, \/ready\/ bit. -- ) -- @ -- diff --git a/clash-prelude/src/Clash/Prelude/ROM/File.hs b/clash-prelude/src/Clash/Prelude/ROM/File.hs index 3f00dd5e22..ad0496b7d7 100644 --- a/clash-prelude/src/Clash/Prelude/ROM/File.hs +++ b/clash-prelude/src/Clash/Prelude/ROM/File.hs @@ -10,26 +10,22 @@ Maintainer : QBayLogic B.V. ROMs initialized with a data file. The BNF grammar for this data file is simple: -@ -FILE = LINE+ -LINE = BIT+ -BIT = '0' - | '1' -@ +> FILE = LINE+ +> LINE = BIT+ +> BIT = '0' +> | '1' Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@. For example, a data file @memory.bin@ containing the 9-bit unsigned numbers @7@ to @13@ looks like: -@ -000000111 -000001000 -000001001 -000001010 -000001011 -000001100 -000001101 -@ +> 000000111 +> 000001000 +> 000001001 +> 000001010 +> 000001011 +> 000001100 +> 000001101 Such a file can be produced with 'memFile': diff --git a/clash-prelude/src/Clash/Promoted/Nat.hs b/clash-prelude/src/Clash/Promoted/Nat.hs index c08a50a981..a13f99b272 100644 --- a/clash-prelude/src/Clash/Promoted/Nat.hs +++ b/clash-prelude/src/Clash/Promoted/Nat.hs @@ -536,7 +536,7 @@ stripZeros (B0 x) = case stripZeros x of -- head :: Vec (n + 1) a -> a -- -- head' :: forall n a. (1 'GHC.TypeNats.<=' n) => Vec n a -> a --- head' = 'leToPlus' @1 @n head +-- head' = 'leToPlus' \@1 \@n head -- @ leToPlus :: forall (k :: Nat) (n :: Nat) r diff --git a/clash-prelude/src/Clash/Signal.hs b/clash-prelude/src/Clash/Signal.hs index d6cef3bf4c..be7d4b616a 100644 --- a/clash-prelude/src/Clash/Signal.hs +++ b/clash-prelude/src/Clash/Signal.hs @@ -26,7 +26,7 @@ domain looks like: { _name :: 'Domain' -- ^ Domain name , _period :: 'Clash.Promoted.Nat.Nat' - -- ^ Clock period in /ps/ + -- ^ Clock period in \/ps\/ , _activeEdge :: 'ActiveEdge' -- ^ Active edge of the clock , _resetKind :: 'ResetKind' @@ -45,8 +45,8 @@ made. Clash provides an implementation 'System' with some common options chosen: @ -instance KnownDomain "System" where - type KnownConf "System" = 'DomainConfiguration "System" 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh +instance KnownDomain 'System' where + type KnownConf 'System' = 'DomainConfiguration 'System' 10000 'Rising 'Asynchronous 'Defined 'ActiveHigh knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh @ @@ -2173,9 +2173,7 @@ dup1 _ = error "empty list" -- -- It prints a message of the form -- --- @ --- Signal sampled for N cycles until value X --- @ +-- > Signal sampled for N cycles until value X -- -- __NB__: This function is not synthesizable -- diff --git a/clash-prelude/src/Clash/Signal/BiSignal.hs b/clash-prelude/src/Clash/Signal/BiSignal.hs index d6331e9c5d..3c46b1d365 100644 --- a/clash-prelude/src/Clash/Signal/BiSignal.hs +++ b/clash-prelude/src/Clash/Signal/BiSignal.hs @@ -77,7 +77,7 @@ g :: Clock System g clk rst en s = writeToBiSignal s (mealy clk rst en counter (True, 0) (readFromBiSignal s)) --- | Connect the /f/ and /g/ circuits to the same bus +-- | Connect the \/f\/ and \/g\/ circuits to the same bus topEntity :: Clock System -> Reset System diff --git a/clash-prelude/src/Clash/Signal/Bundle.hs b/clash-prelude/src/Clash/Signal/Bundle.hs index 79bc7a03ef..51dbe9f2a8 100644 --- a/clash-prelude/src/Clash/Signal/Bundle.hs +++ b/clash-prelude/src/Clash/Signal/Bundle.hs @@ -82,10 +82,10 @@ import Clash.Sized.RTree (RTree, lazyT) -- type Unbundled dom (Pair a b) = Pair (Signal dom a) (Signal dom b) -- -- -- bundle :: Pair (Signal dom a) (Signal dom b) -> Signal dom (Pair a b) --- bundle (MkPair as bs) = MkPair <$> as <*> bs +-- bundle (MkPair as bs) = MkPair '<$>' as '<*>' bs -- -- -- unbundle :: Signal dom (Pair a b) -> Pair (Signal dom a) (Signal dom b) --- unbundle pairs = MkPair (getA <$> pairs) (getB <$> pairs) +-- unbundle pairs = MkPair (getA '<$>' pairs) (getB '<$>' pairs) -- @ class Bundle a where diff --git a/clash-prelude/src/Clash/Sized/Fixed.hs b/clash-prelude/src/Clash/Sized/Fixed.hs index e88e2ffcfe..9a5e2dd7b5 100644 --- a/clash-prelude/src/Clash/Sized/Fixed.hs +++ b/clash-prelude/src/Clash/Sized/Fixed.hs @@ -743,10 +743,8 @@ fLit a = [|| Fixed (fromInteger sat) ||] -- synthesizable function like 'Clash.Prelude.ROM.File.asyncRomFile'. For -- example, consider a file @Data.txt@ containing: -- --- @ --- 1.2 2.0 3.0 4.0 --- -1.0 -2.0 -3.5 -4.0 --- @ +-- > 1.2 2.0 3.0 4.0 +-- > -1.0 -2.0 -3.5 -4.0 -- -- which we want to put in a ROM, interpreting them as @8.8@ signed fixed point -- numbers. What we do is that we first create a conversion utility, @@ -786,30 +784,24 @@ fLit a = [|| Fixed (fromInteger sat) ||] -- -- We then compile this to an executable: -- --- @ --- \$ clash --make createRomFile.hs --- @ +-- > $ clash --make createRomFile.hs -- -- We can then use this utility to convert our @Data.txt@ file which contains -- 'Double's to a @Data.bin@ file which will containing the desired ASCII-encoded -- binary data: -- --- @ --- \$ ./createRomFile \"Data.txt\" \"Data.bin\" --- @ +-- > $ ./createRomFile Data.txt Data.bin -- -- Which results in a @Data.bin@ file containing: -- --- @ --- 0000000100110011 --- 0000001000000000 --- 0000001100000000 --- 0000010000000000 --- 1111111100000000 --- 1111111000000000 --- 1111110010000000 --- 1111110000000000 --- @ +-- > 0000000100110011 +-- > 0000001000000000 +-- > 0000001100000000 +-- > 0000010000000000 +-- > 1111111100000000 +-- > 1111111000000000 +-- > 1111110010000000 +-- > 1111110000000000 -- -- We can then use this @Data.bin@ file in for our ROM: -- diff --git a/clash-prelude/src/Clash/Sized/RTree.hs b/clash-prelude/src/Clash/Sized/RTree.hs index 47dd2d4312..bf698cb962 100644 --- a/clash-prelude/src/Clash/Sized/RTree.hs +++ b/clash-prelude/src/Clash/Sized/RTree.hs @@ -298,6 +298,7 @@ We have such an adder in the form of the 'Clash.Class.Num.add' function, as defined in the instance 'Clash.Class.Num.ExtendingNum' instance of 'Index'. However, we cannot simply use 'Clash.Sized.Vector.fold' to create a tree-structure of 'Clash.Class.Num.add's: + #if __GLASGOW_HASKELL__ >= 900 >>> :{ let populationCount' :: (KnownNat (2^d), KnownNat d, KnownNat (2^d+1)) diff --git a/clash-prelude/src/Clash/Sized/Vector.hs b/clash-prelude/src/Clash/Sized/Vector.hs index 614a07b4a6..1863f8f7bf 100644 --- a/clash-prelude/src/Clash/Sized/Vector.hs +++ b/clash-prelude/src/Clash/Sized/Vector.hs @@ -1943,9 +1943,7 @@ gather xs = map (xs!!) -- | \"'interleave' @d xs@\" creates a vector: -- --- @ --- \ --- @ +-- > -- -- >>> let xs = 1 :> 2 :> 3 :> 4 :> 5 :> 6 :> 7 :> 8 :> 9 :> Nil -- >>> interleave d3 xs diff --git a/clash-prelude/src/Clash/Tutorial.hs b/clash-prelude/src/Clash/Tutorial.hs index fe19b316cf..8b9de7b7f3 100644 --- a/clash-prelude/src/Clash/Tutorial.hs +++ b/clash-prelude/src/Clash/Tutorial.hs @@ -234,24 +234,18 @@ at the same time. If you followed the installation instructions based on , you can start the Clash compiler in interpretive mode by: -@ -stack exec --resolver lts-19 --package clash-ghc -- clashi -@ +> stack exec --resolver lts-19 --package clash-ghc -- clashi If instead you followed the [instructions](https://clash-lang.org/install/linux/) to setup a starter project with Stack, you can also run @clashi@ inside such a project. Change to the directory of the project, and invoke -@ -stack run -- clashi -@ +> stack run -- clashi If you instead set up the starter project with GHC and Cabal, change to the directory of the project and invoke -@ -cabal run -- clashi -@ +> cabal run -- clashi For those familiar with Haskell/GHC, this is indeed just @GHCi@, with three added commands (@:vhdl@, @:verilog@, and @:systemverilog@). You can load files @@ -643,6 +637,7 @@ structure. -} {- $mac6 #mac6# + * __'Num' instance for 'Signal'__: @'Signal' a@ is also also considered a 'Num'eric type as long as the value @@ -944,29 +939,27 @@ blinkerT (leds,mode,cntr) key1R = ((leds',mode',cntr'),leds) The Clash compiler will normally generate the following @topentity.vhdl@ file: -@ --- Automatically generated VHDL-93 -library IEEE; -use IEEE.STD_LOGIC_1164.ALL; -use IEEE.NUMERIC_STD.ALL; -use IEEE.MATH_REAL.ALL; -use std.textio.all; -use work.all; -use work.Blinker_topEntity_types.all; - -entity topEntity is - port(-- clock - clk : in Blinker_topEntity_types.clk_DomInput; - -- reset - rst : in Blinker_topEntity_types.rst_DomInput; - eta : in std_logic; - result : out std_logic_vector(7 downto 0)); -end; - -architecture structural of topEntity is - ... -end; -@ +> -- Automatically generated VHDL-93 +> library IEEE; +> use IEEE.STD_LOGIC_1164.ALL; +> use IEEE.NUMERIC_STD.ALL; +> use IEEE.MATH_REAL.ALL; +> use std.textio.all; +> use work.all; +> use work.Blinker_topEntity_types.all; +> +> entity topEntity is +> port(-- clock +> clk : in Blinker_topEntity_types.clk_DomInput; +> -- reset +> rst : in Blinker_topEntity_types.rst_DomInput; +> eta : in std_logic; +> result : out std_logic_vector(7 downto 0)); +> end; +> +> architecture structural of topEntity is +> ... +> end; However, if we add the following 'Synthesize' annotation in the file: @@ -981,29 +974,27 @@ However, if we add the following 'Synthesize' annotation in the file: The Clash compiler will generate the following @blinker.vhdl@ file instead: -@ --- Automatically generated VHDL-93 -library IEEE; -use IEEE.STD_LOGIC_1164.ALL; -use IEEE.NUMERIC_STD.ALL; -use IEEE.MATH_REAL.ALL; -use std.textio.all; -use work.all; -use work.blinker_types.all; - -entity blinker is - port(-- clock - CLOCK_50 : in blinker_types.clk_DomInput; - -- reset - KEY0 : in blinker_types.rst_DomInput; - KEY1 : in std_logic; - LED : out std_logic_vector(7 downto 0)); -end; - -architecture structural of blinker is - ... -end; -@ +> -- Automatically generated VHDL-93 +> library IEEE; +> use IEEE.STD_LOGIC_1164.ALL; +> use IEEE.NUMERIC_STD.ALL; +> use IEEE.MATH_REAL.ALL; +> use std.textio.all; +> use work.all; +> use work.blinker_types.all; +> +> entity blinker is +> port(-- clock +> CLOCK_50 : in blinker_types.clk_DomInput; +> -- reset +> KEY0 : in blinker_types.rst_DomInput; +> KEY1 : in std_logic; +> LED : out std_logic_vector(7 downto 0)); +> end; +> +> architecture structural of blinker is +> ... +> end; Where we now have: @@ -1057,13 +1048,11 @@ primitives, using 'Signed' multiplication (@*@) as an example. The For which the VHDL /expression/ primitive is: -@ -BlackBox: - name: \'Clash.Sized.Internal.Signed.*#\' - kind: \'Expression\' - type: \'(*#) :: KnownNat n => Signed n -> Signed n -> Signed n\' - template: \'resize(~ARG[1] * ~ARG[2], ~LIT[0])\' -@ +> BlackBox: +> name: Clash.Sized.Internal.Signed.*# +> kind: Expression +> type: '(*#) :: KnownNat n => Signed n -> Signed n -> Signed n' +> template: resize(~ARG[1] * ~ARG[2], ~LIT[0]) The @name@ of the primitive is the /fully qualified/ name of the function you are creating the primitive for. Because we are creating an /expression/ @@ -1112,14 +1101,14 @@ blockRam# => 'Clock' dom -- ^ Clock to synchronize to -> 'Enable' dom -- ^ Global enable -> 'Vec' n a -- ^ Initial content of the BRAM, also - -- determines the size, @n@, of the BRAM. + -- determines the size, \@n\@, of the BRAM. -- - -- __NB__: __MUST__ be a constant. - -> 'Signal' dom Int -- ^ Read address @r@ + -- \_\_NB\_\_: \_\_MUST\_\_ be a constant. + -> 'Signal' dom Int -- ^ Read address \@r\@ -> 'Signal' dom Bool -- ^ Write enable - -> 'Signal' dom Int -- ^ Write address @w@ - -> 'Signal' dom a -- ^ Value to write (at address @w@) - -> 'Signal' dom a -- ^ Value of the @blockRAM@ at address @r@ from + -> 'Signal' dom Int -- ^ Write address \@w\@ + -> 'Signal' dom a -- ^ Value to write (at address \@w\@) + -> 'Signal' dom a -- ^ Value of the BRAM at address \@r\@ from -- the previous clock cycle blockRam# (Clock _) gen content rd wen = go @@ -1148,70 +1137,68 @@ blockRam# (Clock _) gen content rd wen = And for which the /declaration/ primitive is: -@ -BlackBox: - name: Clash.Explicit.BlockRam.blockRam# - kind: Declaration - type: |- - blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , NFDataX a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a - template: |- - -- blockRam begin - ~GENSYM[~RESULT_blockRam][1] : block - signal ~GENSYM[~RESULT_RAM][2] : ~TYP[5] := ~CONST[5]; - signal ~GENSYM[rd][4] : integer range 0 to ~LENGTH[~TYP[5]] - 1; - signal ~GENSYM[wr][5] : integer range 0 to ~LENGTH[~TYP[5]] - 1; - begin - ~SYM[4] <= to_integer(~ARG[6]) - -- pragma translate_off - mod ~LENGTH[~TYP[5]] - -- pragma translate_on - ; - ~SYM[5] <= to_integer(~ARG[8]) - -- pragma translate_off - mod ~LENGTH[~TYP[5]] - -- pragma translate_on - ; - ~IF ~VIVADO ~THEN - ~SYM[6] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; - end if; - ~RESULT <= fromSLV(~SYM[2](~SYM[4])) - -- pragma translate_off - after 1 ps - -- pragma translate_on - ; - end if; - end process; ~ELSE - ~SYM[6] : process(~ARG[3]) - begin - if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then - if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then - ~SYM[2](~SYM[5]) <= ~ARG[9]; - end if; - ~RESULT <= ~SYM[2](~SYM[4]) - -- pragma translate_off - after 1 ps - -- pragma translate_on - ; - end if; - end process; ~FI - end block; - --end blockRam -@ +> BlackBox: +> name: Clash.Explicit.BlockRam.blockRam# +> kind: Declaration +> type: |- +> blockRam# +> :: ( KnownDomain dom ARG[0] +> , HasCallStack -- ARG[1] +> , NFDataX a ) -- ARG[2] +> => Clock dom -- clk, ARG[3] +> -> Enable dom -- en, ARG[4] +> -> Vec n a -- init, ARG[5] +> -> Signal dom Int -- rd, ARG[6] +> -> Signal dom Bool -- wren, ARG[7] +> -> Signal dom Int -- wr, ARG[8] +> -> Signal dom a -- din, ARG[9] +> -> Signal dom a +> template: |- +> -- blockRam begin +> ~GENSYM[~RESULT_blockRam][1] : block +> signal ~GENSYM[~RESULT_RAM][2] : ~TYP[5] := ~CONST[5]; +> signal ~GENSYM[rd][4] : integer range 0 to ~LENGTH[~TYP[5]] - 1; +> signal ~GENSYM[wr][5] : integer range 0 to ~LENGTH[~TYP[5]] - 1; +> begin +> ~SYM[4] <= to_integer(~ARG[6]) +> -- pragma translate_off +> mod ~LENGTH[~TYP[5]] +> -- pragma translate_on +> ; +> ~SYM[5] <= to_integer(~ARG[8]) +> -- pragma translate_off +> mod ~LENGTH[~TYP[5]] +> -- pragma translate_on +> ; +> ~IF ~VIVADO ~THEN +> ~SYM[6] : process(~ARG[3]) +> begin +> if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then +> if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then +> ~SYM[2](~SYM[5]) <= ~TOBV[~ARG[9]][~TYP[9]]; +> end if; +> ~RESULT <= fromSLV(~SYM[2](~SYM[4])) +> -- pragma translate_off +> after 1 ps +> -- pragma translate_on +> ; +> end if; +> end process; ~ELSE +> ~SYM[6] : process(~ARG[3]) +> begin +> if ~IF~ACTIVEEDGE[Rising][0]~THENrising_edge~ELSEfalling_edge~FI(~ARG[3]) then +> if ~ARG[7] ~IF ~ISACTIVEENABLE[4] ~THEN and ~ARG[4] ~ELSE ~FI then +> ~SYM[2](~SYM[5]) <= ~ARG[9]; +> end if; +> ~RESULT <= ~SYM[2](~SYM[4]) +> -- pragma translate_off +> after 1 ps +> -- pragma translate_on +> ; +> end if; +> end process; ~FI +> end block; +> --end blockRam Again, the @name@ of the primitive is the fully qualified name of the function you are creating the primitive for. Because we are creating a /declaration/ @@ -1262,7 +1249,7 @@ a general listing of the available template holes: @-fclash-vivado@ flag. To be used with in an @~IF .. ~THEN .. ~ELSE .. ~FI@ statement. * @~CMPLE[\][\]@: /1/ when @\ \<= \@, otherwise /0/ -* @~IW64@: /1/ when Int\/Word\/Integer types are represented with 64 bits in HDL. +* @~IW64@: /1/ when @Int@\/@Word@\/@Integer@ types are represented with 64 bits in HDL. /0/ when they're represented by 32 bits. * @~TOBV[\][\]@: create conversion code that so that the expression in @\@ is converted to a bit vector (@std_logic_vector@). @@ -1290,7 +1277,7 @@ a general listing of the available template holes: a 'KnownDomain', 'Reset', or 'Clock'. * @~PERIOD[N]@: Clock period of given domain. Errors when called on an argument which is not a 'Clock', 'Reset', 'KnownDomain' or 'KnownConf'. -* @~ISACTIVEENABLE[N]@: Is the @(N+1)@'th argument a an Enable line NOT set to a +* @~ISACTIVEENABLE[N]@: Is the @(N+1)@'th argument a an Enable line __not__ set to a constant True. Can be used instead of deprecated (and removed) template tag * @~ISSYNC[N]@: Does synthesis domain at the @(N+1)@'th argument have synchronous resets. Errors when called on an argument which is not a 'Reset', 'Clock', 'Enable', 'KnownDomain' or 'KnownConf'. @@ -1301,7 +1288,7 @@ a general listing of the available template holes: argument which is not a 'Clock', 'Reset', 'Enable', 'KnownDomain' or 'KnownConf'. * @~AND[\,\,..]@: Logically /and/ the conditions in the @\@'s * @~VAR[\][N]@: Like @~ARG[N]@ but binds the argument to a variable named NAME. - The @\@ can be left blank, then clash will come up with a (unique) name. + The @\@ can be left blank, then Clash will come up with a (unique) name. * @~VARS[N]@: VHDL: Return the variables at the @(N+1)@'th argument. * @~NAME[N]@: Render the @(N+1)@'th string literal argument as an identifier instead of a string literal. Fails when the @(N+1)@'th argument is not a @@ -1328,132 +1315,124 @@ worlds, using e.g. VHDL's foreign function interface VHPI. {- $vprimitives For those who are interested, the equivalent Verilog primitives are: -@ -BlackBox: - name: Clash.Sized.Internal.Signed.*# - kind: Expression - type: \'(*#) :: KnownNat n => Signed n -> Signed n -> Signed n\' - template: ~ARG[1] * ~ARG[2] -@ +> BlackBox: +> name: Clash.Sized.Internal.Signed.*# +> kind: Expression +> type: '(*#) :: KnownNat n => Signed n -> Signed n -> Signed n' +> template: ~ARG[1] * ~ARG[2] and -@ -BlackBox: - name: Clash.Explicit.BlockRam.blockRam# - kind: Declaration - outputReg: true - type: |- - blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , NFDataX a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - => Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a - template: |- - // blockRam begin - reg ~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LENGTH[~TYP[5]]-1]; - - reg ~TYP[5] ~GENSYM[ram_init][3]; - integer ~GENSYM[i][4]; - initial begin - ~SYM[3] = ~CONST[5]; - for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[5]]; ~SYM[4] = ~SYM[4] + 1) begin - ~SYM[1][~LENGTH[~TYP[5]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; - end - end - ~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; - end - ~RESULT <= ~SYM[1][~ARG[6]]; - end~ELSE - if (~ARG[7] & ~ARG[4]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; - end - if (~ARG[4]) begin - ~RESULT <= ~SYM[1][~ARG[6]]; - end~FI - end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~ARG[9]; - end - ~RESULT <= ~SYM[1][~ARG[6]]; - end~FI - // blockRam end -@ +> BlackBox: +> name: Clash.Explicit.BlockRam.blockRam# +> kind: Declaration +> outputUsage: NonBlocking +> type: |- +> blockRam# +> :: ( KnownDomain dom ARG[0] +> , HasCallStack -- ARG[1] +> , NFDataX a ) -- ARG[2] +> => Clock dom -- clk, ARG[3] +> => Enable dom -- en, ARG[4] +> -> Vec n a -- init, ARG[5] +> -> Signal dom Int -- rd, ARG[6] +> -> Signal dom Bool -- wren, ARG[7] +> -> Signal dom Int -- wr, ARG[8] +> -> Signal dom a -- din, ARG[9] +> -> Signal dom a +> template: |- +> // blockRam begin +> reg ~TYPO ~GENSYM[~RESULT_RAM][1] [0:~LENGTH[~TYP[5]]-1]; +> +> reg ~TYP[5] ~GENSYM[ram_init][3]; +> integer ~GENSYM[i][4]; +> initial begin +> ~SYM[3] = ~CONST[5]; +> for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[5]]; ~SYM[4] = ~SYM[4] + 1) begin +> ~SYM[1][~LENGTH[~TYP[5]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYPO]+:~SIZE[~TYPO]]; +> end +> end +> ~IF ~ISACTIVEENABLE[4] ~THEN +> always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~RESULT_blockRam][5]~IF ~VIVADO ~THEN +> if (~ARG[4]) begin +> if (~ARG[7]) begin +> ~SYM[1][~ARG[8]] <= ~ARG[9]; +> end +> ~RESULT <= ~SYM[1][~ARG[6]]; +> end~ELSE +> if (~ARG[7] & ~ARG[4]) begin +> ~SYM[1][~ARG[8]] <= ~ARG[9]; +> end +> if (~ARG[4]) begin +> ~RESULT <= ~SYM[1][~ARG[6]]; +> end~FI +> end~ELSE +> always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[5] +> if (~ARG[7]) begin +> ~SYM[1][~ARG[8]] <= ~ARG[9]; +> end +> ~RESULT <= ~SYM[1][~ARG[6]]; +> end~FI +> // blockRam end -} {- $svprimitives And the equivalent SystemVerilog primitives are: -@ -BlackBox: - name: Clash.Sized.Internal.Signed.*# - kind: Expression - type: \'(*#) :: KnownNat n => Signed n -> Signed n -> Signed n\' - template: ~ARG[1] * ~ARG[2] -@ +> BlackBox: +> name: Clash.Sized.Internal.Signed.*# +> kind: Expression +> type: '(*#) :: KnownNat n => Signed n -> Signed n -> Signed n' +> template: ~ARG[1] * ~ARG[2] and -@ -BlackBox: - name: Clash.Explicit.BlockRam.blockRam# - kind: Declaration - type: |- - blockRam# - :: ( KnownDomain dom ARG[0] - , HasCallStack -- ARG[1] - , NFDataX a ) -- ARG[2] - => Clock dom -- clk, ARG[3] - -> Enable dom -- en, ARG[4] - -> Vec n a -- init, ARG[5] - -> Signal dom Int -- rd, ARG[6] - -> Signal dom Bool -- wren, ARG[7] - -> Signal dom Int -- wr, ARG[8] - -> Signal dom a -- din, ARG[9] - -> Signal dom a - template: |- - // blockRam begin - ~SIGD[~GENSYM[RAM][1]][5]; - logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[~RESULT_q][2]; - initial begin - ~SYM[1] = ~CONST[5]; - end~IF ~ISACTIVEENABLE[4] ~THEN - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN - if (~ARG[4]) begin - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - ~SYM[2] <= ~SYM[1][~ARG[6]]; - end~ELSE - if (~ARG[7] & ~ARG[4]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - if (~ARG[4]) begin - ~SYM[2] <= ~SYM[1][~ARG[6]]; - end~FI - end~ELSE - always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] - if (~ARG[7]) begin - ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; - end - ~SYM[2] <= ~SYM[1][~ARG[6]]; - end~FI - assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[9]]; - // blockRam end -@ +> BlackBox: +> name: Clash.Explicit.BlockRam.blockRam# +> kind: Declaration +> type: |- +> blockRam# +> :: ( KnownDomain dom ARG[0] +> , HasCallStack -- ARG[1] +> , NFDataX a ) -- ARG[2] +> => Clock dom -- clk, ARG[3] +> -> Enable dom -- en, ARG[4] +> -> Vec n a -- init, ARG[5] +> -> Signal dom Int -- rd, ARG[6] +> -> Signal dom Bool -- wren, ARG[7] +> -> Signal dom Int -- wr, ARG[8] +> -> Signal dom a -- din, ARG[9] +> -> Signal dom a +> template: |- +> // blockRam begin +> ~SIGD[~GENSYM[RAM][1]][5]; +> logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[~RESULT_q][2]; +> initial begin +> ~SYM[1] = ~CONST[5]; +> end~IF ~ISACTIVEENABLE[4] ~THEN +> always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~GENSYM[~COMPNAME_blockRam][3]~IF ~VIVADO ~THEN +> if (~ARG[4]) begin +> if (~ARG[7]) begin +> ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; +> end +> ~SYM[2] <= ~SYM[1][~ARG[6]]; +> end~ELSE +> if (~ARG[7] & ~ARG[4]) begin +> ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; +> end +> if (~ARG[4]) begin +> ~SYM[2] <= ~SYM[1][~ARG[6]]; +> end~FI +> end~ELSE +> always @(~IF~ACTIVEEDGE[Rising][0]~THENposedge~ELSEnegedge~FI ~ARG[3]) begin : ~SYM[3] +> if (~ARG[7]) begin +> ~SYM[1][~ARG[8]] <= ~TOBV[~ARG[9]][~TYP[9]]; +> end +> ~SYM[2] <= ~SYM[1][~ARG[6]]; +> end~FI +> assign ~RESULT = ~FROMBV[~SYM[2]][~TYP[9]]; +> // blockRam end -} @@ -1566,12 +1545,12 @@ __asyncRam__ , 'NFDataX' a ) => 'Clock' wdom -- ^ Clock to which to synchronize the write port of the RAM - -> 'Clock' rdom -- ^ Clock to which the read address signal, @r@, is synchronized to + -> 'Clock' rdom -- ^ Clock to which the read address signal, \@r\@, is synchronized to -> 'Enable' wdom -- ^ Global enable - -> 'SNat' n -- ^ Size @n@ of the RAM - -> 'Signal' rdom addr -- ^ Read address @r@ - -> 'Signal' wdom (Maybe (addr, a)) -- ^ (write address @w@, value to write) - -> 'Signal' rdom a -- ^ Value of the @RAM@ at address @r@ + -> 'SNat' n -- ^ Size \@n\@ of the RAM + -> 'Signal' rdom addr -- ^ Read address \@r\@ + -> 'Signal' wdom (Maybe (addr, a)) -- ^ (write address \@w\@, value to write) + -> 'Signal' rdom a -- ^ Value of the RAM at address \@r\@ @ that the signal containing the read address __r__ is synchronized to a different @@ -1678,7 +1657,7 @@ asyncFIFOSynchronizer , 'KnownDomain' rdom , 2 <= addrSize ) => SNat addrSize - -- ^ Size of the internally used addresses, the FIFO contains @2^addrSize@ + -- ^ Size of the internally used addresses, the FIFO contains \@2^addrSize\@ -- elements. -> 'Clock' wdom -- ^ Clock to which the write port is synchronized @@ -1693,7 +1672,7 @@ asyncFIFOSynchronizer -> 'Signal' wdom (Maybe a) -- ^ Element to insert -> ('Signal' rdom a, 'Signal' rdom Bool, 'Signal' wdom Bool) - -- ^ (Oldest element in the FIFO, @empty@ flag, @full@ flag) + -- ^ (Oldest element in the FIFO, \@empty\@ flag, \@full\@ flag) asyncFIFOSynchronizer addrSize\@SNat wclk rclk wrst rrst wen ren rinc wdataM = (rdata, rempty, wfull) where @@ -1799,7 +1778,7 @@ asyncFIFOSynchronizer , 'KnownDomain' rdom , 2 <= addrSize ) => SNat addrSize - -- ^ Size of the internally used addresses, the FIFO contains @2^addrSize@ + -- ^ Size of the internally used addresses, the FIFO contains \@2^addrSize\@ -- elements. -> 'Clock' wdom -- ^ Clock to which the write port is synchronized @@ -1814,7 +1793,7 @@ asyncFIFOSynchronizer -> 'Signal' wdom (Maybe a) -- ^ Element to insert -> ('Signal' rdom a, 'Signal' rdom Bool, 'Signal' wdom Bool) - -- ^ (Oldest element in the FIFO, @empty@ flag, @full@ flag) + -- ^ (Oldest element in the FIFO, \@empty\@ flag, \@full\@ flag) asyncFIFOSynchronizer addrSize\@SNat wclk rclk wrst rrst wen ren rinc wdataM = (rdata, rempty, wfull) where diff --git a/clash-prelude/src/Clash/Xilinx/ClockGen.hs b/clash-prelude/src/Clash/Xilinx/ClockGen.hs index 19e2380141..3966355449 100644 --- a/clash-prelude/src/Clash/Xilinx/ClockGen.hs +++ b/clash-prelude/src/Clash/Xilinx/ClockGen.hs @@ -191,26 +191,22 @@ When type checking cannot infer the types of the tuple elements, or they have the wrong type, the GHC compiler will complain about satisfying @NumOutClocks@. The error message on GHC 9.4 and up is: -@ - • Cannot satisfy: clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks - (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst - ([...]) - DomInput) <= 7 - • In the expression: clockWizard clkIn rstIn -@ +> • Cannot satisfy: clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks +> (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst +> ([...]) +> DomInput) <= 7 +> • In the expression: clockWizard clkIn rstIn On older GHC versions, the error message is: -@ - • Couldn't match type ‘clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks - (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst - ([...]) - DomInput) - <=? 7’ - with ‘'True’ - arising from a use of ‘clockWizard’ - • In the expression: clockWizard clkIn rstIn -@ +> • Couldn't match type ‘clash-prelude-[...]:Clash.Clocks.Internal.NumOutClocks +> (clash-prelude-[...]:Clash.Clocks.Internal.ClocksSyncClocksInst +> ([...]) +> DomInput) +> <=? 7’ +> with ‘'True’ +> arising from a use of ‘clockWizard’ +> • In the expression: clockWizard clkIn rstIn The above error message is also emitted when trying to instantiate more than 18 output clocks, as it will fail to find an instance. As the wizard supports no @@ -218,18 +214,14 @@ more than 7 clocks, trying to instantiate between 8 and 18 output clocks will also cause a type checking error. On GHC 9.4 and up, the error for attempting to instantiate 8 clocks is: -@ - • Cannot satisfy: 8 <= 7 - • In the expression: clockWizard clkIn rstIn -@ +> • Cannot satisfy: 8 <= 7 +> • In the expression: clockWizard clkIn rstIn On older GHC versions, the error message is less clear: -@ - • Couldn't match type ‘'False’ with ‘'True’ - arising from a use of ‘clockWizard’ - • In the expression: clockWizard clkIn rstIn -@ +> • Couldn't match type ‘'False’ with ‘'True’ +> arising from a use of ‘clockWizard’ +> • In the expression: clockWizard clkIn rstIn -} {- $tcl diff --git a/tests/src/Test/Tasty/Ghdl.hs b/tests/src/Test/Tasty/Ghdl.hs index 3c67a0e497..672a801e36 100644 --- a/tests/src/Test/Tasty/Ghdl.hs +++ b/tests/src/Test/Tasty/Ghdl.hs @@ -38,11 +38,9 @@ instance IsOption Ghdl where -- -- For example, for I2C it would execute: -- --- @ --- ghdl -i --work=bitMaster --workdir=bitMaster --std=93 --- ghdl -i --work=byteMaster --workdir=byteMaster --std=93 --- ghdl -i --work=i2c --workdir=i2c --std=93 --- @ +-- > ghdl -i --work=bitMaster --workdir=bitMaster --std=93 +-- > ghdl -i --work=byteMaster --workdir=byteMaster --std=93 +-- > ghdl -i --work=i2c --workdir=i2c --std=93 -- -- After executing this test, $tmpDir/work contains a directory for each -- top entity: @bitMaster@, @byteMaster@, @i2c@. A more typical test case might @@ -96,9 +94,7 @@ instance IsTest GhdlImportTest where -- -- For example, for I2C it would execute: -- --- @ --- ghdl -m -fpsl --work=i2c --workdir=i2c -PbitMaster -PbyteMaster -Pi2c -o i2c_exe i2c --- @ +-- > ghdl -m -fpsl --work=i2c --workdir=i2c -PbitMaster -PbyteMaster -Pi2c -o i2c_exe i2c -- data GhdlMakeTest = GhdlMakeTest { gmtSourceDirectory :: IO FilePath @@ -131,9 +127,7 @@ instance IsTest GhdlMakeTest where -- -- For examples, for I2C it would execute: -- --- @ --- ghdl -r --workdir=i2c --work=i2c i2c_exe --assert-level=error --- @ +-- > ghdl -r --workdir=i2c --work=i2c i2c_exe --assert-level=error -- data GhdlSimTest = GhdlSimTest { gstExpectFailure :: Maybe (TestExitCode, T.Text) diff --git a/tests/src/Test/Tasty/Iverilog.hs b/tests/src/Test/Tasty/Iverilog.hs index 4945f09eff..54fa46cebd 100644 --- a/tests/src/Test/Tasty/Iverilog.hs +++ b/tests/src/Test/Tasty/Iverilog.hs @@ -33,12 +33,10 @@ instance IsOption Iverilog where -- -- For example, for I2C it would execute: -- --- @ --- iverilog \ --- -I test_i2c -I test_bitmaster -I test_bytemaster \ --- -g2 -s test_i2c -o test_i2c.exe \ --- --- @ +-- > iverilog \ +-- > -I test_i2c -I test_bitmaster -I test_bytemaster \ +-- > -g2 -s test_i2c -o test_i2c.exe \ +-- > -- data IVerilogMakeTest = IVerilogMakeTest { ivmParentDirectory :: IO FilePath @@ -76,9 +74,7 @@ instance IsTest IVerilogMakeTest where -- -- For example, for I2C it would execute: -- --- @ --- vvp test_i2c.exe --- @ +-- > vvp test_i2c.exe -- data IVerilogSimTest = IVerilogSimTest { ivsExpectFailure :: Maybe (TestExitCode, T.Text)