Fix Brain-Flak push-pop redundancy

Question

Brain-Flak is a stack-based esoteric language with eight commands:

()     Evaluates to 1
<>     Switch active stack; evaluates to 0
[]     Evaluates to height of current stack
{}     Pop current stack; evaluates to the popped number
(...)  Execute block and push the result; evaluates as result
<...>  Execute block; evaluates as 0
[...]  Execute block; evaluates as negation of result 
{...}  While top of active stack is nonzero, execute block

Write a program or function to detect and remove one common type of push-pop redundancy that often occurs when writing Brain-Flak code.

Finding Redundancy

To determine whether a push and pop are truly redundant, we must understand which scopes use the return value of instructions:

• The return value of any top-level instruction is ignored.
• (...) will always use the return values of its children.
• <...> will always ignore the top-level instruction of its children.
• {...} will pass the return values of its children to the enclosing scope; that is, their return values will be used if and only if {...} itself is in a scope that uses its return value.
• [...] theoretically works like {...} in this sense; however, you may assume that [...] is always in a scope that cares about return value, thus treating it like (...).

The type of redundancy we are interested in occurs in any substring of the form (A)B{} satisfying the following:

• A is a balanced string; that is, the parentheses around A are matched.
• (A) is in a scope that ignores its return value.
• B does not contain [], <>, or either half of the {...} monad.
• The {} immediately following B pops the value pushed by (A). That is, B has an equal number of {} and ...), and no prefix of B has more {} than ...).

Note that B is typically not a balanced string.

Removing Redundancy

To remove this redundancy, we temporarily introduce a symbol 0 to the language, which evaluates to 0. With this symbol, a redundant string (A)B{} can be safely replaced by 0BA. Since Brain-Flak does not have a 0 symbol, we must make simplifications to remove it:

• A 0 with a sibling can be removed entirely, as can any top-level 0s. (If there are two 0s as the only children of a monad, only one of them can be removed.)
• [0] and <0> can be simplified to 0.
• If you encounter a (0), find the matching {}; replace the (0) and matching {} with 0s.
• {0} will never happen. If I'm wrong about this, you may have undefined behavior in this case.

Rules

• Input is a string taken by any reasonable method.
• Input is guaranteed to be valid Brain-Flak code consisting only of brackets.
• Any [...] monads in the input will be in scopes that do not ignore their return values.
• Output is a semantically equivalent Brain-Flak program with no push-pop redundancies as defined above.
• The output program must not be longer than the result of the algorithm described above.
• The input might not contain any redundancy; in that case, the input program should be output unchanged.
• If your solution is in Brain-Flak, it should hopefully not detect any redundancy in its own code.
• This is code-golf, so the shortest program (in bytes) in each language wins.

Test cases

With redundancy (with redundant push and pop marked):

Shortest redundancy
({}){} -> {}
^  ^^^

First example from tips post
({}<>)({}()) -> ({}<>())
^    ^ ^^

Second example from tips post
({}<({}<>)><>)(<((()()()){}[((){}{})])>) -> (<((()()()){}[((){}<({}<>)><>{})])>)
^            ^                 ^^

Inside the zero monad
({}<({}{})>{}) -> ({}{}{})
    ^    ^ ^^

Inside a loop
{({}{})([{}])} -> {([{}{}])}
 ^    ^  ^^

Stack height pushed
([][]())({}()) -> ([][]()())
^      ^ ^^

Loop result pushed
({({}[()])}{})(({})) -> (({({}[()])}{}))
^            ^  ^^

Two redundancies
({}<({}{})>)({}{}) -> ({}{}{})
^   ^    ^ ^ ^^^^

Discovered redundancy
(({})){}({}()) -> ({}())
^^  ^^^^ ^^

Chained redundancy
(<(()()())>)(({}){}{}({})) -> (()()()({}))
  ^      ^         ^^

No redundancy (output should be the same as input):

-empty string-
(({}<>)({}()))         - unlike the second test case, the pushed value is used again
(({}){})               - standard code for doubling the top value on the stack
({}{})<>{}             - push and pop not on same stack
(()){{}{}}             - loop starts between push and pop
({(({}[()]))}{})([]{}) - stack height is used after push

