184 lines
7.1 KiB
ObjectPascal
184 lines
7.1 KiB
ObjectPascal
program InterpretMA;
|
|
{$mode objfpc}{$h+}{$j-}{$b-}
|
|
uses
|
|
SysUtils;
|
|
|
|
type
|
|
TRule = record
|
|
Pattern, Replacement: string;
|
|
Terminating: Boolean;
|
|
end;
|
|
|
|
function ParseMA(const aScheme: string; out aRules: specialize TArray<TRule>): Boolean;
|
|
function ParseLine(const s: string; out r: TRule): Boolean;
|
|
var
|
|
Terms: TStringArray;
|
|
begin
|
|
Terms := s.Split([' -> ']);
|
|
if Length(Terms) <> 2 then exit(False);
|
|
r.Pattern := Terms[0].Trim;
|
|
r.Replacement := Terms[1].Trim;
|
|
r.Terminating := False;
|
|
if (r.Replacement <> '') and (r.Replacement[1] = '.') then begin
|
|
r.Terminating := True;
|
|
Delete(r.Replacement, 1, 1);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
var
|
|
Lines: TStringArray;
|
|
s: string;
|
|
I: Integer;
|
|
begin
|
|
aRules := nil;
|
|
if aScheme = '' then exit(False);
|
|
Lines := aScheme.Split([LineEnding], TStringSplitOptions.ExcludeEmpty);
|
|
if Lines = nil then exit(False);
|
|
SetLength(aRules, Length(Lines));
|
|
I := 0;
|
|
for s in Lines do begin
|
|
if s[1] = '#' then continue;
|
|
if not ParseLine(s, aRules[I]) then exit(False);
|
|
Inc(I);
|
|
end;
|
|
SetLength(aRules, I);
|
|
Result := True;
|
|
end;
|
|
|
|
function ExecuteMA(const aScheme, aInput: string): string;
|
|
var
|
|
Rules: array of TRule;
|
|
r: TRule;
|
|
Applied: Boolean;
|
|
begin
|
|
if not ParseMA(aScheme.Replace(#9, ' ', [rfReplaceAll]), Rules) then
|
|
exit('Error while parsing MA scheme');
|
|
Result := aInput;
|
|
repeat
|
|
Applied := False;
|
|
for r in Rules do begin
|
|
if r.Pattern = '' then begin
|
|
Result := r.Replacement + Result;
|
|
Applied := True;
|
|
end else begin
|
|
Applied := Result.IndexOf(r.Pattern) >= 0;
|
|
if Applied then
|
|
Result := Result.Replace(r.Pattern, r.Replacement);
|
|
end;
|
|
if Applied then begin
|
|
if r.Terminating then exit;
|
|
break;
|
|
end;
|
|
end;
|
|
until not Applied;
|
|
end;
|
|
|
|
type
|
|
TTestEntry = record
|
|
Scheme, Input, Output: string;
|
|
end;
|
|
|
|
const
|
|
LE = LineEnding;
|
|
TestSet: array[1..5] of TTestEntry = (
|
|
(Scheme:
|
|
'# This rules file is extracted from Wikipedia: ' +LE+
|
|
'# http://en.wikipedia.org/wiki/Markov_Algorithm' +LE+
|
|
'A -> apple' +LE+
|
|
'B -> bag' +LE+
|
|
'S -> shop' +LE+
|
|
'T -> the' +LE+
|
|
'the shop -> my brother' +LE+
|
|
'a never used -> .terminating rule';
|
|
Input: 'I bought a B of As from T S.'; Output: 'I bought a bag of apples from my brother.'),
|
|
(Scheme:
|
|
'# Slightly modified from the rules on Wikipedia' +LE+
|
|
'A -> apple' +LE+
|
|
'B -> bag' +LE+
|
|
'S -> .shop' +LE+
|
|
'T -> the' +LE+
|
|
'the shop -> my brother' +LE+
|
|
'a never used -> .terminating rule';
|
|
Input: 'I bought a B of As from T S.'; Output: 'I bought a bag of apples from T shop.'),
|
|
(Scheme:
|
|
'# BNF Syntax testing rules' +LE+
|
|
'A -> apple' +LE+
|
|
'WWWW -> with' +LE+
|
|
'Bgage -> ->.*' +LE+
|
|
'B -> bag' +LE+
|
|
'->.* -> money' +LE+
|
|
'W -> WW' +LE+
|
|
'S -> .shop' +LE+
|
|
'T -> the' +LE+
|
|
'the shop -> my brother' +LE+
|
|
'a never used -> .terminating rule';
|
|
Input: 'I bought a B of As W my Bgage from T S.'; Output: 'I bought a bag of apples with my money from T shop.'),
|
|
(Scheme:
|
|
'### Unary Multiplication Engine, for testing Markov Algorithm implementations' +LE+
|
|
'### By Donal Fellows.' +LE+
|
|
'# Unary addition engine' +LE+
|
|
'_+1 -> _1+' +LE+
|
|
'1+1 -> 11+' +LE+
|
|
'# Pass for converting from the splitting of multiplication into ordinary' +LE+
|
|
'# addition' +LE+
|
|
'1! -> !1' +LE+
|
|
',! -> !+' +LE+
|
|
'_! -> _' +LE+
|
|
'# Unary multiplication by duplicating left side, right side times' +LE+
|
|
'1*1 -> x,@y' +LE+
|
|
'1x -> xX' +LE+
|
|
'X, -> 1,1' +LE+
|
|
'X1 -> 1X' +LE+
|
|
'_x -> _X' +LE+
|
|
',x -> ,X' +LE+
|
|
'y1 -> 1y' +LE+
|
|
'y_ -> _' +LE+
|
|
'# Next phase of applying' +LE+
|
|
'1@1 -> x,@y' +LE+
|
|
'1@_ -> @_' +LE+
|
|
',@_ -> !_' +LE+
|
|
'++ -> +' +LE+
|
|
'# Termination cleanup for addition' +LE+
|
|
'_1 -> 1' +LE+
|
|
'1+_ -> 1' +LE+
|
|
'_+_ -> ';
|
|
Input: '_1111*11111_'; Output: '11111111111111111111'),
|
|
(Scheme:
|
|
'# Turing machine: three-state busy beaver' +LE+
|
|
'#' +LE+
|
|
'# state A, symbol 0 => write 1, move right, new state B' +LE+
|
|
'A0 -> 1B' +LE+
|
|
'# state A, symbol 1 => write 1, move left, new state C' +LE+
|
|
'0A1 -> C01' +LE+
|
|
'1A1 -> C11' +LE+
|
|
'# state B, symbol 0 => write 1, move left, new state A' +LE+
|
|
'0B0 -> A01' +LE+
|
|
'1B0 -> A11' +LE+
|
|
'# state B, symbol 1 => write 1, move right, new state B' +LE+
|
|
'B1 -> 1B' +LE+
|
|
'# state C, symbol 0 => write 1, move left, new state B' +LE+
|
|
'0C0 -> B01' +LE+
|
|
'1C0 -> B11' +LE+
|
|
'# state C, symbol 1 => write 1, move left, halt' +LE+
|
|
'0C1 -> H01' +LE+
|
|
'1C1 -> H11';
|
|
Input: '000000A000000'; Output: '00011H1111000')
|
|
);
|
|
E_FMT = 'test #%d: expected "%s", but got "%s"';
|
|
var
|
|
e: TTestEntry;
|
|
Result: string;
|
|
I: Integer = 1;
|
|
Failed: Integer = 0;
|
|
begin
|
|
for e in TestSet do begin
|
|
Result := ExecuteMA(e.Scheme, e.Input);
|
|
if Result <> e.Output then begin
|
|
WriteLn(Format(E_FMT, [I, e.Output, Result]));
|
|
Inc(Failed);
|
|
end;
|
|
Inc(I);
|
|
end;
|
|
WriteLn('tests completed: ', Length(TestSet), ', failed: ', Failed);
|
|
end.
|