129 lines
3.0 KiB
Bash
129 lines
3.0 KiB
Bash
#!/bin/sh
|
|
exec "snobol4" "-r" "$0" "$@"
|
|
*
|
|
* http://rosettacode.org/wiki/Execute_a_Markov_algorithm
|
|
*
|
|
define('repl(s1,s2,s3)c,t,findc') :(repl_end)
|
|
repl s2 len(1) . c = :f(freturn)
|
|
findc = break(c) . t len(1)
|
|
s2 = pos(0) s2
|
|
repl_1 s1 findc = :f(repl_2)
|
|
s1 s2 = :f(repl_3)
|
|
repl = repl t s3 :(repl_1)
|
|
repl_3 repl = repl t c :(repl_1)
|
|
repl_2 repl = repl s1 :(return)
|
|
repl_end
|
|
*
|
|
define('quote(s)q,qq') :(quote_end)
|
|
quote q = "'"; qq = '"'
|
|
quote = q repl(s, q, q ' ' qq q qq ' ' q) q :(return)
|
|
quote_end
|
|
*
|
|
whitespace = span(' ' char(9))
|
|
top r = 0
|
|
read s = input :f(end)
|
|
s pos(0) 'ENDRULE' rpos(0) :s(interp)
|
|
s pos(0) '#' :s(read)
|
|
pattern =; replacement =; term =
|
|
s arb . pattern whitespace '->' whitespace
|
|
+ ('.' | '') . term arb . replacement rpos(0) :f(syntax)
|
|
r = r + 1
|
|
f = ident(term, '.') ' :(done)'
|
|
f = ident(term) ' :f(rule' r + 1 ')s(rule1)'
|
|
c = 'rule' r ' s ' quote(pattern) ' = ' quote(replacement) f
|
|
code(c) :s(read)
|
|
output = 'rule: ' s ' generates code ' c ' in error' :(end)
|
|
syntax output = 'rule: ' s ' in error' :(read)
|
|
interp code('rule' r + 1 ' :(done)')
|
|
go s = input :f(end)
|
|
s pos(0) 'END' rpos(0) :s(top)f(rule1)
|
|
done output = s :(go)
|
|
end
|
|
# 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
|
|
ENDRULE
|
|
I bought a B of As from T S.
|
|
END
|
|
# Slightly modified from the rules on Wikipedia
|
|
A -> apple
|
|
B -> bag
|
|
S -> .shop
|
|
T -> the
|
|
the shop -> my brother
|
|
a never used -> .terminating rule
|
|
ENDRULE
|
|
I bought a B of As from T S.
|
|
END
|
|
# 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
|
|
ENDRULE
|
|
I bought a B of As W my Bgage from T S.
|
|
END
|
|
### 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
|
|
_+_ ->
|
|
ENDRULE
|
|
_1111*11111_
|
|
END
|
|
# 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
|
|
ENDRULE
|
|
000000A000000
|
|
END
|