From cd292568d775d55d9abb51e962882ecda12c03a9 Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 12 Apr 2011 01:13:42 +0200 Subject: big repo cleanup --- nim/sigmatch.pas | 964 ------------------------------------------------------- 1 file changed, 964 deletions(-) delete mode 100755 nim/sigmatch.pas (limited to 'nim/sigmatch.pas') diff --git a/nim/sigmatch.pas b/nim/sigmatch.pas deleted file mode 100755 index 45a29fc29..000000000 --- a/nim/sigmatch.pas +++ /dev/null @@ -1,964 +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 implements the signature matching for resolving -// the call to overloaded procs, generic procs and operators. - -type - TCandidateState = (csEmpty, csMatch, csNoMatch); - TCandidate = record - exactMatches: int; - subtypeMatches: int; - intConvMatches: int; // conversions to int are not as expensive - convMatches: int; - genericMatches: int; - state: TCandidateState; - callee: PType; // may not be nil! - calleeSym: PSym; // may be nil - call: PNode; // modified call - bindings: TIdTable; // maps sym-ids to types - baseTypeMatch: bool; // needed for conversions from T to openarray[T] - // for example - end; - TTypeRelation = (isNone, isConvertible, isIntConv, isSubtype, - isGeneric, isEqual); - // order is important! - -procedure initCandidate(out c: TCandidate; callee: PType); -begin - c.exactMatches := 0; - c.subtypeMatches := 0; - c.convMatches := 0; - c.intConvMatches := 0; - c.genericMatches := 0; - c.state := csEmpty; - c.callee := callee; - c.calleeSym := nil; - c.call := nil; - c.baseTypeMatch := false; - initIdTable(c.bindings); - //assert(c.callee <> nil); -end; - -procedure copyCandidate(var a: TCandidate; const b: TCandidate); -begin - a.exactMatches := b.exactMatches; - a.subtypeMatches := b.subtypeMatches; - a.convMatches := b.convMatches; - a.intConvMatches := b.intConvMatches; - a.genericMatches := b.genericMatches; - a.state := b.state; - a.callee := b.callee; - a.calleeSym := b.calleeSym; - a.call := copyTree(b.call); - a.baseTypeMatch := b.baseTypeMatch; - copyIdTable(a.bindings, b.bindings); -end; - -function cmpCandidates(const a, b: TCandidate): int; -begin - result := a.exactMatches - b.exactMatches; - if result <> 0 then exit; - result := a.genericMatches - b.genericMatches; - if result <> 0 then exit; - result := a.subtypeMatches - b.subtypeMatches; - if result <> 0 then exit; - result := a.intConvMatches - b.intConvMatches; - if result <> 0 then exit; - result := a.convMatches - b.convMatches; -end; - -procedure writeMatches(const c: TCandidate); -begin - Writeln(output, 'exact matches: ' + toString(c.exactMatches)); - Writeln(output, 'subtype matches: ' + toString(c.subtypeMatches)); - Writeln(output, 'conv matches: ' + toString(c.convMatches)); - Writeln(output, 'intconv matches: ' + toString(c.intConvMatches)); - Writeln(output, 'generic matches: ' + toString(c.genericMatches)); -end; - -function getNotFoundError(c: PContext; n: PNode): string; -// Gives a detailed error message; this is seperated from semDirectCall, -// as semDirectCall is already pretty slow (and we need this information only -// in case of an error). -var - sym: PSym; - o: TOverloadIter; - i: int; - candidates: string; -begin - result := msgKindToString(errTypeMismatch); - for i := 1 to sonsLen(n)-1 do begin - //debug(n.sons[i].typ); - add(result, typeToString(n.sons[i].typ)); - if i <> sonsLen(n)-1 then add(result, ', '); - end; - addChar(result, ')'); - candidates := ''; - sym := initOverloadIter(o, c, n.sons[0]); - while sym <> nil do begin - if sym.kind in [skProc, skMethod, skIterator, skConverter] then begin - add(candidates, getProcHeader(sym)); - add(candidates, nl) - end; - sym := nextOverloadIter(o, c, n.sons[0]); - end; - if candidates <> '' then - add(result, nl +{&} msgKindToString(errButExpected) +{&} nl - +{&} candidates); -end; - -function typeRel(var mapping: TIdTable; f, a: PType): TTypeRelation; overload; - forward; - -function concreteType(const mapping: TIdTable; t: PType): PType; -begin - case t.kind of - tyArrayConstr: begin // make it an array - result := newType(tyArray, t.owner); - addSon(result, t.sons[0]); // XXX: t.owner is wrong for ID! - addSon(result, t.sons[1]); // XXX: semantic checking for the type? - end; - tyNil: result := nil; // what should it be? - tyGenericParam: begin - result := t; - while true do begin - result := PType(idTableGet(mapping, t)); - if result = nil then InternalError('lookup failed'); - if result.kind <> tyGenericParam then break - end - end; - else result := t // Note: empty is valid here - end -end; - -function handleRange(f, a: PType; min, max: TTypeKind): TTypeRelation; -var - k: TTypeKind; -begin - if a.kind = f.kind then - result := isEqual - else begin - k := skipTypes(a, {@set}[tyRange]).kind; - if k = f.kind then - result := isSubtype - else if (f.kind = tyInt) and (k in [tyInt..tyInt32]) then - result := isIntConv - else if (k >= min) and (k <= max) then - result := isConvertible - else - result := isNone - end -end; - -function handleFloatRange(f, a: PType): TTypeRelation; -var - k: TTypeKind; -begin - if a.kind = f.kind then - result := isEqual - else begin - k := skipTypes(a, {@set}[tyRange]).kind; - if k = f.kind then - result := isSubtype - else if (k >= tyFloat) and (k <= tyFloat128) then - result := isConvertible - else - result := isNone - end -end; - -function isObjectSubtype(a, f: PType): bool; -var - t: PType; -begin - t := a; - while (t <> nil) and (t.id <> f.id) do t := base(t); - result := t <> nil -end; - -function minRel(a, b: TTypeRelation): TTypeRelation; -begin - if a <= b then result := a else result := b -end; - -function tupleRel(var mapping: TIdTable; f, a: PType): TTypeRelation; -var - i: int; - x, y: PSym; - m: TTypeRelation; -begin - result := isNone; - if sonsLen(a) = sonsLen(f) then begin - result := isEqual; - for i := 0 to sonsLen(f)-1 do begin - m := typeRel(mapping, f.sons[i], a.sons[i]); - if m < isSubtype then begin result := isNone; exit end; - result := minRel(result, m); - end; - if (f.n <> nil) and (a.n <> nil) then begin - for i := 0 to sonsLen(f.n)-1 do begin - // check field names: - if f.n.sons[i].kind <> nkSym then InternalError(f.n.info, 'tupleRel'); - if a.n.sons[i].kind <> nkSym then InternalError(a.n.info, 'tupleRel'); - x := f.n.sons[i].sym; - y := a.n.sons[i].sym; - if x.name.id <> y.name.id then begin - result := isNone; exit - end - end - end - end -end; - -function typeRel(var mapping: TIdTable; f, a: PType): TTypeRelation; -var - x, concrete: PType; - i: Int; - m: TTypeRelation; -begin // is a subtype of f? - result := isNone; - assert(f <> nil); - assert(a <> nil); - if (a.kind = tyGenericInst) and not - (skipTypes(f, {@set}[tyVar]).kind in [tyGenericBody, tyGenericInvokation]) - then begin - result := typeRel(mapping, f, lastSon(a)); - exit - end; - if (a.kind = tyVar) and (f.kind <> tyVar) then begin - result := typeRel(mapping, f, a.sons[0]); - exit - end; - case f.kind of - tyEnum: begin - if (a.kind = f.kind) and (a.id = f.id) then result := isEqual - else if (skipTypes(a, {@set}[tyRange]).id = f.id) then result := isSubtype - end; - tyBool, tyChar: begin - if (a.kind = f.kind) then result := isEqual - else if skipTypes(a, {@set}[tyRange]).kind = f.kind then - result := isSubtype - end; - tyRange: begin - if (a.kind = f.kind) then begin - result := typeRel(mapping, base(a), base(f)); - if result < isGeneric then result := isNone - end - else if skipTypes(f, {@set}[tyRange]).kind = a.kind then - result := isConvertible // a convertible to f - end; - tyInt: result := handleRange(f, a, tyInt8, tyInt32); - tyInt8: result := handleRange(f, a, tyInt8, tyInt8); - tyInt16: result := handleRange(f, a, tyInt8, tyInt16); - tyInt32: result := handleRange(f, a, tyInt, tyInt32); - tyInt64: result := handleRange(f, a, tyInt, tyInt64); - tyFloat: result := handleFloatRange(f, a); - tyFloat32: result := handleFloatRange(f, a); - tyFloat64: result := handleFloatRange(f, a); - tyFloat128: result := handleFloatRange(f, a); - - tyVar: begin - if (a.kind = f.kind) then - result := typeRel(mapping, base(f), base(a)) - else - result := typeRel(mapping, base(f), a) - end; - tyArray, tyArrayConstr: begin // tyArrayConstr cannot happen really, but - // we wanna be safe here - case a.kind of - tyArray: begin - result := minRel(typeRel(mapping, f.sons[0], a.sons[0]), - typeRel(mapping, f.sons[1], a.sons[1])); - if result < isGeneric then result := isNone; - end; - tyArrayConstr: begin - result := typeRel(mapping, f.sons[1], a.sons[1]); - if result < isGeneric then - result := isNone - else begin - if (result <> isGeneric) and (lengthOrd(f) <> lengthOrd(a)) then - result := isNone - else if f.sons[0].kind in GenericTypes then - result := minRel(result, typeRel(mapping, f.sons[0], a.sons[0])); - end - end; - else begin end - end - end; - tyOpenArray: begin - case a.Kind of - tyOpenArray: begin - result := typeRel(mapping, base(f), base(a)); - if result < isGeneric then result := isNone - end; - tyArrayConstr: begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[1].kind = tyEmpty) then - result := isSubtype // [] is allowed here - else if typeRel(mapping, base(f), a.sons[1]) >= isGeneric then - result := isSubtype; - end; - tyArray: begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[1].kind = tyEmpty) then - result := isSubtype - else if typeRel(mapping, base(f), a.sons[1]) >= isGeneric then - result := isConvertible - end; - tySequence: begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[0].kind = tyEmpty) then - result := isConvertible - else if typeRel(mapping, base(f), a.sons[0]) >= isGeneric then - result := isConvertible; - end - else begin end - end - end; - tySequence: begin - case a.Kind of - tyNil: result := isSubtype; - tySequence: begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[0].kind = tyEmpty) then - result := isSubtype - else begin - result := typeRel(mapping, f.sons[0], a.sons[0]); - if result < isGeneric then result := isNone - end - end; - else begin end - end - end; - tyOrdinal: begin - if isOrdinalType(a) then begin - if a.kind = tyOrdinal then x := a.sons[0] else x := a; - result := typeRel(mapping, f.sons[0], x); - if result < isGeneric then result := isNone - end - end; - tyForward: InternalError('forward type in typeRel()'); - tyNil: begin - if a.kind = f.kind then result := isEqual - end; - tyTuple: begin - if a.kind = tyTuple then result := tupleRel(mapping, f, a); - end; - tyObject: begin - if a.kind = tyObject then begin - if a.id = f.id then result := isEqual - else if isObjectSubtype(a, f) then result := isSubtype - end - end; - tyDistinct: begin - if (a.kind = tyDistinct) and (a.id = f.id) then result := isEqual; - end; - tySet: begin - if a.kind = tySet then begin - if (f.sons[0].kind <> tyGenericParam) and - (a.sons[0].kind = tyEmpty) then - result := isSubtype - else begin - result := typeRel(mapping, f.sons[0], a.sons[0]); - if result <= isConvertible then result := isNone // BUGFIX! - end - end - end; - tyPtr: begin - case a.kind of - tyPtr: begin - result := typeRel(mapping, base(f), base(a)); - if result <= isConvertible then result := isNone - end; - tyNil: result := isSubtype - else begin end - end - end; - tyRef: begin - case a.kind of - tyRef: begin - result := typeRel(mapping, base(f), base(a)); - if result <= isConvertible then result := isNone - end; - tyNil: result := isSubtype - else begin end - end - end; - tyProc: begin - case a.kind of - tyNil: result := isSubtype; - tyProc: begin - if (sonsLen(f) = sonsLen(a)) and (f.callconv = a.callconv) then begin - // Note: We have to do unification for the parameters before the - // return type! - result := isEqual; // start with maximum; also correct for no - // params at all - for i := 1 to sonsLen(f)-1 do begin - m := typeRel(mapping, f.sons[i], a.sons[i]); - if (m = isNone) and (typeRel(mapping, a.sons[i], - f.sons[i]) = isSubtype) then begin - // allow ``f.son`` as subtype of ``a.son``! - result := isConvertible; - end - else if m < isSubtype then begin - result := isNone; exit - end - else result := minRel(m, result) - end; - if f.sons[0] <> nil then begin - if a.sons[0] <> nil then begin - m := typeRel(mapping, f.sons[0], a.sons[0]); - // Subtype is sufficient for return types! - if m < isSubtype then result := isNone - else if m = isSubtype then result := isConvertible - else result := minRel(m, result) - end - else - result := isNone - end - else if a.sons[0] <> nil then - result := isNone; - if (tfNoSideEffect in f.flags) and not (tfNoSideEffect in a.flags) then - result := isNone - end - end - else begin end - end - end; - tyPointer: begin - case a.kind of - tyPointer: result := isEqual; - tyNil: result := isSubtype; - tyRef, tyPtr, tyProc, tyCString: result := isConvertible; - else begin end - end - end; - tyString: begin - case a.kind of - tyString: result := isEqual; - tyNil: result := isSubtype; - else begin end - end - end; - tyCString: begin - // conversion from string to cstring is automatic: - case a.Kind of - tyCString: result := isEqual; - tyNil: result := isSubtype; - tyString: result := isConvertible; - tyPtr: if a.sons[0].kind = tyChar then result := isConvertible; - tyArray: begin - if (firstOrd(a.sons[0]) = 0) - and (skipTypes(a.sons[0], {@set}[tyRange]).kind in [tyInt..tyInt64]) - and (a.sons[1].kind = tyChar) then - result := isConvertible; - end - else begin end - end - end; - - tyEmpty: begin - if a.kind = tyEmpty then result := isEqual; - end; - tyGenericInst: begin - result := typeRel(mapping, lastSon(f), a); - end; (* - tyGenericBody: begin - x := PType(idTableGet(mapping, f)); - if x = nil then begin - assert(f.containerID <> 0); - if (a.kind = tyGenericInst) and (f.containerID = a.containerID) and - (sonsLen(a) = sonsLen(f)) then begin - for i := 0 to sonsLen(f)-2 do begin - if typeRel(mapping, f.sons[i], a.sons[i]) < isGeneric then exit; - end; - result := isGeneric; - idTablePut(mapping, f, a); - end - end - else begin - result := typeRel(mapping, x, a) // check if it fits - end - end; *) - tyGenericBody: begin - result := typeRel(mapping, lastSon(f), a); - end; - tyGenericInvokation: begin - assert(f.sons[0].kind = tyGenericBody); - if a.kind = tyGenericInvokation then begin - InternalError('typeRel: tyGenericInvokation -> tyGenericInvokation'); - end; - if (a.kind = tyGenericInst) then begin - if (f.sons[0].containerID = a.sons[0].containerID) - and (sonsLen(a)-1 = sonsLen(f)) then begin - assert(a.sons[0].kind = tyGenericBody); - for i := 1 to sonsLen(f)-1 do begin - if a.sons[i].kind = tyGenericParam then begin - InternalError('wrong instantiated type!'); - end; - if typeRel(mapping, f.sons[i], a.sons[i]) < isGeneric then exit; - end; - result := isGeneric; - end (* - else begin - MessageOut('came here: ' + toString(sonsLen(f)) + ' ' + - toString(sonsLen(a)) + ' '+ - toString(f.sons[0].containerID) + ' '+ - toString(a.sons[0].containerID)); - end *) - end - else begin - result := typeRel(mapping, f.sons[0], a); - if result <> isNone then begin - // we steal the generic parameters from the tyGenericBody: - for i := 1 to sonsLen(f)-1 do begin - x := PType(idTableGet(mapping, f.sons[0].sons[i-1])); - if (x = nil) or (x.kind = tyGenericParam) then - InternalError('wrong instantiated type!'); - idTablePut(mapping, f.sons[i], x); - end - end - end - end; - tyGenericParam: begin - x := PType(idTableGet(mapping, f)); - if x = nil then begin - if sonsLen(f) = 0 then begin // no constraints - concrete := concreteType(mapping, a); - if concrete <> nil then begin - //MessageOut('putting: ' + f.sym.name.s); - idTablePut(mapping, f, concrete); - result := isGeneric - end; - end - else begin - InternalError(f.sym.info, 'has constraints: ' + f.sym.name.s); - // check constraints: - for i := 0 to sonsLen(f)-1 do begin - if typeRel(mapping, f.sons[i], a) >= isSubtype then begin - concrete := concreteType(mapping, a); - if concrete <> nil then begin - idTablePut(mapping, f, concrete); - result := isGeneric - end; - break - end - end - end - end - else if a.kind = tyEmpty then - result := isGeneric - else if x.kind = tyGenericParam then - result := isGeneric - else - result := typeRel(mapping, x, a) // check if it fits - end; - tyExpr, tyStmt, tyTypeDesc: begin - if a.kind = f.kind then result := isEqual - else - case a.kind of - tyExpr, tyStmt, tyTypeDesc: result := isGeneric; - tyNil: result := isSubtype; - else begin end - end - end; - else internalError('typeRel(' +{&} typeKindToStr[f.kind] +{&} ')'); - end -end; - -function cmpTypes(f, a: PType): TTypeRelation; -var - mapping: TIdTable; -begin - InitIdTable(mapping); - result := typeRel(mapping, f, a); -end; - -function getInstantiatedType(c: PContext; arg: PNode; const m: TCandidate; - f: PType): PType; -begin - result := PType(idTableGet(m.bindings, f)); - if result = nil then begin - result := generateTypeInstance(c, m.bindings, arg, f); - end; - if result = nil then InternalError(arg.info, 'getInstantiatedType'); -end; - -function implicitConv(kind: TNodeKind; f: PType; arg: PNode; - const m: TCandidate; c: PContext): PNode; -begin - result := newNodeI(kind, arg.info); - if containsGenericType(f) then - result.typ := getInstantiatedType(c, arg, m, f) - else - result.typ := f; - if result.typ = nil then InternalError(arg.info, 'implicitConv'); - addSon(result, nil); - addSon(result, arg); -end; - -function userConvMatch(c: PContext; var m: TCandidate; f, a: PType; - arg: PNode): PNode; -var - i: int; - src, dest: PType; - s: PNode; -begin - result := nil; - for i := 0 to length(c.converters)-1 do begin - src := c.converters[i].typ.sons[1]; - dest := c.converters[i].typ.sons[0]; - if (typeRel(m.bindings, f, dest) = isEqual) and - (typeRel(m.bindings, src, a) = isEqual) then begin - s := newSymNode(c.converters[i]); - s.typ := c.converters[i].typ; - s.info := arg.info; - result := newNodeIT(nkHiddenCallConv, arg.info, s.typ.sons[0]); - addSon(result, s); - addSon(result, copyTree(arg)); - inc(m.convMatches); - exit - end - end -end; - -function ParamTypesMatchAux(c: PContext; var m: TCandidate; f, a: PType; - arg: PNode): PNode; -var - r: TTypeRelation; -begin - r := typeRel(m.bindings, f, a); - case r of - isConvertible: begin - inc(m.convMatches); - result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); - end; - isIntConv: begin - inc(m.intConvMatches); - result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); - end; - isSubtype: begin - inc(m.subtypeMatches); - result := implicitConv(nkHiddenSubConv, f, copyTree(arg), m, c); - end; - isGeneric: begin - inc(m.genericMatches); - result := copyTree(arg); - result.typ := getInstantiatedType(c, arg, m, f); - // BUG: f may not be the right key! - if (skipTypes(result.typ, abstractVar).kind in [tyTuple, tyOpenArray]) then - // BUGFIX: must pass length implicitely - result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); - // BUGFIX: use ``result.typ`` and not `f` here - end; - isEqual: begin - inc(m.exactMatches); - result := copyTree(arg); - if (skipTypes(f, abstractVar).kind in [tyTuple, tyOpenArray]) then - // BUGFIX: must pass length implicitely - result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); - end; - isNone: begin - result := userConvMatch(c, m, f, a, arg); - // check for a base type match, which supports openarray[T] without [] - // constructor in a call: - if (result = nil) and (f.kind = tyOpenArray) then begin - r := typeRel(m.bindings, base(f), a); - if r >= isGeneric then begin - inc(m.convMatches); - result := copyTree(arg); - if r = isGeneric then - result.typ := getInstantiatedType(c, arg, m, base(f)); - m.baseTypeMatch := true; - end - else - result := userConvMatch(c, m, base(f), a, arg); - end - end - end -end; - -function ParamTypesMatch(c: PContext; var m: TCandidate; f, a: PType; - arg: PNode): PNode; -var - i, cmp, best: int; - x, y, z: TCandidate; - r: TTypeRelation; -begin - if (arg = nil) or (arg.kind <> nkSymChoice) then begin - result := ParamTypesMatchAux(c, m, f, a, arg) - end - else begin - // CAUTION: The order depends on the used hashing scheme. Thus it is - // incorrect to simply use the first fitting match. However, to implement - // this correctly is inefficient. We have to copy `m` here to be able to - // roll back the side effects of the unification algorithm. - initCandidate(x, m.callee); - initCandidate(y, m.callee); - initCandidate(z, m.callee); - x.calleeSym := m.calleeSym; - y.calleeSym := m.calleeSym; - z.calleeSym := m.calleeSym; - best := -1; - for i := 0 to sonsLen(arg)-1 do begin - // iterators are not first class yet, so ignore them - if arg.sons[i].sym.kind in {@set}[skProc, skMethod, skConverter] then begin - copyCandidate(z, m); - r := typeRel(z.bindings, f, arg.sons[i].typ); - if r <> isNone then begin - case x.state of - csEmpty, csNoMatch: begin x := z; best := i; x.state := csMatch; end; - csMatch: begin - cmp := cmpCandidates(x, z); - if cmp < 0 then begin best := i; x := z end // z is better than x - else if cmp = 0 then y := z // z is as good as x - else begin end // z is worse than x - end - end - end - end - end; - if x.state = csEmpty then - result := nil - else if (y.state = csMatch) and (cmpCandidates(x, y) = 0) then begin - if x.state <> csMatch then InternalError(arg.info, 'x.state is not csMatch'); - // ambiguous: more than one symbol fits - result := nil - end - else begin - // only one valid interpretation found: - markUsed(arg, arg.sons[best].sym); - result := ParamTypesMatchAux(c, m, f, arg.sons[best].typ, arg.sons[best]); - end - end -end; - -function IndexTypesMatch(c: PContext; f, a: PType; arg: PNode): PNode; -var - m: TCandidate; -begin - initCandidate(m, f); - result := paramTypesMatch(c, m, f, a, arg) -end; - -procedure setSon(father: PNode; at: int; son: PNode); -begin - if sonsLen(father) <= at then - setLength(father.sons, at+1); - father.sons[at] := son; -end; - -procedure matches(c: PContext; n: PNode; var m: TCandidate); -var - f: int; // iterates over formal parameters - a: int; // iterates over the actual given arguments - formalLen: int; - marker: TIntSet; - container, arg: PNode; // constructed container - formal: PSym; -begin - f := 1; - a := 1; - m.state := csMatch; // until proven otherwise - m.call := newNodeI(nkCall, n.info); - m.call.typ := base(m.callee); // may be nil - formalLen := sonsLen(m.callee.n); - addSon(m.call, copyTree(n.sons[0])); - IntSetInit(marker); - container := nil; - formal := nil; - while a < sonsLen(n) do begin - if n.sons[a].kind = nkExprEqExpr then begin - // named param - // check if m.callee has such a param: - if n.sons[a].sons[0].kind <> nkIdent then begin - liMessage(n.sons[a].info, errNamedParamHasToBeIdent); - m.state := csNoMatch; - exit - end; - formal := getSymFromList(m.callee.n, n.sons[a].sons[0].ident, 1); - if formal = nil then begin - // no error message! - m.state := csNoMatch; - exit; - end; - if IntSetContainsOrIncl(marker, formal.position) then begin - // already in namedParams: - liMessage(n.sons[a].info, errCannotBindXTwice, formal.name.s); - m.state := csNoMatch; - exit - end; - m.baseTypeMatch := false; - arg := ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, - n.sons[a].sons[1]); - if (arg = nil) then begin m.state := csNoMatch; exit end; - if m.baseTypeMatch then begin - assert(container = nil); - container := newNodeI(nkBracket, n.sons[a].info); - addSon(container, arg); - setSon(m.call, formal.position+1, container); - if f <> formalLen-1 then container := nil; - end - else begin - setSon(m.call, formal.position+1, arg); - end - end - else begin - // unnamed param - if f >= formalLen then begin // too many arguments? - if tfVarArgs in m.callee.flags then begin - // is ok... but don't increment any counters... - if skipTypes(n.sons[a].typ, abstractVar).kind = tyString then - // conversion to cstring - addSon(m.call, implicitConv(nkHiddenStdConv, - getSysType(tyCString), copyTree(n.sons[a]), m, c)) - else - addSon(m.call, copyTree(n.sons[a])); - end - else if formal <> nil then begin - m.baseTypeMatch := false; - arg := ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, n.sons[a]); - if (arg <> nil) and m.baseTypeMatch and (container <> nil) then begin - addSon(container, arg); - end - else begin - m.state := csNoMatch; - exit - end; - end - else begin - m.state := csNoMatch; - exit - end - end - else begin - if m.callee.n.sons[f].kind <> nkSym then - InternalError(n.sons[a].info, 'matches'); - formal := m.callee.n.sons[f].sym; - if IntSetContainsOrIncl(marker, formal.position) then begin - // already in namedParams: - liMessage(n.sons[a].info, errCannotBindXTwice, formal.name.s); - m.state := csNoMatch; - exit - end; - m.baseTypeMatch := false; - arg := ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, n.sons[a]); - if (arg = nil) then begin m.state := csNoMatch; exit end; - if m.baseTypeMatch then begin - assert(container = nil); - container := newNodeI(nkBracket, n.sons[a].info); - addSon(container, arg); - setSon(m.call, formal.position+1, - implicitConv(nkHiddenStdConv, formal.typ, container, m, c)); - if f <> formalLen-1 then container := nil; - end - else begin - setSon(m.call, formal.position+1, arg); - end - end - end; - inc(a); - inc(f); - end; - // iterate over all formal params and check all are provided: - f := 1; - while f < sonsLen(m.callee.n) do begin - formal := m.callee.n.sons[f].sym; - if not IntSetContainsOrIncl(marker, formal.position) then begin - if formal.ast = nil then begin // no default value - m.state := csNoMatch; break - end - else begin - // use default value: - setSon(m.call, formal.position+1, copyTree(formal.ast)); - end - end; - inc(f); - end -end; - -function sameMethodDispatcher(a, b: PSym): bool; -var - aa, bb: PNode; -begin - result := false; - if (a.kind = skMethod) and (b.kind = skMethod) then begin - aa := lastSon(a.ast); - bb := lastSon(b.ast); - if (aa.kind = nkSym) and (bb.kind = nkSym) and - (aa.sym = bb.sym) then result := true - end -end; - -function semDirectCall(c: PContext; n: PNode; filter: TSymKinds): PNode; -var - sym: PSym; - o: TOverloadIter; - x, y, z: TCandidate; - cmp: int; -begin - //liMessage(n.info, warnUser, renderTree(n)); - sym := initOverloadIter(o, c, n.sons[0]); - result := nil; - if sym = nil then exit; - initCandidate(x, sym.typ); - x.calleeSym := sym; - initCandidate(y, sym.typ); - y.calleeSym := sym; - while sym <> nil do begin - if sym.kind in filter then begin - initCandidate(z, sym.typ); - z.calleeSym := sym; - matches(c, n, z); - if z.state = csMatch then begin - case x.state of - csEmpty, csNoMatch: x := z; - csMatch: begin - cmp := cmpCandidates(x, z); - if cmp < 0 then x := z // z is better than x - else if cmp = 0 then y := z // z is as good as x - else begin end // z is worse than x - end - end - end - end; - sym := nextOverloadIter(o, c, n.sons[0]) - end; - if x.state = csEmpty then begin - // no overloaded proc found - // do not generate an error yet; the semantic checking will check for - // an overloaded () operator - end - else if (y.state = csMatch) and (cmpCandidates(x, y) = 0) - and not sameMethodDispatcher(x.calleeSym, y.calleeSym) then begin - if x.state <> csMatch then - InternalError(n.info, 'x.state is not csMatch'); - //writeMatches(x); - //writeMatches(y); - liMessage(n.Info, errGenerated, - format(msgKindToString(errAmbiguousCallXYZ), - [getProcHeader(x.calleeSym), - getProcHeader(y.calleeSym), x.calleeSym.Name.s])) - end - else begin - // only one valid interpretation found: - markUsed(n, x.calleeSym); - if x.calleeSym.ast = nil then - internalError(n.info, 'calleeSym.ast is nil'); // XXX: remove this check! - if x.calleeSym.ast.sons[genericParamsPos] <> nil then begin - // a generic proc! - x.calleeSym := generateInstance(c, x.calleeSym, x.bindings, n.info); - x.callee := x.calleeSym.typ; - end; - result := x.call; - result.sons[0] := newSymNode(x.calleeSym); - result.typ := x.callee.sons[0]; - end -end; -- cgit 1.4.1-2-gfad0