Properly de-parse escaped brackets in blackboxes

The way that blackboxes of function arguments to higher order
blackboxes are handled is somewhat weird.
For some reason, I don't fully understand, they're parsed, then
de-parsed back into text, and later re-parsed again.
This de-parsing didn't correctly re-escape previously escaped square
brackets, causing the problem seen in #2809.

Fixes #2809

clash-lib/src/Clash/Netlist/BlackBox/Parser.hs

@@ -150,8 +150,8 @@ pElemE = pTagE
 
 -- | Parse SigD
 pSigD :: Parser [Element]
-pSigD = some (pTagE <|> (Text (pack "[") <$ (pack <$> string "[\\"))
-                    <|> (Text (pack "]") <$ (pack <$> string "\\]"))
+pSigD = some (pTagE <|> (EscapedSymbol SquareBracketOpen <$ (pack <$> string "[\\"))
+                    <|> (EscapedSymbol SquareBracketClose <$ (pack <$> string "\\]"))
                     <|> (Text <$> (pack <$> some (satisfyRange '\000' '\90')))
                     <|> (Text <$> (pack <$> some (satisfyRange '\94' '\125'))))
 

clash-lib/src/Clash/Netlist/BlackBox/Types.hs

@@ -19,6 +19,7 @@ module Clash.Netlist.BlackBox.Types
  , BlackBoxTemplate
  , TemplateKind (..)
  , Element(..)
+ , EscapedSymbol(..)
  , Decl(..)
  , HdlSyn(..)
  , RenderVoid(..)
@@ -211,6 +212,12 @@ data Element
   | CtxName
   -- ^ The "context name", name set by `Clash.Magic.setName`, defaults to the
   -- name of the closest binder
+  | EscapedSymbol EscapedSymbol
+  -- ^ Used for "[\" and "\]", they'll be rendered as "[" and "]",
+  -- but pretty printed as "[\" and "\]".
+  deriving (Show, Generic, NFData, Binary, Eq, Hashable)
+
+data EscapedSymbol = SquareBracketOpen | SquareBracketClose
   deriving (Show, Generic, NFData, Binary, Eq, Hashable)
 
 -- | Component instantiation hole. First argument indicates which function argument

clash-lib/src/Clash/Netlist/BlackBox/Util.hs

@@ -126,6 +126,7 @@ inputHole = \case
   DevNull _        -> Nothing
   SigD _ nM        -> nM
   CtxName          -> Nothing
+  EscapedSymbol _  -> Nothing
 
 -- | Determine if the number of normal\/literal\/function inputs of a blackbox
 -- context at least matches the number of argument that is expected by the
@@ -714,6 +715,8 @@ renderTag :: Backend backend
           -> Element
           -> State backend Text
 renderTag _ (Text t)        = return t
+renderTag _ (EscapedSymbol SquareBracketOpen)  = return "["
+renderTag _ (EscapedSymbol SquareBracketClose) = return "]"
 renderTag b (Result)    = do
   fmap renderOneLine . getAp . expr False . fst $ bbResult "~RESULT" b
 renderTag b (Arg n)  = do
@@ -1108,6 +1111,8 @@ prettyElem (Template bbname source) = do
                                   <> brackets (string $ Text.concat bbname')
                                   <> brackets (string $ Text.concat source'))
 prettyElem CtxName = return "~CTXNAME"
+prettyElem (EscapedSymbol SquareBracketOpen)  = return "[\\"
+prettyElem (EscapedSymbol SquareBracketClose) = return "\\]"
 
 -- | Recursively walk @Element@, applying @f@ to each element in the tree.
 walkElement
@@ -1178,6 +1183,7 @@ walkElement f el = maybeToList (f el) ++ walked
         Repeat es1 es2 ->
           concatMap go es1 ++ concatMap go es2
         CtxName -> []
+        EscapedSymbol _ -> []
 
 -- | Determine variables used in an expression. Used for VHDL sensitivity list.
 -- Also see: https://github.com/clash-lang/clash-compiler/issues/365
@@ -1266,6 +1272,7 @@ getUsedArguments (N.BBTemplate t) = nub (concatMap (walkElement matchArg) t)
         TypM _ -> Nothing
         Vars _ -> Nothing
         CtxName -> Nothing
+        EscapedSymbol _ -> Nothing
 
 onBlackBox
   :: (BlackBoxTemplate -> r)

tests/Main.hs

@@ -975,6 +975,7 @@ runClashTest = defaultMain $ clashTestRoot
         , runTest "Indices" def
         , runTest "Iterate" def
         , outputTest "IterateCF" def{hdlTargets=[VHDL]}
+        , runTest "MapHead" def
         , runTest "Minimum" def
         , runTest "MovingAvg" def{hdlSim=[]}
         , runTest "PatHOCon" def{hdlSim=[]}

tests/shouldwork/Vector/MapHead.hs

@@ -0,0 +1,19 @@
+-- see issue #2809
+module MapHead where
+
+import Clash.Prelude
+import Clash.Explicit.Testbench
+
+
+topEntity :: Vec 2 (Vec 2 Int) -> Vec 2 Int
+topEntity = map head
+{-# CLASH_OPAQUE topEntity #-}
+
+testBench :: Signal System Bool
+testBench = done
+  where
+    testInput      = stimuliGenerator clk aclr (((0 :> 1 :> Nil) :> (3 :> 4 :> Nil) :> Nil) :> Nil)
+    expectedOutput = outputVerifier'  clk aclr ((0 :> 3 :> Nil) :> Nil)
+    done           = expectedOutput (topEntity <$> testInput)
+    clk            = tbSystemClockGen (not <$> done)
+    aclr           = systemResetGen