mirror of
https://github.com/nim-lang/Nim.git
synced 2026-01-09 22:43:34 +00:00
270 lines
7.0 KiB
ObjectPascal
270 lines
7.0 KiB
ObjectPascal
//
|
|
//
|
|
// The Nimrod Compiler
|
|
// (c) Copyright 2009 Andreas Rumpf
|
|
//
|
|
// See the file "copying.txt", included in this
|
|
// distribution, for details about the copyright.
|
|
//
|
|
|
|
unit cgmeth;
|
|
|
|
// This module implements code generation for multi methods.
|
|
|
|
interface
|
|
|
|
{$include 'config.inc'}
|
|
|
|
uses
|
|
sysutils, nsystem,
|
|
options, ast, astalgo, msgs, idents, rnimsyn, types, magicsys;
|
|
|
|
procedure methodDef(s: PSym);
|
|
function methodCall(n: PNode): PNode;
|
|
function generateMethodDispatchers(): PNode;
|
|
|
|
implementation
|
|
|
|
const
|
|
skipPtrs = {@set}[tyVar, tyPtr, tyRef, tyGenericInst];
|
|
|
|
function genConv(n: PNode; d: PType; downcast: bool): PNode;
|
|
var
|
|
dest, source: PType;
|
|
diff: int;
|
|
begin
|
|
dest := skipTypes(d, abstractPtrs);
|
|
source := skipTypes(n.typ, abstractPtrs);
|
|
if (source.kind = tyObject) and (dest.kind = tyObject) then begin
|
|
diff := inheritanceDiff(dest, source);
|
|
if diff = high(int) then InternalError(n.info, 'cgmeth.genConv');
|
|
if diff < 0 then begin
|
|
result := newNodeIT(nkObjUpConv, n.info, d);
|
|
addSon(result, n);
|
|
if downCast then
|
|
InternalError(n.info, 'cgmeth.genConv: no upcast allowed');
|
|
end
|
|
else if diff > 0 then begin
|
|
result := newNodeIT(nkObjDownConv, n.info, d);
|
|
addSon(result, n);
|
|
if not downCast then
|
|
InternalError(n.info, 'cgmeth.genConv: no downcast allowed');
|
|
end
|
|
else result := n
|
|
end
|
|
else result := n
|
|
end;
|
|
|
|
function methodCall(n: PNode): PNode;
|
|
var
|
|
disp: PSym;
|
|
i: int;
|
|
begin
|
|
result := n;
|
|
disp := lastSon(result.sons[0].sym.ast).sym;
|
|
result.sons[0].sym := disp;
|
|
for i := 1 to sonsLen(result)-1 do
|
|
result.sons[i] := genConv(result.sons[i], disp.typ.sons[i], true)
|
|
end;
|
|
|
|
var
|
|
gMethods: array of TSymSeq;
|
|
|
|
function sameMethodBucket(a, b: PSym): bool;
|
|
var
|
|
i: int;
|
|
aa, bb: PType;
|
|
begin
|
|
result := false;
|
|
if a.name.id <> b.name.id then exit;
|
|
if sonsLen(a.typ) <> sonsLen(b.typ) then exit;
|
|
// check for return type:
|
|
if not sameTypeOrNil(a.typ.sons[0], b.typ.sons[0]) then exit;
|
|
for i := 1 to sonsLen(a.typ)-1 do begin
|
|
aa := a.typ.sons[i];
|
|
bb := b.typ.sons[i];
|
|
while true do begin
|
|
aa := skipTypes(aa, {@set}[tyGenericInst]);
|
|
bb := skipTypes(bb, {@set}[tyGenericInst]);
|
|
if (aa.kind = bb.kind) and (aa.kind in [tyVar, tyPtr, tyRef]) then begin
|
|
aa := aa.sons[0];
|
|
bb := bb.sons[0];
|
|
end
|
|
else
|
|
break
|
|
end;
|
|
if sameType(aa, bb)
|
|
or (aa.kind = tyObject) and (bb.kind = tyObject)
|
|
and (inheritanceDiff(bb, aa) < 0) then begin end
|
|
else exit;
|
|
end;
|
|
result := true
|
|
end;
|
|
|
|
procedure methodDef(s: PSym);
|
|
var
|
|
i, L, q: int;
|
|
disp: PSym;
|
|
begin
|
|
L := length(gMethods);
|
|
for i := 0 to L-1 do begin
|
|
if sameMethodBucket(gMethods[i][0], s) then begin
|
|
{@ignore}
|
|
q := length(gMethods[i]);
|
|
setLength(gMethods[i], q+1);
|
|
gMethods[i][q] := s;
|
|
{@emit
|
|
add(gMethods[i], s);
|
|
}
|
|
// store a symbol to the dispatcher:
|
|
addSon(s.ast, lastSon(gMethods[i][0].ast));
|
|
exit
|
|
end
|
|
end;
|
|
{@ignore}
|
|
setLength(gMethods, L+1);
|
|
setLength(gMethods[L], 1);
|
|
gMethods[L][0] := s;
|
|
{@emit
|
|
add(gMethods, @[s]);
|
|
}
|
|
// create a new dispatcher:
|
|
disp := copySym(s);
|
|
disp.typ := copyType(disp.typ, disp.typ.owner, false);
|
|
if disp.typ.callConv = ccInline then disp.typ.callConv := ccDefault;
|
|
disp.ast := copyTree(s.ast);
|
|
disp.ast.sons[codePos] := nil;
|
|
if s.typ.sons[0] <> nil then
|
|
disp.ast.sons[resultPos].sym := copySym(s.ast.sons[resultPos].sym);
|
|
addSon(s.ast, newSymNode(disp));
|
|
end;
|
|
|
|
function relevantCol(methods: TSymSeq; col: int): bool;
|
|
var
|
|
t: PType;
|
|
i: int;
|
|
begin
|
|
// returns true iff the position is relevant
|
|
t := methods[0].typ.sons[col];
|
|
result := false;
|
|
if skipTypes(t, skipPtrs).kind = tyObject then
|
|
for i := 1 to high(methods) do
|
|
if not SameType(methods[i].typ.sons[col], t) then begin
|
|
result := true; exit
|
|
end
|
|
end;
|
|
|
|
function cmpSignatures(a, b: PSym; const relevantCols: TIntSet): int;
|
|
var
|
|
col, d: int;
|
|
aa, bb: PType;
|
|
begin
|
|
result := 0;
|
|
for col := 1 to sonsLen(a.typ)-1 do
|
|
if intSetContains(relevantCols, col) then begin
|
|
aa := skipTypes(a.typ.sons[col], skipPtrs);
|
|
bb := skipTypes(b.typ.sons[col], skipPtrs);
|
|
d := inheritanceDiff(aa, bb);
|
|
if (d <> high(int)) then begin
|
|
result := d; exit
|
|
end
|
|
end
|
|
end;
|
|
|
|
procedure sortBucket(var a: TSymSeq; const relevantCols: TIntSet);
|
|
// we use shellsort here; fast and simple
|
|
var
|
|
N, i, j, h: int;
|
|
v: PSym;
|
|
begin
|
|
N := length(a);
|
|
h := 1; repeat h := 3*h+1; until h > N;
|
|
repeat
|
|
h := h div 3;
|
|
for i := h to N-1 do begin
|
|
v := a[i]; j := i;
|
|
while cmpSignatures(a[j-h], v, relevantCols) >= 0 do begin
|
|
a[j] := a[j-h]; j := j - h;
|
|
if j < h then break
|
|
end;
|
|
a[j] := v;
|
|
end;
|
|
until h = 1
|
|
end;
|
|
|
|
function genDispatcher(methods: TSymSeq; const relevantCols: TIntSet): PSym;
|
|
var
|
|
disp, cond, call, ret, a, isn: PNode;
|
|
base, curr, ands, iss: PSym;
|
|
meth, col, paramLen: int;
|
|
begin
|
|
base := lastSon(methods[0].ast).sym;
|
|
result := base;
|
|
paramLen := sonsLen(base.typ);
|
|
disp := newNodeI(nkIfStmt, base.info);
|
|
ands := getSysSym('and');
|
|
iss := getSysSym('is');
|
|
for meth := 0 to high(methods) do begin
|
|
curr := methods[meth];
|
|
// generate condition:
|
|
cond := nil;
|
|
for col := 1 to paramLen-1 do begin
|
|
if IntSetContains(relevantCols, col) then begin
|
|
isn := newNodeIT(nkCall, base.info, getSysType(tyBool));
|
|
addSon(isn, newSymNode(iss));
|
|
addSon(isn, newSymNode(base.typ.n.sons[col].sym));
|
|
addSon(isn, newNodeIT(nkType, base.info, curr.typ.sons[col]));
|
|
if cond <> nil then begin
|
|
a := newNodeIT(nkCall, base.info, getSysType(tyBool));
|
|
addSon(a, newSymNode(ands));
|
|
addSon(a, cond);
|
|
addSon(a, isn);
|
|
cond := a
|
|
end
|
|
else
|
|
cond := isn
|
|
end
|
|
end;
|
|
// generate action:
|
|
call := newNodeI(nkCall, base.info);
|
|
addSon(call, newSymNode(curr));
|
|
for col := 1 to paramLen-1 do begin
|
|
addSon(call, genConv(newSymNode(base.typ.n.sons[col].sym),
|
|
curr.typ.sons[col], false));
|
|
end;
|
|
if base.typ.sons[0] <> nil then begin
|
|
a := newNodeI(nkAsgn, base.info);
|
|
addSon(a, newSymNode(base.ast.sons[resultPos].sym));
|
|
addSon(a, call);
|
|
ret := newNodeI(nkReturnStmt, base.info);
|
|
addSon(ret, a);
|
|
end
|
|
else
|
|
ret := call;
|
|
a := newNodeI(nkElifBranch, base.info);
|
|
addSon(a, cond);
|
|
addSon(a, ret);
|
|
addSon(disp, a);
|
|
end;
|
|
result.ast.sons[codePos] := disp;
|
|
end;
|
|
|
|
function generateMethodDispatchers(): PNode;
|
|
var
|
|
bucket, col: int;
|
|
relevantCols: TIntSet;
|
|
begin
|
|
result := newNode(nkStmtList);
|
|
for bucket := 0 to length(gMethods)-1 do begin
|
|
IntSetInit(relevantCols);
|
|
for col := 1 to sonsLen(gMethods[bucket][0].typ)-1 do
|
|
if relevantCol(gMethods[bucket], col) then IntSetIncl(relevantCols, col);
|
|
sortBucket(gMethods[bucket], relevantCols);
|
|
addSon(result, newSymNode(genDispatcher(gMethods[bucket], relevantCols)));
|
|
end
|
|
end;
|
|
|
|
initialization
|
|
{@emit gMethods := @[]; }
|
|
end.
|