A program that writes itself
$ include "seed7_05.s7i";
const array string: prog is [](
"$ include \"seed7_05.s7i\";",
"const array string: prog is [](",
"const proc: main is func",
" local var integer: number is 0;",
" begin",
" for number range 1 to 2 do writeln(prog[number]); end for;",
" for number range 1 to 11 do",
" writeln(literal(prog[number]) <& \",\");",
" end for;",
" writeln(literal(prog[12]) <& \");\");",
" for number range 3 to 12 do writeln(prog[number]); end for;",
" end func;");
const proc: main is func
local var integer: number is 0;
begin
for number range 1 to 2 do writeln(prog[number]); end for;
for number range 1 to 11 do
writeln(literal(prog[number]) <& ",");
end for;
writeln(literal(prog[12]) <& ");");
for number range 3 to 12 do writeln(prog[number]); end for;
end func;
Brainfuck interpreter
$ include "seed7_05.s7i";
include "osfiles.s7i";
include "getf.s7i";
const proc: brainF (in string: source, inout file: input, inout file: output) is func
local
var array char: memory is 100000 times '\0;';
var integer: dataPointer is 50000;
var integer: instructionPointer is 1;
var integer: nestingLevel is 0;
begin
while instructionPointer <= length(source) do
case source[instructionPointer] of
when {'>'}: incr(dataPointer);
when {'<'}: decr(dataPointer);
when {'+'}: incr(memory[dataPointer]);
when {'-'}: decr(memory[dataPointer]);
when {'.'}: write(output, memory[dataPointer]);
when {','}: memory[dataPointer] := getc(input);
when {'['}:
if memory[dataPointer] = '\0;' then
nestingLevel := 1;
repeat
incr(instructionPointer);
case source[instructionPointer] of
when {'['}: incr(nestingLevel);
when {']'}: decr(nestingLevel);
end case;
until nestingLevel = 0;
end if;
when {']'}:
if memory[dataPointer] <> '\0;' then
nestingLevel := 1;
repeat
decr(instructionPointer);
case source[instructionPointer] of
when {'['}: decr(nestingLevel);
when {']'}: incr(nestingLevel);
end case;
until nestingLevel = 0;
end if;
end case;
incr(instructionPointer);
end while;
end func;
const proc: main is func
local
var string: source is "";
begin
if length(argv(PROGRAM)) <> 1 then
writeln("usage: brainf7 source");
else
source := convDosPath(argv(PROGRAM)[1]);
if fileType(source) <> FILE_REGULAR then
writeln(" *** File " <& literal(source) <& " not found");
else
brainF(getf(source), IN, OUT);
end if;
end if;
end func;
Decode roman numerals
const func integer: ROMAN parse (in string: roman) is func
result
var integer: arabic is 0;
local
var integer: index is 0;
var integer: number is 0;
var integer: lastval is 0;
begin
for index range length(roman) downto 1 do
case roman[index] of
when {'M', 'm'}: number := 1000;
when {'D', 'd'}: number := 500;
when {'C', 'c'}: number := 100;
when {'L', 'l'}: number := 50;
when {'X', 'x'}: number := 10;
when {'V', 'v'}: number := 5;
when {'I', 'i'}: number := 1;
otherwise: raise RANGE_ERROR;
end case;
if number < lastval then
arabic -:= number;
else
arabic +:= number;
end if;
lastval := number;
end for;
end func;