summary refs log tree commit diff stats
path: root/nim/seminst.pas
diff options
context:
space:
mode:
Diffstat (limited to 'nim/seminst.pas')
-rwxr-xr-xnim/seminst.pas365
1 files changed, 0 insertions, 365 deletions
diff --git a/nim/seminst.pas b/nim/seminst.pas
deleted file mode 100755
index ea8889007..000000000
--- a/nim/seminst.pas
+++ /dev/null
@@ -1,365 +0,0 @@
-//
-//
-//           The Nimrod Compiler
-//        (c) Copyright 2009 Andreas Rumpf
-//
-//    See the file "copying.txt", included in this
-//    distribution, for details about the copyright.
-//
-
-// This module does the instantiation of generic procs and types.
-
-function generateInstance(c: PContext; fn: PSym; const pt: TIdTable;
-                          const info: TLineInfo): PSym; forward;
-// generates an instantiated proc
-
-
-function searchInstTypes(const tab: TIdTable; key: PType): PType;
-var
-  t: PType;
-  h: THash;
-  j: int;
-  match: bool;
-begin // returns nil if we need to declare this type
-  result := PType(IdTableGet(tab, key));
-  if (result = nil) and (tab.counter > 0) then begin
-    // we have to do a slow linear search because types may need
-    // to be compared by their structure:
-    for h := 0 to high(tab.data) do begin
-      t := PType(tab.data[h].key);
-      if t <> nil then begin
-        if key.containerId = t.containerID then begin
-          match := true;
-          for j := 0 to sonsLen(t) - 1 do begin
-            // XXX sameType is not really correct for nested generics?
-            if not sameType(t.sons[j], key.sons[j]) then begin
-              match := false; break
-            end
-          end;
-          if match then begin result := PType(tab.data[h].val); exit end;
-        end
-      end
-    end
-  end
-end;
-
-function containsGenericTypeIter(t: PType; closure: PObject): bool;
-begin
-  result := t.kind in GenericTypes;
-end;
-
-function containsGenericType(t: PType): bool;
-begin
-  result := iterOverType(t, containsGenericTypeIter, nil);
-end;
-
-(*
-function instantiateSym(c: PInstantiateClosure; sym: PSym): PSym;
-begin
-  if sym = nil then begin result := nil; exit end; // BUGFIX
-  result := PSym(idTableGet(c.symMap, sym));
-  if (result = nil) then begin
-    if (sym.owner.id = c.fn.id) then begin // XXX: nested generics?
-      result := copySym(sym, false);
-      include(result.flags, sfFromGeneric);
-      idTablePut(c.symMap, sym, result); // BUGFIX
-      result.typ := instantiateType(c, sym.typ);
-      if (result.owner <> nil) and (result.owner.kind = skModule) then
-        result.owner := c.module // BUGFIX
-      else
-        result.owner := instantiateSym(c, result.owner);
-      if sym.ast <> nil then begin
-        result.ast := instantiateTree(c, sym.ast);
-      end
-    end
-    else
-      result := sym // do not copy t!
-  end
-end;
-*)
-
-procedure instantiateGenericParamList(c: PContext; n: PNode; const pt: TIdTable);
-var
-  i: int;
-  s, q: PSym;
-  t: PType;
-  a: PNode;
-begin
-  if (n.kind <> nkGenericParams) then 
-    InternalError(n.info, 'instantiateGenericParamList; no generic params');
-  for i := 0 to sonsLen(n)-1 do begin
-    a := n.sons[i];
-    if a.kind <> nkSym then 
-      InternalError(a.info, 'instantiateGenericParamList; no symbol');
-    q := a.sym;
-    if not (q.typ.kind in [tyTypeDesc, tyGenericParam]) then continue;
-    s := newSym(skType, q.name, getCurrOwner());
-    t := PType(IdTableGet(pt, q.typ));
-    if t = nil then liMessage(a.info, errCannotInstantiateX, s.name.s);
-    if (t.kind = tyGenericParam) then begin
-      InternalError(a.info, 'instantiateGenericParamList: ' + q.name.s);
-    end;
-    s.typ := t;
-    addDecl(c, s)
-  end
-end;
-
-function GenericCacheGet(c: PContext; genericSym, instSym: PSym): PSym;
-var
-  i: int;
-  a, b: PSym;
-begin
-  result := nil;
-  for i := 0 to sonsLen(c.generics)-1 do begin
-    if c.generics.sons[i].kind <> nkExprEqExpr then
-      InternalError(genericSym.info, 'GenericCacheGet');
-    a := c.generics.sons[i].sons[0].sym;
-    if genericSym.id = a.id then begin
-      b := c.generics.sons[i].sons[1].sym;
-      if equalParams(b.typ.n, instSym.typ.n) = paramsEqual then begin
-        //if gVerbosity > 0 then 
-        //  MessageOut('found in cache: ' + getProcHeader(instSym));
-        result := b; exit
-      end
-    end
-  end
-end;
-
-procedure GenericCacheAdd(c: PContext; genericSym, instSym: PSym);
-var
-  n: PNode;
-begin
-  n := newNode(nkExprEqExpr);
-  addSon(n, newSymNode(genericSym));
-  addSon(n, newSymNode(instSym));
-  addSon(c.generics, n);
-end;
-
-function generateInstance(c: PContext; fn: PSym; const pt: TIdTable;
-                          const info: TLineInfo): PSym;
-// generates an instantiated proc
-var
-  oldPrc, oldMod: PSym;
-  oldP: PProcCon;
-  n: PNode;
-begin
-  if c.InstCounter > 1000 then InternalError(fn.ast.info, 'nesting too deep');
-  inc(c.InstCounter);
-  oldP := c.p; // restore later
-  // NOTE: for access of private fields within generics from a different module
-  // and other identifiers we fake the current module temporarily!
-  oldMod := c.module;
-  c.module := getModule(fn);
-  result := copySym(fn, false);
-  include(result.flags, sfFromGeneric);
-  result.owner := getCurrOwner().owner;
-  n := copyTree(fn.ast);
-  result.ast := n;
-  pushOwner(result);
-  openScope(c.tab);
-  if (n.sons[genericParamsPos] = nil) then 
-    InternalError(n.info, 'generateInstance');
-  n.sons[namePos] := newSymNode(result);
-  pushInfoContext(info);
-
-  instantiateGenericParamList(c, n.sons[genericParamsPos], pt);
-  n.sons[genericParamsPos] := nil;
-  // semantic checking for the parameters:
-  if n.sons[paramsPos] <> nil then begin
-    semParamList(c, n.sons[ParamsPos], nil, result);
-    addParams(c, result.typ.n);
-  end
-  else begin
-    result.typ := newTypeS(tyProc, c);
-    addSon(result.typ, nil);
-  end;
-
-  // now check if we have already such a proc generated
-  oldPrc := GenericCacheGet(c, fn, result);
-  if oldPrc = nil then begin
-    // add it here, so that recursive generic procs are possible:
-    GenericCacheAdd(c, fn, result);
-    addDecl(c, result);
-    if n.sons[codePos] <> nil then begin
-      c.p := newProcCon(result);
-      if result.kind in [skProc, skMethod, skConverter] then begin
-        addResult(c, result.typ.sons[0], n.info);
-        addResultNode(c, n);
-      end;
-      n.sons[codePos] := semStmtScope(c, n.sons[codePos]);
-    end
-  end
-  else
-    result := oldPrc;
-  popInfoContext();
-  closeScope(c.tab); // close scope for parameters
-  popOwner();
-  c.p := oldP; // restore
-  c.module := oldMod;
-  dec(c.InstCounter);
-end;
-
-procedure checkConstructedType(const info: TLineInfo; t: PType);
-begin
-  if (tfAcyclic in t.flags)
-  and (skipTypes(t, abstractInst).kind <> tyObject) then
-    liMessage(info, errInvalidPragmaX, 'acyclic');
-  if computeSize(t) < 0 then
-    liMessage(info, errIllegalRecursionInTypeX, typeToString(t));
-  if (t.kind = tyVar) and (t.sons[0].kind = tyVar) then
-    liMessage(info, errVarVarTypeNotAllowed);
-end;
-
-type
-  TReplTypeVars = record
-    c: PContext;
-    typeMap: TIdTable; // map PType to PType
-    symMap: TIdTable;  // map PSym to PSym
-    info: TLineInfo;
-  end;
-
-function ReplaceTypeVarsT(var cl: TReplTypeVars; t: PType): PType; forward;
-function ReplaceTypeVarsS(var cl: TReplTypeVars; s: PSym): PSym; forward;
-
-function ReplaceTypeVarsN(var cl: TReplTypeVars; n: PNode): PNode;
-var
-  i, Len: int;
-begin
-  result := nil;
-  if n <> nil then begin
-    result := copyNode(n);
-    result.typ := ReplaceTypeVarsT(cl, n.typ);
-    case n.kind of
-      nkNone..pred(nkSym), succ(nkSym)..nkNilLit: begin end;
-      nkSym: begin
-        result.sym := ReplaceTypeVarsS(cl, n.sym);
-      end;
-      else begin
-        len := sonsLen(n);
-        if len > 0 then begin
-          newSons(result, len);
-          for i := 0 to len-1 do
-            result.sons[i] := ReplaceTypeVarsN(cl, n.sons[i]);
-        end
-      end
-    end
-  end
-end;
-
-function ReplaceTypeVarsS(var cl: TReplTypeVars; s: PSym): PSym;
-begin
-  if s = nil then begin result := nil; exit end;
-  result := PSym(idTableGet(cl.symMap, s));
-  if (result = nil) then begin
-    result := copySym(s, false);
-    include(result.flags, sfFromGeneric);
-    idTablePut(cl.symMap, s, result);
-    result.typ := ReplaceTypeVarsT(cl, s.typ);
-    result.owner := s.owner;
-    result.ast := ReplaceTypeVarsN(cl, s.ast);
-  end
-end;
-
-function lookupTypeVar(cl: TReplTypeVars; t: PType): PType;
-begin
-  result := PType(idTableGet(cl.typeMap, t));
-  if result = nil then
-    liMessage(t.sym.info, errCannotInstantiateX, typeToString(t))
-  else if result.kind = tyGenericParam then
-    InternalError(cl.info, 'substitution with generic parameter');
-end;
-
-function ReplaceTypeVarsT(var cl: TReplTypeVars; t: PType): PType;
-var
-  i: int;
-  body, newbody, x, header: PType;
-begin
-  result := t;
-  if t = nil then exit;
-  case t.kind of
-    tyGenericParam: begin
-      result := lookupTypeVar(cl, t);
-    end;
-    tyGenericInvokation: begin
-      body := t.sons[0];
-      if body.kind <> tyGenericBody then
-        InternalError(cl.info, 'no generic body');
-      header := nil;
-      for i := 1 to sonsLen(t)-1 do begin
-        if t.sons[i].kind = tyGenericParam then begin
-          x := lookupTypeVar(cl, t.sons[i]);
-          if header = nil then header := copyType(t, t.owner, false);
-          header.sons[i] := x;
-        end
-        else
-          x := t.sons[i];
-        idTablePut(cl.typeMap, body.sons[i-1], x);
-      end;
-      // cycle detection:
-      if header = nil then header := t;
-      result := searchInstTypes(gInstTypes, header);
-      if result <> nil then exit;
-      
-      result := newType(tyGenericInst, t.sons[0].owner);
-      for i := 0 to sonsLen(t)-1 do begin
-        // if one of the params is not concrete, we cannot do anything
-        // but we already raised an error!
-        addSon(result, header.sons[i]);
-      end;
-      // add these before recursive calls:
-      idTablePut(gInstTypes, header, result);
-
-      newbody := ReplaceTypeVarsT(cl, lastSon(body));
-      newbody.n := ReplaceTypeVarsN(cl, lastSon(body).n);
-      addSon(result, newbody);
-      //writeln(output, ropeToStr(Typetoyaml(newbody)));
-      checkConstructedType(cl.info, newbody);
-    end;
-    tyGenericBody: begin
-      InternalError(cl.info, 'ReplaceTypeVarsT: tyGenericBody');
-      result := ReplaceTypeVarsT(cl, lastSon(t));
-    end 
-    else begin
-      if containsGenericType(t) then begin
-        result := copyType(t, t.owner, false);
-        for i := 0 to sonsLen(result)-1 do
-          result.sons[i] := ReplaceTypeVarsT(cl, result.sons[i]);
-        result.n := ReplaceTypeVarsN(cl, result.n);
-        if result.Kind in GenericTypes then 
-          liMessage(cl.info, errCannotInstantiateX, TypeToString(t, preferName));
-        //writeln(output, ropeToStr(Typetoyaml(result)));
-        //checkConstructedType(cl.info, result);
-      end
-    end
-  end
-end;
-
-function instGenericContainer(c: PContext; n: PNode; header: PType): PType;
-var
-  cl: TReplTypeVars;
-begin
-  InitIdTable(cl.symMap);
-  InitIdTable(cl.typeMap);
-  cl.info := n.info;
-  cl.c := c;
-  result := ReplaceTypeVarsT(cl, header);
-end;
-
-function generateTypeInstance(p: PContext; const pt: TIdTable;
-                              arg: PNode; t: PType): PType;
-var
-  cl: TReplTypeVars;
-begin
-  InitIdTable(cl.symMap);
-  copyIdTable(cl.typeMap, pt);
-  cl.info := arg.info;
-  cl.c := p;
-  pushInfoContext(arg.info);
-  result := ReplaceTypeVarsT(cl, t);
-  popInfoContext();
-end;
-
-function partialSpecialization(c: PContext; n: PNode; s: PSym): PNode;
-begin
-  result := n;
-end;