paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 22:47:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: implement Inc, Dec class operators

Browse Source 
- extend tok2node array to store inline function number for the case when nodetype = inlinen, add Inc, Dec operators to array
 - implement inline function support in isunaryoverloaded
 - check for operator overload if Inc, Dec is not used for standard types
 - extend test to check Inc,Dec operators

git-svn-id: trunk@16629 -
This commit is contained in:
paul 2010-12-24 09:26:52 +00:00
parent d62ad56b74
commit 4531e1231b
7 changed files with 110 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
compiler/htypechk.pas
View File

@ -34,6 +34,7 @@ interface
Ttok2nodeRec=record
tok : ttoken;
nod : tnodetype;
inr : integer; // inline number
op_overloading_supported : boolean;
end;
@ -94,33 +95,36 @@ interface
ra_addr_taken);
tregableinfoflags = set of tregableinfoflag;
{$i compinnr.inc}
const
tok2nodes=24;
tok2nodes=26;
tok2node:array[1..tok2nodes] of ttok2noderec=(
(tok:_PLUS ;nod:addn;op_overloading_supported:true), { binary overloading supported }
(tok:_MINUS ;nod:subn;op_overloading_supported:true), { binary and unary overloading supported }
(tok:_STAR ;nod:muln;op_overloading_supported:true), { binary overloading supported }
(tok:_SLASH ;nod:slashn;op_overloading_supported:true), { binary overloading supported }
(tok:_EQ ;nod:equaln;op_overloading_supported:true), { binary overloading supported }
(tok:_GT ;nod:gtn;op_overloading_supported:true), { binary overloading supported }
(tok:_LT ;nod:ltn;op_overloading_supported:true), { binary overloading supported }
(tok:_GTE ;nod:gten;op_overloading_supported:true), { binary overloading supported }
(tok:_LTE ;nod:lten;op_overloading_supported:true), { binary overloading supported }
(tok:_SYMDIF ;nod:symdifn;op_overloading_supported:true), { binary overloading supported }
(tok:_STARSTAR ;nod:starstarn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_AS ;nod:asn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_IN ;nod:inn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_IS ;nod:isn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_OR ;nod:orn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_AND ;nod:andn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_DIV ;nod:divn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_NOT ;nod:notn;op_overloading_supported:true), { unary overloading supported }
(tok:_OP_MOD ;nod:modn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_SHL ;nod:shln;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_SHR ;nod:shrn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_XOR ;nod:xorn;op_overloading_supported:true), { binary overloading supported }
(tok:_ASSIGNMENT;nod:assignn;op_overloading_supported:true), { unary overloading supported }
(tok:_NE ;nod:unequaln;op_overloading_supported:true) { binary overloading supported }
(tok:_PLUS ;nod:addn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_MINUS ;nod:subn;inr:-1;op_overloading_supported:true), { binary and unary overloading supported }
(tok:_STAR ;nod:muln;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_SLASH ;nod:slashn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_EQ ;nod:equaln;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_GT ;nod:gtn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_LT ;nod:ltn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_GTE ;nod:gten;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_LTE ;nod:lten;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_SYMDIF ;nod:symdifn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_STARSTAR ;nod:starstarn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_AS ;nod:asn;inr:-1;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_IN ;nod:inn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_IS ;nod:isn;inr:-1;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_OR ;nod:orn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_AND ;nod:andn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_DIV ;nod:divn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_NOT ;nod:notn;inr:-1;op_overloading_supported:true), { unary overloading supported }
(tok:_OP_MOD ;nod:modn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_SHL ;nod:shln;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_SHR ;nod:shrn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_XOR ;nod:xorn;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_ASSIGNMENT;nod:assignn;inr:-1;op_overloading_supported:true), { unary overloading supported }
(tok:_NE ;nod:unequaln;inr:-1;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_INC ;nod:inlinen;inr:in_inc_x;op_overloading_supported:true),{ unary overloading supported }
(tok:_OP_DEC ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported }
);
{ true, if we are parsing stuff which allows array constructors }
@ -331,13 +335,16 @@ implementation
end;
function isunaryoperatoroverloadable(treetyp : tnodetype;ld : tdef) : boolean;
function isunaryoperatoroverloadable(treetyp:tnodetype;inlinenumber:integer;ld:tdef) : boolean;
begin
result:=false;
case treetyp of
subn,
unaryminusn :
unaryminusn,
inlinen:
begin
{ only Inc, Dec inline functions are supported for now, so skip check inlinenumber }
if (ld.typ in [orddef,enumdef,floatdef]) then
exit;
@ -440,9 +447,12 @@ implementation
begin
result:=
tok2node[i].op_overloading_supported and
isunaryoperatoroverloadable(tok2node[i].nod,ld);
isunaryoperatoroverloadable(tok2node[i].nod,tok2node[i].inr,ld);
break;
end;
{ Inc, Dec operators are valid if only result type is the same as argument type }
if result and (optoken in [_OP_INC,_OP_DEC]) then
result:=pf.returndef=ld;
end;
end;
2 : begin
@ -468,35 +478,57 @@ implementation
operpd : tprocdef;
ppn : tcallparanode;
candidates : tcallcandidates;
cand_cnt : integer;
cand_cnt,
inlinenumber: integer;
begin
result:=false;
operpd:=nil;
{ load easier access variables }
ld:=tunarynode(t).left.resultdef;
if not isunaryoperatoroverloadable(t.nodetype,ld) then
{ if we are dealing with inline function then get the function }
if t.nodetype=inlinen then
inlinenumber:=tinlinenode(t).inlinenumber
else
inlinenumber:=-1;
if not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
exit;
{ operator overload is possible }
result:=true;
optoken:=NOTOKEN;
case t.nodetype of
notn:
optoken:=_OP_NOT;
unaryminusn:
optoken:=_MINUS;
else
begin
CGMessage(parser_e_operator_not_overloaded);
t:=cnothingnode.create;
exit;
inlinen:
case inlinenumber of
in_inc_x:
optoken:=_OP_INC;
in_dec_x:
optoken:=_OP_DEC;
end;
end;
if (optoken=NOTOKEN) then
begin
CGMessage(parser_e_operator_not_overloaded);
t:=cnothingnode.create;
exit;
end;
{ generate parameter nodes }
ppn:=ccallparanode.create(tunarynode(t).left.getcopy,nil);
ppn.get_paratype;
{ for inline nodes just copy existent callparanode }
if (t.nodetype=inlinen) and (tinlinenode(t).left.nodetype=callparan) then
ppn:=tcallparanode(tinlinenode(t).left.getcopy)
else
begin
ppn:=ccallparanode.create(tunarynode(t).left.getcopy,nil);
ppn.get_paratype;
end;
candidates:=tcallcandidates.create_operator(optoken,ppn);
{ stop when there are no operators found }