Answer 1

Haskell, 995 973 873 bytes

Nitrodon saved me 22 bytes with a way around the monomorphism restriction

Not well golfed, but golfed a bit.

I implement my own parsing library here. Not a wise idea for golf. If I really wanted to make this short I would probably just use an off the shelf one like parsec.

I also lose a ton of bytes to the type and instance declarations. This could definitely be done without them and it would probably save bytes.

import Control.Monad
newtype P b a=P{h::b->[(b,a)]}
instance Functor(P b)where fmap f(P p)=P$map(f?)?p
instance Applicative(P b)where pure x=P(\y->[(y,x)]);(<*>)=ap
instance Monad(P b)where P p>>=f=P$(>>=uncurry(flip$h.f)).p
f?x=f<$>x
l=s"("
k=s"()"
o=s")"
w=words
p x=pure x
e=P$p[]
x%y=liftM2(++)x y
P p#P q=P$p%q
b q=P(\x->[(b,a)|a:b<-[x],q a])
t=p?b(p$1>0)
s=mapM$b.(==)
a=foldr(#)e
n p=P(\x->[(x,())|[]==h p x])
v=a[s[x]%c%s[y]%c|[x,y]<-w"() <> {} []"]#s"0"
c=v#s""
d 0=a[n(a$s?w"<> [] { } )")*>a[k,n k*>t]%d 0,o%d 1,p""]
d x=a[n(s"<>"#s"[]")*>k#(p?b(`elem`"(<>[]"))%d x,s"{}"%d(x-1),o%d(x+1)]
f z=a[a[p""|z],(s"{"#s"[")%f z,l%f(0>1),s"<"%f(1>0),v%f z]
m=p""#(t%m)<*q
q=P(\x->[([],"")|[]==x])
z=a[s"0"*>p"",(s"["#s"<")*>z<*(s"]"#s">"),l%z%o*>p"<(0)>"]
r=a[n z*>t%r,z%r,q]
u x=head$(u.snd<$>((>>=h r.snd).h(do x<-f$1>0;l;i<-v;o;y<-d 0;s"{}";((x++'0':y++i)++)?m))x)++[x]

Try it online!

Haskell, Ungolfed

Here's what this looks like ungolfed.

balanced :: Parser String
balanced =
  ( choice
    [ string [x]
      <> balanced
      <> string [y]
      <> balanced
    | [x, y] <- ["()", "<>", "{}", "[]"]
    ]
  ) <|> string ""
    <|> string "0"

getBetween :: Int -> Parser String
getBetween pushes
  | pushes > 0 =
  choice
    [ do
      notAhead $ string "<>"
      notAhead $ string "[]"
      start <- string "()" <|> fmap pure (charBy (`notElem` "{})"))
      rest <- getBetween pushes
      pure $ start ++ rest
    , do
      string "{}"
      rest <- getBetween (pushes - 1)
      return $ "{}" ++ rest
    , do
      string ")"
      rest <- getBetween (pushes + 1)
      return $ ')' : rest
    ]
  | pushes == 0 =
  choice
    [ do
      notAhead $ string "<>"
      notAhead $ string "[]"
      notAhead $ char '{'
      notAhead $ char '{'
      notAhead $ char ')'
      start <- choice
        [ string "()"
        , do
          notAhead $ string "()"
          chr <-charBy $ const True
          return [chr]
        ]
      rest <- getBetween pushes
      pure $ start ++ rest
    , do
      string ")"
      rest <- getBetween (pushes + 1)
      return $ ')' : rest
    , pure ""
    ]

getBefore :: Bool -> Parser String
getBefore zeroed
  | zeroed
  =
    choice
      [ pure ""
      , do
        next <- choice $ map char "<{["
        rest <- getBefore zeroed
        return $ next : rest
      , do
        char '('
        rest <- getBefore False
        return $ '(' : rest
      , do
        prefix <- balanced
        guard $ prefix /= ""
        rest <- getBefore zeroed
        return $ prefix ++ rest
      ]
  | otherwise
  =
    choice
      [ do
        next <- choice $ map char "({["
        rest <- getBefore zeroed
        return $ next : rest
      , do
        char '<'
        rest <- getBefore True
        return $ '<' : rest
      , do
        prefix <- balanced
        guard $ prefix /= ""
        rest <- getBefore zeroed
        return $ prefix ++ rest
      ]

mainParser :: Parser String
mainParser =
  do
    before <- getBefore True
    char '('
    inside <- balanced
    guard $ inside /= ""
    char ')'
    between <- getBetween 0
    string "{}"
    after <- many $ charBy $ const True
    end
    return $ before ++ "0" ++ between ++ inside ++ after

zero :: Parser String
zero =
  choice
    [ char '0' *> pure ""
    , choice
      [ char x *> zero <* char y
      | [x, y] <- ["[]", "<>"]
      ]
    , do
      char '('
      zero
      char ')'
      return $ "<(0)>"
    ]



removeZeros :: Parser String
removeZeros =
  choice
    [ do
      notAhead zero
      chr <- charBy $ const True
      rest <- removeZeros
      return $ chr : rest
    , zero <> removeZeros
    , end *> pure ""
    ]

run :: String -> String
run input =
  case
    map snd $ apply (compose mainParser removeZeros) input
  of
    [] ->
      input
    x ->
      head $ map run x

Try it online!

Answer 2

JavaScript, 449 600 580 bytes

-13 bytes thanks emanresu A

^{(@WheatWizard wrote their answer first, causing me to look at this challenge; this answer is not intended to steal their glory)}

x=>{for([...x].reduce((_,b)=>"({[<".includes(b)?(y.unshift([b,--i+"#"]),y[1].push(y[0])):(b==")"&&y[0][2]&&j.push(y[0][1]),x=y.shift()).push(b!="}"|x[3]?b:b+(j.pop()||"-0#")),y=[[]],i=0,j=[]),y=y[0].reduce(g=(a,b)=>b[3]?a+b[0]+b[1]+b.slice(2,-1).reduce(g,"")+b[1]+b.pop():a+b[0]+b[2],"");x!=y;)y=(x=y).replace(/(((<-\d+#|^)([<[({]((-\d+#).+\5)?[\])}>]|X)*)(({-\d+#|^)([<[({]((-\d+#).+\11)?[\])}>]|X)*)*)\((-\d+#)(.*)\12\)(((?!\[\]|<>|\{-|#}).)*){}\12|\((-\d+#)(X)\16\)(((?!\[\]|<>|\{-|#}).)*){}\16|\[-\d+#X-\d+#\]|<-\d+#X-\d+#>/,"$1X$18$17$14$13");return y.replace(/-\d+#|X/g,"")}

Try it online!

A horrific solution that uses string manipulation.

First, it recursively parses the program and adds annotations:

original:
(<(()()())>)(({}){}{}({}))
annotated:
(-1#<-2#(-3#()()()-3#)-2#>-1#)(-7#(-8#{}-1#-8#){}-8#{}-3#(-12#{}-0#-12#)-7#)

The -N%s inside brackets denote matching brackets. Additionally, {}s are annotated with the -N# of the () they pop.

Then, regex substitutions are repeatedly applied until it stabilizes (X is used instead of 0):

^{(this is an explanation of the old regex; the new one that accounts for more cases is beyond explanation)}

/\((-\d+#)(.*)\1\)(((?!\[\]|<>|\{-|#}).)*){}\1/X$3$2
 \(                                                   literal open paren
   (-\d+#)                                            group 1, matches a -N#
          (.*)                                        group 2, this is A
              \1\)                                    matching close paren
                  (((?!\[\]|<>|\{-|#}).)*)            group 3, this is B
                    (?!\[\]|<>|\{-|#})                there can be no [], <>, {-, or #}
                                          {}\1        the {} that pops (A)
                                               X$3$2  replace with X, followed by groups 2 and 3
/\[-\d+#X-\d+#\]/X  replace [-N#X-N#] with X
/<-\d+#X-\d+#>/X  replace <-N#X-N#> with X

In the actual implementation, these are all combined into a single unioned regex.

The (0) case from the original algorithm is just a special case of the (A)B{} -> 0BA transformation, so no special casing is needed for it.

Once it stabilizes, all Xs (these must be have a sibling) and -N#s are removed, and the resulting string is returned.