summary refs log tree commit diff stats
path: root/nim/cgmeth.pas
diff options
context:
space:
mode:
authorAraq <rumpf_a@web.de>2011-04-12 01:13:42 +0200
committerAraq <rumpf_a@web.de>2011-04-12 01:13:42 +0200
commitcd292568d775d55d9abb51e962882ecda12c03a9 (patch)
tree85451f0e1f17dc0463350915f12bdd0a82a73455 /nim/cgmeth.pas
parent46c41e43690cba9bc1caff6a994bb6915df8a1b7 (diff)
downloadNim-cd292568d775d55d9abb51e962882ecda12c03a9.tar.gz
big repo cleanup
Diffstat (limited to 'nim/cgmeth.pas')
-rwxr-xr-xnim/cgmeth.pas269
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.