12
compiler/ninl.pas
View File

@ -2348,7 +2348,17 @@ implementation
end;
end
else
CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
begin
hp:=self;
if isunaryoverloaded(hp) then
begin
{ inc(rec) and dec(rec) assigns result value to argument }
result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp);
exit;
end
else
CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
end;
end
else
CGMessagePos(fileinfo,type_e_mismatch);

4
compiler/nset.pas
View File

@ -251,8 +251,8 @@ implementation
t:=self;
if isbinaryoverloaded(t) then
begin
result:=t;
exit;
result:=t;
exit;
end;
if right.resultdef.typ<>setdef then

4
compiler/pdecsub.pas
View File

@ -830,8 +830,8 @@ implementation
// _EXPLICIT:optoken:=;
_NEGATIVE:optoken:=_MINUS;
// _POSITIVE:optoken:=_PLUS;
// _INC:optoken:=;
// _DEC:optoken:=;
_INC:optoken:=_OP_INC;
_DEC:optoken:=_OP_DEC;
_LOGICALNOT:optoken:=_OP_NOT;
_IN:optoken:=_OP_IN;
_EQUAL:optoken:=_EQ;

4
compiler/symtable.pas
View File

@ -290,7 +290,9 @@ interface
{ _OP_SHR } 'shr',
{ _OP_XOR } 'xor',
{ _ASSIGNMENT } 'assign',
{ _OP_ENUMERATOR } 'enumerator');
{ _OP_ENUMERATOR } 'enumerator',
{ _OP_INC } 'inc',
{ _OP_DEC } 'dec');

6
compiler/tokens.pas
View File

@ -55,6 +55,8 @@ type
_OP_XOR,
_ASSIGNMENT,
_OP_ENUMERATOR,
_OP_INC,
_OP_DEC,
{ special chars }
_CARET,
_LECKKLAMMER,
@ -296,7 +298,7 @@ const
{ last operator which can be overloaded, the first_overloaded should
be declared directly after NOTOKEN }
first_overloaded = succ(NOTOKEN);
last_overloaded = _OP_ENUMERATOR;
last_overloaded = _OP_DEC;
type
tokenrec=record
@ -345,6 +347,8 @@ const
(str:'xor' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:':=' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'enumerator' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'++' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'--' ;special:true ;keyword:m_none;op:NOTOKEN),
{ Special chars }
(str:'^' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'[' ;special:true ;keyword:m_none;op:NOTOKEN),

20
tests/test/terecs6.pp
View File

@ -30,8 +30,8 @@ type
class operator BitwiseOr(a, b: TFoo): TFoo;
class operator BitwiseAnd(a, b: TFoo): TFoo;
class operator BitwiseXor(a, b: TFoo): TFoo;
// class operator Inc(a: TFoo): TFoo;
// class operator Dec(a: TFoo): TFoo;
class operator Inc(a: TFoo): TFoo;
class operator Dec(a: TFoo): TFoo;
end;
class operator TFoo.Equal(a, b: TFoo): Boolean;
@ -144,6 +144,16 @@ begin
Result.F := a.F xor b.F;
end;
class operator TFoo.Inc(a: TFoo): TFoo;
begin
Result.F := a.F + 1;
end;
class operator TFoo.Dec(a: TFoo): TFoo;
begin
Result.F := a.F - 1;
end;
var
a, b: TFoo;
begin
@ -197,5 +207,11 @@ begin
if (a xor b).F <> (a.F xor b.F) then
halt(23);
}
inc(a);
if a.F <> 2 then
halt(24);
dec(b);
if b.F <> 1 then
halt(25);
WriteLn('ok');
end.