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

* rewrote isbinaryoverloadable to use a case. it's now much easier

Browse Source 
to understand what is happening
This commit is contained in:
peter 2002-11-27 22:11:59 +00:00
parent a4c5740fce
commit 18fd47a47a
1 changed files with 259 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

378
compiler/htypechk.pas
View File

@ -77,13 +77,11 @@ interface
{ is overloading of this operator allowed for this { is overloading of this operator allowed for this
binary operator } binary operator }
function isbinaryoperatoroverloadable(ld, rd,dd : tdef; function isbinaryoperatoroverloadable(ld, rd,dd : tdef; treetyp : tnodetype) : boolean;
treetyp : tnodetype) : boolean;
{ is overloading of this operator allowed for this { is overloading of this operator allowed for this
unary operator } unary operator }
function isunaryoperatoroverloadable(rd,dd : tdef; function isunaryoperatoroverloadable(rd,dd : tdef; treetyp : tnodetype) : boolean;
treetyp : tnodetype) : boolean;
{ check operator args and result type } { check operator args and result type }
function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean; function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
@ -137,132 +135,270 @@ implementation
TValidAssigns=set of TValidAssign; TValidAssigns=set of TValidAssign;
{ ld is the left type definition function isbinaryoperatoroverloadable(ld,rd,dd : tdef; treetyp : tnodetype) : boolean;
rd the right type definition
dd the result type definition or voiddef if unkown }
function isbinaryoperatoroverloadable(ld, rd, dd : tdef;
treetyp : tnodetype) : boolean;
begin begin
isbinaryoperatoroverloadable:= { everything is possible, the exceptions will be
(treetyp=starstarn) or handled below }
(ld.deftype=recorddef) or isbinaryoperatoroverloadable:=false;
(rd.deftype=recorddef) or { power ** is always possible }
(ld.deftype=variantdef) or if (treetyp=starstarn) then
(rd.deftype=variantdef) or begin
((rd.deftype=pointerdef) and isbinaryoperatoroverloadable:=true;
not(is_dynamic_array(ld) and exit;
is_voidpointer(rd)) and end;
not(is_pchar(rd) and case ld.deftype of
(is_chararray(ld) or recorddef,
(ld.deftype=stringdef) or variantdef :
(treetyp=addn))) and begin
(not(ld.deftype in [pointerdef,objectdef,classrefdef,procvardef]) or isbinaryoperatoroverloadable:=true;
not (treetyp in [equaln,unequaln,gtn,gten,ltn,lten,subn]) exit;
) and end;
(not is_integer(ld) or not (treetyp in [addn,subn])) procvardef :
) or begin
((ld.deftype=pointerdef) and if (rd.deftype in [pointerdef,procdef,procvardef]) and
not(is_dynamic_array(rd) and (treetyp in [equaln,unequaln]) then
is_voidpointer(ld)) and begin
not(is_pchar(ld) and isbinaryoperatoroverloadable:=false;
(is_chararray(rd) or exit;
(rd.deftype=stringdef) or end;
(treetyp=addn))) and end;
(not(rd.deftype in [stringdef,pointerdef,objectdef,classrefdef,procvardef]) and pointerdef :
((not is_integer(rd) and (rd.deftype<>objectdef) begin
and (rd.deftype<>classrefdef)) or if (rd.deftype in [pointerdef,objectdef,classrefdef,procvardef]) and
not (treetyp in [equaln,unequaln,gtn,gten,ltn,lten,addn,subn]) (treetyp in [equaln,unequaln,gtn,gten,ltn,lten,addn,subn]) then
) begin
) isbinaryoperatoroverloadable:=false;
) or exit;
{ array def, but not mmx or chararray+[char,string,chararray] } end;
((ld.deftype=arraydef) and
not((cs_mmx in aktlocalswitches) and { don't allow operations on pointer/integer }
is_mmx_able_array(ld)) and if is_integer(rd) then
not(is_dynamic_array(ld) and begin
is_voidpointer(rd)) and isbinaryoperatoroverloadable:=false;
not(is_chararray(ld) and exit;
(is_char(rd) or end;
is_pchar(rd) or
{ char array + int = pchar + int, fix for web bug 1377 (JM) } { don't allow pchar+string }
is_integer(rd) or if is_pchar(ld) and
(rd.deftype=stringdef) or (treetyp in [addn,equaln,unequaln,gtn,gten,ltn,lten]) and
is_chararray(rd))) (is_chararray(rd) or
) or is_char(rd) or
((rd.deftype=arraydef) and (rd.deftype=stringdef)) then
not((cs_mmx in aktlocalswitches) and begin
is_mmx_able_array(rd)) and isbinaryoperatoroverloadable:=false;
not(is_dynamic_array(rd) and exit;
is_voidpointer(ld)) and end;
not(is_chararray(rd) and
(is_char(ld) or isbinaryoperatoroverloadable:=true;
is_pchar(ld) or end;
(ld.deftype=stringdef) or arraydef :
is_chararray(ld))) begin
) or { not mmx }
{ <> and = are defined for classes } if (cs_mmx in aktlocalswitches) and
( is_mmx_able_array(ld) then
(ld.deftype=objectdef) and begin
not((treetyp in [equaln,unequaln]) and is_class_or_interface(ld)) isbinaryoperatoroverloadable:=false;
) or exit;
( end;
(rd.deftype=objectdef) and { not chararray+[char,string,chararray] }
not((treetyp in [equaln,unequaln]) and is_class_or_interface(rd)) if is_chararray(ld) and
) (treetyp in [addn,equaln,unequaln,gtn,gten,ltn,lten]) and
or (is_char(rd) or
{ allow other operators that + on strings } is_pchar(rd) or
( is_integer(rd) or
(is_char(rd) or (rd.deftype=stringdef) or
is_pchar(rd) or is_chararray(rd)) then
(rd.deftype=stringdef) or begin
is_chararray(rd) or isbinaryoperatoroverloadable:=false;
is_char(ld) or exit;
is_pchar(ld) or end;
(ld.deftype=stringdef) or
is_chararray(ld) isbinaryoperatoroverloadable:=true;
) and end;
not(treetyp in [addn,equaln,unequaln,gtn,gten,ltn,lten]) and objectdef :
not(is_pchar(ld) and begin
(is_integer(rd) or (rd.deftype=pointerdef)) and { <> and = are defined for classes }
(treetyp=subn) if (treetyp in [equaln,unequaln]) and
) is_class_or_interface(ld) then
); begin
isbinaryoperatoroverloadable:=false;
exit;
end;
isbinaryoperatoroverloadable:=true;
end;
stringdef :
begin
if ((rd.deftype=stringdef) or
is_char(rd) or
is_pchar(rd) or
is_chararray(rd)) and
(treetyp in [addn,equaln,unequaln,gtn,gten,ltn,lten]) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
isbinaryoperatoroverloadable:=true;
end;
end;
{ Also check the right def. There can be some duplicated code
that is never reached. But to place everything in one big
case is unmaintainable }
case rd.deftype of
recorddef,
variantdef :
begin
isbinaryoperatoroverloadable:=true;
exit;
end;
procvardef :
begin
if (ld.deftype in [pointerdef,procdef,procvardef]) and
(treetyp in [equaln,unequaln]) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
isbinaryoperatoroverloadable:=true;
end;
pointerdef :
begin
if (ld.deftype in [pointerdef,objectdef,classrefdef,procvardef]) and
(treetyp in [equaln,unequaln,gtn,gten,ltn,lten,addn,subn]) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
{ don't allow operations on pointer/integer }
if is_integer(ld) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
{ don't allow pchar+string }
if is_pchar(rd) and
(treetyp in [addn,equaln,unequaln,gtn,gten,ltn,lten]) and
(is_chararray(ld) or
is_char(ld) or
(ld.deftype=stringdef)) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
isbinaryoperatoroverloadable:=true;
end;
arraydef :
begin
{ not mmx }
if (cs_mmx in aktlocalswitches) and
is_mmx_able_array(rd) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
{ not chararray+[char,string,chararray] }
if is_chararray(rd) and
(treetyp in [addn,equaln,unequaln,gtn,gten,ltn,lten]) and
(is_char(ld) or
is_pchar(ld) or
is_integer(ld) or
(ld.deftype=stringdef) or
is_chararray(ld)) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
isbinaryoperatoroverloadable:=true;
end;
objectdef :
begin
{ <> and = are defined for classes }
if (treetyp in [equaln,unequaln]) and
is_class_or_interface(rd) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
isbinaryoperatoroverloadable:=true;
end;
stringdef :
begin
if ((ld.deftype=stringdef) or
is_char(ld) or
is_pchar(ld) or
is_chararray(ld)) and
(treetyp in [addn,equaln,unequaln,gtn,gten,ltn,lten]) then
begin
isbinaryoperatoroverloadable:=false;
exit;
end;
isbinaryoperatoroverloadable:=true;
end;
end;
end; end;
function isunaryoperatoroverloadable(rd,dd : tdef; function isunaryoperatoroverloadable(rd,dd : tdef; treetyp : tnodetype) : boolean;
treetyp : tnodetype) : boolean;
begin begin
isunaryoperatoroverloadable:=false; isunaryoperatoroverloadable:=false;
{ what assignment overloading should be allowed ?? } case treetyp of
if (treetyp=assignn) then assignn :
begin begin
isunaryoperatoroverloadable:=true; if (rd.deftype=orddef) and
{ this already get tbs0261 to fail (dd.deftype=orddef) then
isunaryoperatoroverloadable:=not is_equal(rd,dd); PM } begin
end isunaryoperatoroverloadable:=false;
{ should we force that rd and dd are equal ?? } exit;
else if (treetyp=subn { unaryminusn }) then end;
begin isunaryoperatoroverloadable:=true;
isunaryoperatoroverloadable:= end;
not is_integer(rd) and not (rd.deftype=floatdef)
subn :
begin
if is_integer(rd) or
(rd.deftype=floatdef) then
begin
isunaryoperatoroverloadable:=false;
exit;
end;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
and not ((cs_mmx in aktlocalswitches) and if (cs_mmx in aktlocalswitches) and
is_mmx_able_array(rd)) is_mmx_able_array(rd) then
begin
isunaryoperatoroverloadable:=false;
exit;
end;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
; isunaryoperatoroverloadable:=true;
end end;
else if (treetyp=notn) then
begin notn :
isunaryoperatoroverloadable:=not is_integer(rd) and not is_boolean(rd) begin
if is_integer(rd) or
is_boolean(rd) then
begin
isunaryoperatoroverloadable:=false;
exit;
end;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
and not ((cs_mmx in aktlocalswitches) and if (cs_mmx in aktlocalswitches) and
is_mmx_able_array(rd)) is_mmx_able_array(rd) then
begin
isunaryoperatoroverloadable:=false;
exit;
end;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
; isunaryoperatoroverloadable:=true;
end; end;
end;
end; end;
function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean; function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
var var
ld,rd,dd : tdef; ld,rd,dd : tdef;
@ -975,7 +1111,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.51 2002-11-25 17:43:17 peter Revision 1.52 2002-11-27 22:11:59 peter
* rewrote isbinaryoverloadable to use a case. it's now much easier
to understand what is happening
Revision 1.51 2002/11/25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp * splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext) * merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once * made operator search faster by walking the list only once