Hallo,
wollte mal schnell eben eine mathe unit schreiben - mit mässigen Erfolg.
Es sollen unterschiedlich Integer Werte, die als String repräsentiert werden
bearbeitet werden.
Also eine beliebige Menge an Daten - sofern Datenspeicher ausreicht.
Damit man einen Einstieg hat, habe ich nur Addition aufgenommen.
scheitere aber damit, die Strings richtig zu kombinieren.
irgendwie komm ich nicht weiter.
Für sachdienliche Hinweise bin ich Jedem dankbar.
wollte mal schnell eben eine mathe unit schreiben - mit mässigen Erfolg.
Es sollen unterschiedlich Integer Werte, die als String repräsentiert werden
bearbeitet werden.
Also eine beliebige Menge an Daten - sofern Datenspeicher ausreicht.
Damit man einen Einstieg hat, habe ich nur Addition aufgenommen.
scheitere aber damit, die Strings richtig zu kombinieren.
irgendwie komm ich nicht weiter.
Für sachdienliche Hinweise bin ich Jedem dankbar.
Code:
unit Compiler;
interface
uses SysUtils, StrUtils, Classes, Dialogs, Contnrs;
procedure CompileAndRun(_Code: String);
procedure commenteof;
procedure ungetchar;
function getchar: Char;
var pc: Integer;
line_no: Integer;
Code: Array of Char;
type
EMyErrorException = class(Exception);
EMyEndOfComment = class(Exception);
TNumberStack = class(TStack);
TNumberClass = class(TObject)
FnumberStr : String;
Fop : Char;
end;
var
num_digit: String;
num_class: TNumberClass;
num_stack: TNumberStack;
flag: Integer;
implementation
procedure commenteof;
begin
ShowMessage(Format('unexpected EOF inside comment at line %d',
[line_no]));
end;
procedure warn(err: String);
begin
ShowMessage('Error:' + IntToStr(Line_no) + err);
end;
procedure fatal(err: String);
begin
warn(err);
end;
function getchar: Char;
begin
if pc > High(Code) then
raise EMyErrorException.Create('Error:' + IntToStr(line_no) + ': Syntax Error');
result := Code[pc];;
inc(pc);
end;
procedure ungetchar;
begin
if pc > 0 then
begin
dec(pc);
end;
end;
procedure CompileAndRun(_Code: String);
var
c, mop: Char;
st,s1,s2: String;
a1,a2: Array [0..4096] of Char;
i: Integer;
type
TTokenType = (tUnknown, tNumeric, tIdent, tMathOp);
function skip_white_spaces: Char;
label l1;
begin
result := #0;
repeat
c := getchar;
if (c in ['0'..'9']) or (c in ['A'..'Z']) or (c in ['a'..'z'])
or (c in ['+','-']) then
begin
result := c;
exit;
end else if c = #0 then break;
if c = #13 then
begin
inc(line_no);
end else if c = '/' then
begin
c := getchar;
if c = #0 then
begin
commenteof;
break;
end else if c = '*' then
begin
l1:
c := getchar;
if c = #0 then
begin
commenteof;
break;
end else if c = '*' then
begin
c := getchar;
if c = '/' then
begin
result := skip_white_spaces;
exit;
end else goto l1;
end else goto l1;
end else if c = '/' then
begin
repeat
c := getchar;
until c in [#0,#10,#13];
if c = #0 then break
else if c = #13 then
begin
inc(line_no);
end;
end;
end;
until c = #0;
result := c;
end;
function getIdent: TTokenType;
begin
end;
function calculate(op: Char; v: TNumberStack): String;
var s,s4: String;
i,f1,f2,f3,f4,f5,f6,rest: integer;
ptr1,ptr2: Pointer;
ic: Integer;
begin
ptr1 := TNumberStack(v.PopItem);
ptr2 := TNumberStack(v.PopItem);
s1 := TNumberClass(ptr1).FnumberStr;
s2 := TNumberClass(ptr2).FnumberStr;
if op = '+' then
begin
if Length(Trim(s1)) = Length(Trim(s2)) then
begin
s1 := ReverseString(s1);
s2 := ReverseString(s2);
StrLCopy(PChar(@a1[0]), PChar(s1), High(a1));
StrLCopy(PChar(@a2[0]), PChar(s2), High(a2));
ic := 0;
while true do
begin
if ic = 2 then break;
f1 := integer(a1[ic]) - 48;
f2 := integer(a2[ic]) - 48;
f3 := f2 + f1;
f4 := f3 - 10; // 2
f5 := f4 - f3;
if f5 < -9 then
begin
f6 := ((integer(a1[ic+1]) - 48) + 1) + 48; // 1
end;
a1[ic] := chr(f4);
a2[ic+1] := char(f6);
showmessage(
'1: ' + IntToStr(f1) + #10 +
'2: ' + IntToStr(f2) + #10 +
'3: ' + IntToStr(f3) + #10 +
'4: ' + IntToStr(f4) + #10 +
'5: ' + IntToStr(f5) + #10 +
'6: ' + IntToStr(f6) + #10 +
'7: ' + a2[ic+1]
);
inc(ic);
end;
end
else if Length(s1) > Length(s2) then
begin
s := StringOfChar('0',
Length(s1) -
Length(s2)) + s2;
end;
end;
result := '1111';;
end;
function getNumber: String;
begin
c := skip_white_spaces;
while c in ['0'..'9'] do
begin
num_digit :=
num_digit + c;
c := getchar;
end;
result := num_digit;
end;
function getExpression: String;
begin
s1 := getNumber;
num_digit := '';
if c = '+' then
begin
mop := '+';
c := skip_white_spaces;
if c in ['0'..'9'] then
begin
s2 := c + getNumber + c;
num_class := TNumberClass.Create;
num_class.FnumberStr := s1[1];
num_class.Fop := mop;
num_stack.PushItem(num_class);
num_class := TNumberClass.Create;
num_class.FnumberStr := s2[1];
num_class.Fop := mop;
num_stack.PushItem(num_class);
s2 := calculate(mop,num_stack);
end;
end;
s2 := s2 + c;
showmessage('A-->>> ' + s1);
num_class := TNumberClass.Create;
num_class.FnumberStr := s1[1];
num_class.Fop := mop;
num_stack.PushItem(num_class);
if flag = 2 then
begin
s2 := calculate(mop,num_stack);
flag := 0;
end else inc(flag);
result := num_digit;
end;
begin
pc := 0;
Line_no := 1;
try
SetLength(Code,Length(_code));
StrLCopy(PChar(@code[0]), PChar(_code), High(code));
num_class := TNumberClass.Create;
num_stack := TNumberStack.Create;
num_class.FnumberStr := '<null>';
num_stack.PushItem(num_stack);
flag := 0;
for i := 0 to High(a1) do a1[i] := '0';
for i := 0 to High(a1) do a2[i] := '0';
repeat
num_digit := '';
c := skip_white_spaces;
if c in ['0'..'9'] then
begin
ungetchar;
s1 := getExpression;
end;
until c = #0;
except
on E: EMyEndOfComment do
begin
end;
on E: EMyErrorException do
begin
ShowMessage('Error:' + IntToStr(line_no) + ': ' + E.Message);
end;
end;
end;
end.