diff options
author | Araq <rumpf_a@web.de> | 2011-04-12 01:13:42 +0200 |
---|---|---|
committer | Araq <rumpf_a@web.de> | 2011-04-12 01:13:42 +0200 |
commit | cd292568d775d55d9abb51e962882ecda12c03a9 (patch) | |
tree | 85451f0e1f17dc0463350915f12bdd0a82a73455 /nim/cgmeth.pas | |
parent | 46c41e43690cba9bc1caff6a994bb6915df8a1b7 (diff) | |
download | Nim-cd292568d775d55d9abb51e962882ecda12c03a9.tar.gz |
big repo cleanup
Diffstat (limited to 'nim/cgmeth.pas')
-rwxr-xr-x | nim/cgmeth.pas | 269 |
1 files changed, 0 insertions, 269 deletions
diff --git a/nim/cgmeth.pas b/nim/cgmeth.pas deleted file mode 100755 index 6b9335c4c..000000000 --- a/nim/cgmeth.pas +++ /dev/null @@ -1,269 +0,0 @@ -// -// -// 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. |