RosettaCodeData/Task/Execute-a-Markov-algorithm/Bracmat/execute-a-markov-algorithm.bracmat

markov=
{
First the patterns that describe the rules syntax.
This is a naive and not very efficient way to parse the rules, but it closely
matches the problem description, which is nice.
}
    ( ruleset
    =     >%@" " ?   { Added: assume that a rule cannot start with whitespace.
                       The %@ say that the thing to match must be exactly one
                       byte. % means 'one or more'. @ means 'zero or one'.
                     }
        : ((!comment|!rule) !newlines) !ruleset
      |         { Recursion terminates here: match empty string. }
    )
  & (comment="#" ?com)
  & ( rule
    =   %?pattern
        !whitespace
        "->"
        !whitespace
        ( "." %?replacement&stop:?stop
        | %?replacement
        )
    )
  & ( whitespace
    = (\t|" ") (!whitespace|)
    )
  & ( newlines
    =   ( (\n|\r)
        & ( :!pattern:!replacement {Do nothing. We matched an empty line.}
          |   (!pattern.!replacement.!stop) !rules:?rules
                {
                Add pattern, replacement and the stop (empty string or "stop")
                to a list of triplets. This list will contain the rules in
                reverse order.
                Then, reset these variables, so they are not added once more
                if an empty line follows.
                }
            & :?stop:?pattern:?replacement
          )
        )
        (!newlines|)
    )
{
Compile the textual rules to a single Bracmat pattern.
}
  & ( compileRules
    =   stop pattern replacement rules,pat rep stp
      .   :?stop:?pattern:?replacement:?rules
                {
                Important! Initialise these variables.
                }
        & @(!arg:!ruleset)
                {
                That's all. The textual rules are parsed and converted to a
                list of triplets. The rules in the list are in reversed order.
                }
        & !rules:(?pat.?rep.?stp) ?rules
                {
                The head of the list is the last rule. Use it to initialise
                the pattern "ruleSetAsPattern".
                The single quote introduces a macro substition. All symbols
                preceded with a $ are substituted.
                }
        &
            ' ( ?A ()$pat ?Z
              & $stp:?stop
              & $rep:?replacement
              )
          : (=?ruleSetAsPattern)
                {
                Add all remaining rules as new subpatterns to
                "ruleSetAsPattern". Separate with the OR symbol.
                }
        &   whl
          ' ( !rules:(?pat.?rep.?stp) ?rules
            &
                ' (   ?A ()$pat ?Z
                    & $stp:?stop
                    & $rep:?replacement
                  | $ruleSetAsPattern
                  )
              : (=?ruleSetAsPattern)
            )
        & '$ruleSetAsPattern
    )
        {
        Function that takes two arguments: a rule set (as text)
        and a subject string.
        The function returns the transformed string.
        }
  & ( applyRules
    =     rulesSetAsText subject ruleSetAsPattern
        , A Z replacement stop
      .   !arg:(?rulesSetAsText.?subject)
        & compileRules$!rulesSetAsText:(=?ruleSetAsPattern)
                {
                Apply rule until no match
                or until variable "stop" has been set to the value "stop".
                }
        &   whl
          ' ( @(!subject:!ruleSetAsPattern)
            & str$(!A !replacement !Z):?subject
            & !stop:~stop
            )
        & !subject
    )
{
Tests:
}
  &   out
    $ ( applyRules
      $ ( "# This rules file is extracted from Wikipedia:
# http://en.wikipedia.org/wiki/Markov_Algorithm
A -> apple
B -> bag
S -> shop
T -> the
the shop -> my brother
a never used -> .terminating rule
"
        . "I bought a B of As from T S."
        )
      )
  &   out
    $ ( applyRules
      $ ( "# Slightly modified from the rules on Wikipedia
A -> apple
B -> bag
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
"
        . "I bought a B of As from T S."
        )
      )
  &   out
    $ ( applyRules
      $ ( "# BNF Syntax testing rules
A -> apple
WWWW -> with
Bgage -> ->.*
B -> bag
->.* -> money
W -> WW
S -> .shop
T -> the
the shop -> my brother
a never used -> .terminating rule
"
        . "I bought a B of As W my Bgage from T S."
        )
      )
  &   out
    $ ( applyRules
      $ ( "### Unary Multiplication Engine, for testing Markov Algorithm implementations
### By Donal Fellows.
# Unary addition engine
_+1 -> _1+
1+1 -> 11+
# Pass for converting from the splitting of multiplication into ordinary
# addition
1! -> !1
,! -> !+
_! -> _
# Unary multiplication by duplicating left side, right side times
1*1 -> x,@y
1x -> xX
X, -> 1,1
X1 -> 1X
_x -> _X
,x -> ,X
y1 -> 1y
y_ -> _
# Next phase of applying
1@1 -> x,@y
1@_ -> @_
,@_ -> !_
++ -> +
# Termination cleanup for addition
_1 -> 1
1+_ -> 1
_+_ ->
"
        . "_1111*11111_"
        )
      )
  &   out
    $ ( applyRules
      $ ( "# Turing machine: three-state busy beaver
#
# state A, symbol 0 => write 1, move right, new state B
A0 -> 1B
# state A, symbol 1 => write 1, move left, new state C
0A1 -> C01
1A1 -> C11
# state B, symbol 0 => write 1, move left, new state A
0B0 -> A01
1B0 -> A11
# state B, symbol 1 => write 1, move right, new state B
B1 -> 1B
# state C, symbol 0 => write 1, move left, new state B
0C0 -> B01
1C0 -> B11
# state C, symbol 1 => write 1, move left, halt
0C1 -> H01
1C1 -> H11
"
        . 000000A000000
        )
      )
  & ok
| failure;