mirror of
https://github.com/nim-lang/Nim.git
synced 2025-12-29 17:34:43 +00:00
875 lines
26 KiB
ObjectPascal
Executable File
875 lines
26 KiB
ObjectPascal
Executable File
//
|
|
//
|
|
// 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 semantic checking of type declarations
|
|
|
|
function fitNode(c: PContext; formal: PType; arg: PNode): PNode;
|
|
begin
|
|
result := IndexTypesMatch(c, formal, arg.typ, arg);
|
|
if result = nil then typeMismatch(arg, formal, arg.typ);
|
|
end;
|
|
|
|
function newOrPrevType(kind: TTypeKind; prev: PType; c: PContext): PType;
|
|
begin
|
|
if prev = nil then
|
|
result := newTypeS(kind, c)
|
|
else begin
|
|
result := prev;
|
|
if result.kind = tyForward then result.kind := kind
|
|
end
|
|
end;
|
|
|
|
function semEnum(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
i: int;
|
|
counter, x: BiggestInt;
|
|
e: PSym;
|
|
base: PType;
|
|
v: PNode;
|
|
begin
|
|
counter := 0;
|
|
base := nil;
|
|
result := newOrPrevType(tyEnum, prev, c);
|
|
result.n := newNodeI(nkEnumTy, n.info);
|
|
checkMinSonsLen(n, 1);
|
|
if n.sons[0] <> nil then begin
|
|
base := semTypeNode(c, n.sons[0].sons[0], nil);
|
|
if base.kind <> tyEnum then
|
|
liMessage(n.sons[0].info, errInheritanceOnlyWithEnums);
|
|
counter := lastOrd(base)+1;
|
|
end;
|
|
addSon(result, base);
|
|
for i := 1 to sonsLen(n)-1 do begin
|
|
case n.sons[i].kind of
|
|
nkEnumFieldDef: begin
|
|
e := newSymS(skEnumField, n.sons[i].sons[0], c);
|
|
v := semConstExpr(c, n.sons[i].sons[1]);
|
|
x := getOrdValue(v);
|
|
if i <> 1 then begin
|
|
if (x <> counter) then
|
|
include(result.flags, tfEnumHasWholes);
|
|
if x < counter then
|
|
liMessage(n.sons[i].info, errInvalidOrderInEnumX, e.name.s);
|
|
end;
|
|
counter := x;
|
|
end;
|
|
nkSym: e := n.sons[i].sym;
|
|
nkIdent: begin
|
|
e := newSymS(skEnumField, n.sons[i], c);
|
|
end;
|
|
else
|
|
illFormedAst(n);
|
|
end;
|
|
e.typ := result;
|
|
e.position := int(counter);
|
|
if (result.sym <> nil) and (sfInInterface in result.sym.flags) then begin
|
|
include(e.flags, sfUsed); // BUGFIX
|
|
include(e.flags, sfInInterface); // BUGFIX
|
|
StrTableAdd(c.module.tab, e); // BUGFIX
|
|
end;
|
|
addSon(result.n, newSymNode(e));
|
|
addDeclAt(c, e, c.tab.tos-1);
|
|
inc(counter);
|
|
end;
|
|
end;
|
|
|
|
function semSet(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
base: PType;
|
|
begin
|
|
result := newOrPrevType(tySet, prev, c);
|
|
if sonsLen(n) = 2 then begin
|
|
base := semTypeNode(c, n.sons[1], nil);
|
|
addSon(result, base);
|
|
if base.kind = tyGenericInst then base := lastSon(base);
|
|
if base.kind <> tyGenericParam then begin
|
|
if not isOrdinalType(base) then liMessage(n.info, errOrdinalTypeExpected);
|
|
if lengthOrd(base) > MaxSetElements then liMessage(n.info, errSetTooBig);
|
|
end
|
|
end
|
|
else
|
|
liMessage(n.info, errXExpectsOneTypeParam, 'set');
|
|
end;
|
|
|
|
function semContainer(c: PContext; n: PNode;
|
|
kind: TTypeKind; const kindStr: string;
|
|
prev: PType): PType;
|
|
var
|
|
base: PType;
|
|
begin
|
|
result := newOrPrevType(kind, prev, c);
|
|
if sonsLen(n) = 2 then begin
|
|
base := semTypeNode(c, n.sons[1], nil);
|
|
addSon(result, base);
|
|
end
|
|
else
|
|
liMessage(n.info, errXExpectsOneTypeParam, kindStr);
|
|
end;
|
|
|
|
function semAnyRef(c: PContext; n: PNode;
|
|
kind: TTypeKind; const kindStr: string; prev: PType): PType;
|
|
var
|
|
base: PType;
|
|
begin
|
|
result := newOrPrevType(kind, prev, c);
|
|
if sonsLen(n) = 1 then begin
|
|
base := semTypeNode(c, n.sons[0], nil);
|
|
addSon(result, base);
|
|
end
|
|
else
|
|
liMessage(n.info, errXExpectsOneTypeParam, kindStr);
|
|
end;
|
|
|
|
function semVarType(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
base: PType;
|
|
begin
|
|
result := newOrPrevType(tyVar, prev, c);
|
|
if sonsLen(n) = 1 then begin
|
|
base := semTypeNode(c, n.sons[0], nil);
|
|
if base.kind = tyVar then liMessage(n.info, errVarVarTypeNotAllowed);
|
|
addSon(result, base);
|
|
end
|
|
else
|
|
liMessage(n.info, errXExpectsOneTypeParam, 'var');
|
|
end;
|
|
|
|
function semDistinct(c: PContext; n: PNode; prev: PType): PType;
|
|
begin
|
|
result := newOrPrevType(tyDistinct, prev, c);
|
|
if sonsLen(n) = 1 then
|
|
addSon(result, semTypeNode(c, n.sons[0], nil))
|
|
else
|
|
liMessage(n.info, errXExpectsOneTypeParam, 'distinct');
|
|
end;
|
|
|
|
function semRangeAux(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
a, b: PNode;
|
|
begin
|
|
if (n.kind <> nkRange) then InternalError(n.info, 'semRangeAux');
|
|
checkSonsLen(n, 2);
|
|
result := newOrPrevType(tyRange, prev, c);
|
|
result.n := newNodeI(nkRange, n.info);
|
|
if (n.sons[0] = nil) or (n.sons[1] = nil) then
|
|
liMessage(n.Info, errRangeIsEmpty);
|
|
a := semConstExpr(c, n.sons[0]);
|
|
b := semConstExpr(c, n.sons[1]);
|
|
if not sameType(a.typ, b.typ) then
|
|
liMessage(n.info, errPureTypeMismatch);
|
|
if not (a.typ.kind in [tyInt..tyInt64, tyEnum, tyBool, tyChar,
|
|
tyFloat..tyFloat128]) then
|
|
liMessage(n.info, errOrdinalTypeExpected);
|
|
if enumHasWholes(a.typ) then
|
|
liMessage(n.info, errEnumXHasWholes, a.typ.sym.name.s);
|
|
if not leValue(a, b) then
|
|
liMessage(n.Info, errRangeIsEmpty);
|
|
addSon(result.n, a);
|
|
addSon(result.n, b);
|
|
addSon(result, b.typ);
|
|
end;
|
|
|
|
function semRange(c: PContext; n: PNode; prev: PType): PType;
|
|
begin
|
|
result := nil;
|
|
if sonsLen(n) = 2 then begin
|
|
if n.sons[1].kind = nkRange then
|
|
result := semRangeAux(c, n.sons[1], prev)
|
|
else
|
|
liMessage(n.sons[0].info, errRangeExpected);
|
|
end
|
|
else
|
|
liMessage(n.info, errXExpectsOneTypeParam, 'range');
|
|
end;
|
|
|
|
function semArray(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
indx, base: PType;
|
|
begin
|
|
result := newOrPrevType(tyArray, prev, c);
|
|
if sonsLen(n) = 3 then begin // 3 = length(array indx base)
|
|
if n.sons[1].kind = nkRange then indx := semRangeAux(c, n.sons[1], nil)
|
|
else indx := semTypeNode(c, n.sons[1], nil);
|
|
addSon(result, indx);
|
|
if indx.kind = tyGenericInst then indx := lastSon(indx);
|
|
if indx.kind <> tyGenericParam then begin
|
|
if not isOrdinalType(indx) then
|
|
liMessage(n.sons[1].info, errOrdinalTypeExpected);
|
|
if enumHasWholes(indx) then
|
|
liMessage(n.sons[1].info, errEnumXHasWholes, indx.sym.name.s);
|
|
end;
|
|
base := semTypeNode(c, n.sons[2], nil);
|
|
addSon(result, base);
|
|
end
|
|
else
|
|
liMessage(n.info, errArrayExpectsTwoTypeParams);
|
|
end;
|
|
|
|
function semOrdinal(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
base: PType;
|
|
begin
|
|
result := newOrPrevType(tyOrdinal, prev, c);
|
|
if sonsLen(n) = 2 then begin
|
|
base := semTypeNode(c, n.sons[1], nil);
|
|
if base.kind <> tyGenericParam then begin
|
|
if not isOrdinalType(base) then
|
|
liMessage(n.sons[1].info, errOrdinalTypeExpected);
|
|
end;
|
|
addSon(result, base);
|
|
end
|
|
else
|
|
liMessage(n.info, errXExpectsOneTypeParam, 'ordinal');
|
|
end;
|
|
|
|
function semTypeIdent(c: PContext; n: PNode): PSym;
|
|
begin
|
|
result := qualifiedLookup(c, n, true);
|
|
if (result <> nil) then begin
|
|
markUsed(n, result);
|
|
if result.kind <> skType then liMessage(n.info, errTypeExpected);
|
|
end
|
|
else
|
|
liMessage(n.info, errIdentifierExpected);
|
|
end;
|
|
|
|
function semTuple(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
i, j, len, counter: int;
|
|
typ: PType;
|
|
check: TIntSet;
|
|
a: PNode;
|
|
field: PSym;
|
|
begin
|
|
result := newOrPrevType(tyTuple, prev, c);
|
|
result.n := newNodeI(nkRecList, n.info);
|
|
IntSetInit(check);
|
|
counter := 0;
|
|
for i := 0 to sonsLen(n)-1 do begin
|
|
a := n.sons[i];
|
|
if (a.kind <> nkIdentDefs) then IllFormedAst(a);
|
|
checkMinSonsLen(a, 3);
|
|
len := sonsLen(a);
|
|
if a.sons[len-2] <> nil then
|
|
typ := semTypeNode(c, a.sons[len-2], nil)
|
|
else
|
|
liMessage(a.info, errTypeExpected);
|
|
if a.sons[len-1] <> nil then
|
|
liMessage(a.sons[len-1].info, errInitHereNotAllowed);
|
|
for j := 0 to len-3 do begin
|
|
field := newSymS(skField, a.sons[j], c);
|
|
field.typ := typ;
|
|
field.position := counter;
|
|
inc(counter);
|
|
if IntSetContainsOrIncl(check, field.name.id) then
|
|
liMessage(a.sons[j].info, errAttemptToRedefine, field.name.s);
|
|
addSon(result.n, newSymNode(field));
|
|
addSon(result, typ);
|
|
end
|
|
end
|
|
end;
|
|
|
|
function semGeneric(c: PContext; n: PNode; s: PSym; prev: PType): PType;
|
|
var
|
|
i: int;
|
|
elem: PType;
|
|
isConcrete: bool;
|
|
begin
|
|
if (s.typ = nil) or (s.typ.kind <> tyGenericBody) then
|
|
liMessage(n.info, errCannotInstantiateX, s.name.s);
|
|
result := newOrPrevType(tyGenericInvokation, prev, c);
|
|
if (s.typ.containerID = 0) then InternalError(n.info, 'semtypes.semGeneric');
|
|
if sonsLen(n) <> sonsLen(s.typ) then
|
|
liMessage(n.info, errWrongNumberOfArguments);
|
|
addSon(result, s.typ);
|
|
isConcrete := true;
|
|
// iterate over arguments:
|
|
for i := 1 to sonsLen(n)-1 do begin
|
|
elem := semTypeNode(c, n.sons[i], nil);
|
|
if elem.kind = tyGenericParam then isConcrete := false;
|
|
addSon(result, elem);
|
|
end;
|
|
if isConcrete then begin
|
|
if s.ast = nil then liMessage(n.info, errCannotInstantiateX, s.name.s);
|
|
result := instGenericContainer(c, n, result);
|
|
end
|
|
end;
|
|
|
|
function semIdentVis(c: PContext; kind: TSymKind; n: PNode;
|
|
const allowed: TSymFlags): PSym;
|
|
// identifier with visibility
|
|
var
|
|
v: PIdent;
|
|
begin
|
|
result := nil;
|
|
if n.kind = nkPostfix then begin
|
|
if (sonsLen(n) = 2) and (n.sons[0].kind = nkIdent) then begin
|
|
result := newSymS(kind, n.sons[1], c);
|
|
v := n.sons[0].ident;
|
|
if (sfStar in allowed) and (v.id = ord(wStar)) then
|
|
include(result.flags, sfStar)
|
|
else if (sfMinus in allowed) and (v.id = ord(wMinus)) then
|
|
include(result.flags, sfMinus)
|
|
else
|
|
liMessage(n.sons[0].info, errInvalidVisibilityX, v.s);
|
|
end
|
|
else
|
|
illFormedAst(n);
|
|
end
|
|
else
|
|
result := newSymS(kind, n, c);
|
|
end;
|
|
|
|
function semIdentWithPragma(c: PContext; kind: TSymKind;
|
|
n: PNode; const allowed: TSymFlags): PSym;
|
|
begin
|
|
if n.kind = nkPragmaExpr then begin
|
|
checkSonsLen(n, 2);
|
|
result := semIdentVis(c, kind, n.sons[0], allowed);
|
|
case kind of
|
|
skType: begin
|
|
// process pragmas later, because result.typ has not been set yet
|
|
end;
|
|
skField: pragma(c, result, n.sons[1], fieldPragmas);
|
|
skVar: pragma(c, result, n.sons[1], varPragmas);
|
|
skConst: pragma(c, result, n.sons[1], constPragmas);
|
|
else begin end
|
|
end
|
|
end
|
|
else
|
|
result := semIdentVis(c, kind, n, allowed);
|
|
end;
|
|
|
|
procedure checkForOverlap(c: PContext; t, ex: PNode; branchIndex: int);
|
|
var
|
|
j, i: int;
|
|
begin
|
|
for i := 1 to branchIndex-1 do
|
|
for j := 0 to sonsLen(t.sons[i])-2 do
|
|
if overlap(t.sons[i].sons[j], ex) then begin
|
|
//MessageOut(renderTree(t));
|
|
liMessage(ex.info, errDuplicateCaseLabel);
|
|
end
|
|
end;
|
|
|
|
procedure semBranchExpr(c: PContext; t: PNode; var ex: PNode);
|
|
begin
|
|
ex := semConstExpr(c, ex);
|
|
checkMinSonsLen(t, 1);
|
|
if (cmpTypes(t.sons[0].typ, ex.typ) <= isConvertible) then begin
|
|
typeMismatch(ex, t.sons[0].typ, ex.typ);
|
|
end;
|
|
end;
|
|
|
|
procedure SemCaseBranch(c: PContext; t, branch: PNode;
|
|
branchIndex: int; var covered: biggestInt);
|
|
var
|
|
i: int;
|
|
b: PNode;
|
|
begin
|
|
for i := 0 to sonsLen(branch)-2 do begin
|
|
b := branch.sons[i];
|
|
if b.kind = nkRange then begin
|
|
checkSonsLen(b, 2);
|
|
semBranchExpr(c, t, b.sons[0]);
|
|
semBranchExpr(c, t, b.sons[1]);
|
|
if emptyRange(b.sons[0], b.sons[1]) then begin
|
|
//MessageOut(renderTree(t));
|
|
liMessage(b.info, errRangeIsEmpty);
|
|
end;
|
|
covered := covered + getOrdValue(b.sons[1]) - getOrdValue(b.sons[0]) + 1;
|
|
end
|
|
else begin
|
|
semBranchExpr(c, t, branch.sons[i]); // NOT: `b`, because of var-param!
|
|
inc(covered);
|
|
end;
|
|
checkForOverlap(c, t, branch.sons[i], branchIndex)
|
|
end
|
|
end;
|
|
|
|
procedure semRecordNodeAux(c: PContext; n: PNode;
|
|
var check: TIntSet;
|
|
var pos: int; father: PNode;
|
|
rectype: PSym); forward;
|
|
|
|
procedure semRecordCase(c: PContext; n: PNode;
|
|
var check: TIntSet;
|
|
var pos: int; father: PNode; rectype: PSym);
|
|
var
|
|
i: int;
|
|
covered: biggestint;
|
|
chckCovered: boolean;
|
|
a, b: PNode;
|
|
typ: PType;
|
|
begin
|
|
a := copyNode(n);
|
|
checkMinSonsLen(n, 2);
|
|
semRecordNodeAux(c, n.sons[0], check, pos, a, rectype);
|
|
if a.sons[0].kind <> nkSym then
|
|
internalError('semRecordCase: dicriminant is no symbol');
|
|
include(a.sons[0].sym.flags, sfDiscriminant);
|
|
covered := 0;
|
|
typ := skipTypes(a.sons[0].Typ, abstractVar);
|
|
if not isOrdinalType(typ) then
|
|
liMessage(n.info, errSelectorMustBeOrdinal);
|
|
if firstOrd(typ) < 0 then
|
|
liMessage(n.info, errOrdXMustNotBeNegative, a.sons[0].sym.name.s);
|
|
if lengthOrd(typ) > $7fff then
|
|
liMessage(n.info, errLenXinvalid, a.sons[0].sym.name.s);
|
|
chckCovered := true;
|
|
for i := 1 to sonsLen(n)-1 do begin
|
|
b := copyTree(n.sons[i]);
|
|
case n.sons[i].kind of
|
|
nkOfBranch: begin
|
|
checkMinSonsLen(b, 2);
|
|
semCaseBranch(c, a, b, i, covered);
|
|
end;
|
|
nkElse: begin
|
|
chckCovered := false;
|
|
checkSonsLen(b, 1);
|
|
end;
|
|
else illFormedAst(n);
|
|
end;
|
|
delSon(b, sonsLen(b)-1);
|
|
semRecordNodeAux(c, lastSon(n.sons[i]), check, pos, b, rectype);
|
|
addSon(a, b);
|
|
end;
|
|
if chckCovered and (covered <> lengthOrd(a.sons[0].typ)) then
|
|
liMessage(a.info, errNotAllCasesCovered);
|
|
addSon(father, a);
|
|
end;
|
|
|
|
procedure semRecordNodeAux(c: PContext; n: PNode; var check: TIntSet;
|
|
var pos: int; father: PNode; rectype: PSym);
|
|
var
|
|
i, len: int;
|
|
f: PSym; // new field
|
|
a, it, e, branch: PNode;
|
|
typ: PType;
|
|
begin
|
|
if n = nil then exit; // BUGFIX: nil is possible
|
|
case n.kind of
|
|
nkRecWhen: begin
|
|
branch := nil; // the branch to take
|
|
for i := 0 to sonsLen(n)-1 do begin
|
|
it := n.sons[i];
|
|
if it = nil then illFormedAst(n);
|
|
case it.kind of
|
|
nkElifBranch: begin
|
|
checkSonsLen(it, 2);
|
|
e := semConstExpr(c, it.sons[0]);
|
|
checkBool(e);
|
|
if (e.kind <> nkIntLit) then
|
|
InternalError(e.info, 'semRecordNodeAux');
|
|
if (e.intVal <> 0) and (branch = nil) then
|
|
branch := it.sons[1]
|
|
end;
|
|
nkElse: begin
|
|
checkSonsLen(it, 1);
|
|
if branch = nil then branch := it.sons[0];
|
|
end;
|
|
else illFormedAst(n)
|
|
end
|
|
end;
|
|
if branch <> nil then
|
|
semRecordNodeAux(c, branch, check, pos, father, rectype);
|
|
end;
|
|
nkRecCase: begin
|
|
semRecordCase(c, n, check, pos, father, rectype);
|
|
end;
|
|
nkNilLit: begin
|
|
if father.kind <> nkRecList then
|
|
addSon(father, newNodeI(nkRecList, n.info));
|
|
end;
|
|
nkRecList: begin
|
|
// attempt to keep the nesting at a sane level:
|
|
if father.kind = nkRecList then a := father
|
|
else a := copyNode(n);
|
|
for i := 0 to sonsLen(n)-1 do begin
|
|
semRecordNodeAux(c, n.sons[i], check, pos, a, rectype);
|
|
end;
|
|
if a <> father then addSon(father, a);
|
|
end;
|
|
nkIdentDefs: begin
|
|
checkMinSonsLen(n, 3);
|
|
len := sonsLen(n);
|
|
if (father.kind <> nkRecList) and (len >= 4) then
|
|
a := newNodeI(nkRecList, n.info)
|
|
else
|
|
a := nil;
|
|
if n.sons[len-1] <> nil then
|
|
liMessage(n.sons[len-1].info, errInitHereNotAllowed);
|
|
if n.sons[len-2] = nil then
|
|
liMessage(n.info, errTypeExpected);
|
|
typ := semTypeNode(c, n.sons[len-2], nil);
|
|
for i := 0 to sonsLen(n)-3 do begin
|
|
f := semIdentWithPragma(c, skField, n.sons[i], {@set}[sfStar, sfMinus]);
|
|
f.typ := typ;
|
|
f.position := pos;
|
|
if (rectype <> nil)
|
|
and ([sfImportc, sfExportc] * rectype.flags <> [])
|
|
and (f.loc.r = nil) then begin
|
|
f.loc.r := toRope(f.name.s);
|
|
f.flags := f.flags + ([sfImportc, sfExportc] * rectype.flags);
|
|
end;
|
|
inc(pos);
|
|
if IntSetContainsOrIncl(check, f.name.id) then
|
|
liMessage(n.sons[i].info, errAttemptToRedefine, f.name.s);
|
|
if a = nil then addSon(father, newSymNode(f))
|
|
else addSon(a, newSymNode(f))
|
|
end;
|
|
if a <> nil then addSon(father, a);
|
|
end;
|
|
else illFormedAst(n);
|
|
end
|
|
end;
|
|
|
|
procedure addInheritedFieldsAux(c: PContext; var check: TIntSet;
|
|
var pos: int; n: PNode);
|
|
var
|
|
i: int;
|
|
begin
|
|
case n.kind of
|
|
nkRecCase: begin
|
|
if (n.sons[0].kind <> nkSym) then
|
|
InternalError(n.info, 'addInheritedFieldsAux');
|
|
addInheritedFieldsAux(c, check, pos, n.sons[0]);
|
|
for i := 1 to sonsLen(n)-1 do begin
|
|
case n.sons[i].kind of
|
|
nkOfBranch, nkElse: begin
|
|
addInheritedFieldsAux(c, check, pos, lastSon(n.sons[i]));
|
|
end;
|
|
else internalError(n.info,
|
|
'addInheritedFieldsAux(record case branch)');
|
|
end
|
|
end;
|
|
end;
|
|
nkRecList: begin
|
|
for i := 0 to sonsLen(n)-1 do begin
|
|
addInheritedFieldsAux(c, check, pos, n.sons[i]);
|
|
end;
|
|
end;
|
|
nkSym: begin
|
|
IntSetIncl(check, n.sym.name.id);
|
|
inc(pos);
|
|
end;
|
|
else
|
|
InternalError(n.info, 'addInheritedFieldsAux()');
|
|
end;
|
|
end;
|
|
|
|
procedure addInheritedFields(c: PContext; var check: TIntSet; var pos: int;
|
|
obj: PType);
|
|
begin
|
|
if (sonsLen(obj) > 0) and (obj.sons[0] <> nil) then
|
|
addInheritedFields(c, check, pos, obj.sons[0]);
|
|
addInheritedFieldsAux(c, check, pos, obj.n);
|
|
end;
|
|
|
|
function semObjectNode(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
check: TIntSet;
|
|
base: PType;
|
|
pos: int;
|
|
begin
|
|
IntSetInit(check);
|
|
pos := 0;
|
|
// n.sons[0] contains the pragmas (if any). We process these later...
|
|
checkSonsLen(n, 3);
|
|
if n.sons[1] <> nil then begin
|
|
base := semTypeNode(c, n.sons[1].sons[0], nil);
|
|
if base.kind = tyObject then
|
|
addInheritedFields(c, check, pos, base)
|
|
else
|
|
liMessage(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects);
|
|
end
|
|
else
|
|
base := nil;
|
|
if n.kind <> nkObjectTy then InternalError(n.info, 'semObjectNode');
|
|
result := newOrPrevType(tyObject, prev, c);
|
|
addSon(result, base);
|
|
result.n := newNodeI(nkRecList, n.info);
|
|
semRecordNodeAux(c, n.sons[2], check, pos, result.n, result.sym);
|
|
if (base <> nil) and (tfFinal in base.flags) then
|
|
liMessage(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects);
|
|
end;
|
|
|
|
function addTypeVarsOfGenericBody(c: PContext; t: PType; genericParams: PNode;
|
|
var cl: TIntSet): PType;
|
|
var
|
|
i, L: int;
|
|
s: PSym;
|
|
begin
|
|
result := t;
|
|
if (t = nil) then exit;
|
|
if IntSetContainsOrIncl(cl, t.id) then exit;
|
|
case t.kind of
|
|
tyGenericBody: begin
|
|
result := newTypeS(tyGenericInvokation, c);
|
|
addSon(result, t);
|
|
for i := 0 to sonsLen(t)-2 do begin
|
|
if t.sons[i].kind <> tyGenericParam then
|
|
InternalError('addTypeVarsOfGenericBody');
|
|
s := copySym(t.sons[i].sym);
|
|
s.position := sonsLen(genericParams);
|
|
addDecl(c, s);
|
|
addSon(genericParams, newSymNode(s));
|
|
addSon(result, t.sons[i]);
|
|
end;
|
|
end;
|
|
tyGenericInst: begin
|
|
L := sonsLen(t)-1;
|
|
t.sons[L] := addTypeVarsOfGenericBody(c, t.sons[L], genericParams, cl);
|
|
end;
|
|
tyGenericInvokation: begin
|
|
for i := 1 to sonsLen(t)-1 do
|
|
t.sons[i] := addTypeVarsOfGenericBody(c, t.sons[i], genericParams, cl);
|
|
end
|
|
else begin
|
|
for i := 0 to sonsLen(t)-1 do
|
|
t.sons[i] := addTypeVarsOfGenericBody(c, t.sons[i], genericParams, cl);
|
|
end
|
|
end
|
|
end;
|
|
|
|
function paramType(c: PContext; n, genericParams: PNode;
|
|
var cl: TIntSet): PType;
|
|
begin
|
|
result := semTypeNode(c, n, nil);
|
|
if (genericParams <> nil) and (sonsLen(genericParams) = 0) then
|
|
result := addTypeVarsOfGenericBody(c, result, genericParams, cl);
|
|
end;
|
|
|
|
function semProcTypeNode(c: PContext; n, genericParams: PNode;
|
|
prev: PType): PType;
|
|
var
|
|
i, j, len, counter: int;
|
|
a, def, res: PNode;
|
|
typ: PType;
|
|
arg: PSym;
|
|
check, cl: TIntSet;
|
|
begin
|
|
checkMinSonsLen(n, 1);
|
|
result := newOrPrevType(tyProc, prev, c);
|
|
result.callConv := lastOptionEntry(c).defaultCC;
|
|
result.n := newNodeI(nkFormalParams, n.info);
|
|
if (genericParams <> nil) and (sonsLen(genericParams) = 0) then
|
|
IntSetInit(cl);
|
|
if n.sons[0] = nil then begin
|
|
addSon(result, nil); // return type
|
|
addSon(result.n, newNodeI(nkType, n.info)); // BUGFIX: nkType must exist!
|
|
// XXX but it does not, if n.sons[paramsPos] == nil?
|
|
end
|
|
else begin
|
|
addSon(result, nil);
|
|
res := newNodeI(nkType, n.info);
|
|
addSon(result.n, res);
|
|
end;
|
|
IntSetInit(check);
|
|
counter := 0;
|
|
for i := 1 to sonsLen(n)-1 do begin
|
|
a := n.sons[i];
|
|
if (a.kind <> nkIdentDefs) then IllFormedAst(a);
|
|
checkMinSonsLen(a, 3);
|
|
len := sonsLen(a);
|
|
if a.sons[len-2] <> nil then
|
|
typ := paramType(c, a.sons[len-2], genericParams, cl)
|
|
else
|
|
typ := nil;
|
|
if a.sons[len-1] <> nil then begin
|
|
def := semExprWithType(c, a.sons[len-1]);
|
|
// check type compability between def.typ and typ:
|
|
if (typ <> nil) then begin
|
|
if (cmpTypes(typ, def.typ) < isConvertible) then begin
|
|
typeMismatch(a.sons[len-1], typ, def.typ);
|
|
end;
|
|
def := fitNode(c, typ, def);
|
|
end
|
|
else typ := def.typ;
|
|
end
|
|
else
|
|
def := nil;
|
|
for j := 0 to len-3 do begin
|
|
arg := newSymS(skParam, a.sons[j], c);
|
|
arg.typ := typ;
|
|
arg.position := counter;
|
|
inc(counter);
|
|
arg.ast := copyTree(def);
|
|
if IntSetContainsOrIncl(check, arg.name.id) then
|
|
liMessage(a.sons[j].info, errAttemptToRedefine, arg.name.s);
|
|
addSon(result.n, newSymNode(arg));
|
|
addSon(result, typ);
|
|
end
|
|
end;
|
|
// NOTE: semantic checking of the result type needs to be done here!
|
|
if n.sons[0] <> nil then begin
|
|
result.sons[0] := paramType(c, n.sons[0], genericParams, cl);
|
|
res.typ := result.sons[0];
|
|
end
|
|
end;
|
|
|
|
function semStmtListType(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
len, i: int;
|
|
begin
|
|
checkMinSonsLen(n, 1);
|
|
len := sonsLen(n);
|
|
for i := 0 to len-2 do begin
|
|
n.sons[i] := semStmt(c, n.sons[i]);
|
|
end;
|
|
if len > 0 then begin
|
|
result := semTypeNode(c, n.sons[len-1], prev);
|
|
n.typ := result;
|
|
n.sons[len-1].typ := result
|
|
end
|
|
else
|
|
result := nil;
|
|
end;
|
|
|
|
function semBlockType(c: PContext; n: PNode; prev: PType): PType;
|
|
begin
|
|
Inc(c.p.nestedBlockCounter);
|
|
checkSonsLen(n, 2);
|
|
openScope(c.tab);
|
|
if n.sons[0] <> nil then begin
|
|
addDecl(c, newSymS(skLabel, n.sons[0], c))
|
|
end;
|
|
result := semStmtListType(c, n.sons[1], prev);
|
|
n.sons[1].typ := result;
|
|
n.typ := result;
|
|
closeScope(c.tab);
|
|
Dec(c.p.nestedBlockCounter);
|
|
end;
|
|
|
|
function semTypeNode(c: PContext; n: PNode; prev: PType): PType;
|
|
var
|
|
s: PSym;
|
|
t: PType;
|
|
begin
|
|
result := nil;
|
|
if n = nil then exit;
|
|
case n.kind of
|
|
nkTypeOfExpr: begin
|
|
result := semExprWithType(c, n, {@set}[efAllowType]).typ;
|
|
end;
|
|
nkPar: begin
|
|
if sonsLen(n) = 1 then result := semTypeNode(c, n.sons[0], prev)
|
|
else liMessage(n.info, errTypeExpected);
|
|
end;
|
|
nkBracketExpr: begin
|
|
checkMinSonsLen(n, 2);
|
|
s := semTypeIdent(c, n.sons[0]);
|
|
case s.magic of
|
|
mArray: result := semArray(c, n, prev);
|
|
mOpenArray: result := semContainer(c, n, tyOpenArray, 'openarray', prev);
|
|
mRange: result := semRange(c, n, prev);
|
|
mSet: result := semSet(c, n, prev);
|
|
mOrdinal: result := semOrdinal(c, n, prev);
|
|
mSeq: result := semContainer(c, n, tySequence, 'seq', prev);
|
|
else result := semGeneric(c, n, s, prev);
|
|
end
|
|
end;
|
|
nkIdent, nkDotExpr, nkAccQuoted: begin
|
|
s := semTypeIdent(c, n);
|
|
if s.typ = nil then
|
|
liMessage(n.info, errTypeExpected);
|
|
if prev = nil then
|
|
result := s.typ
|
|
else begin
|
|
assignType(prev, s.typ);
|
|
prev.id := s.typ.id;
|
|
result := prev;
|
|
end
|
|
end;
|
|
nkSym: begin
|
|
if (n.sym.kind = skType) and (n.sym.typ <> nil) then begin
|
|
t := n.sym.typ;
|
|
if prev = nil then
|
|
result := t
|
|
else begin
|
|
assignType(prev, t);
|
|
result := prev;
|
|
end;
|
|
markUsed(n, n.sym);
|
|
end
|
|
else
|
|
liMessage(n.info, errTypeExpected);
|
|
end;
|
|
nkObjectTy: result := semObjectNode(c, n, prev);
|
|
nkTupleTy: result := semTuple(c, n, prev);
|
|
nkRefTy: result := semAnyRef(c, n, tyRef, 'ref', prev);
|
|
nkPtrTy: result := semAnyRef(c, n, tyPtr, 'ptr', prev);
|
|
nkVarTy: result := semVarType(c, n, prev);
|
|
nkDistinctTy: result := semDistinct(c, n, prev);
|
|
nkProcTy: begin
|
|
checkSonsLen(n, 2);
|
|
result := semProcTypeNode(c, n.sons[0], nil, prev);
|
|
// dummy symbol for `pragma`:
|
|
s := newSymS(skProc, newIdentNode(getIdent('dummy'), n.info), c);
|
|
s.typ := result;
|
|
pragma(c, s, n.sons[1], procTypePragmas);
|
|
end;
|
|
nkEnumTy: result := semEnum(c, n, prev);
|
|
nkType: result := n.typ;
|
|
nkStmtListType: result := semStmtListType(c, n, prev);
|
|
nkBlockType: result := semBlockType(c, n, prev);
|
|
else liMessage(n.info, errTypeExpected);
|
|
//internalError(n.info, 'semTypeNode(' +{&} nodeKindToStr[n.kind] +{&} ')');
|
|
end
|
|
end;
|
|
|
|
procedure setMagicType(m: PSym; kind: TTypeKind; size: int);
|
|
begin
|
|
m.typ.kind := kind;
|
|
m.typ.align := size;
|
|
m.typ.size := size;
|
|
//m.typ.sym := nil;
|
|
end;
|
|
|
|
procedure processMagicType(c: PContext; m: PSym);
|
|
begin
|
|
case m.magic of
|
|
mInt: setMagicType(m, tyInt, intSize);
|
|
mInt8: setMagicType(m, tyInt8, 1);
|
|
mInt16: setMagicType(m, tyInt16, 2);
|
|
mInt32: setMagicType(m, tyInt32, 4);
|
|
mInt64: setMagicType(m, tyInt64, 8);
|
|
mFloat: setMagicType(m, tyFloat, floatSize);
|
|
mFloat32: setMagicType(m, tyFloat32, 4);
|
|
mFloat64: setMagicType(m, tyFloat64, 8);
|
|
mBool: setMagicType(m, tyBool, 1);
|
|
mChar: setMagicType(m, tyChar, 1);
|
|
mString: begin
|
|
setMagicType(m, tyString, ptrSize);
|
|
addSon(m.typ, getSysType(tyChar));
|
|
end;
|
|
mCstring: begin
|
|
setMagicType(m, tyCString, ptrSize);
|
|
addSon(m.typ, getSysType(tyChar));
|
|
end;
|
|
mPointer: setMagicType(m, tyPointer, ptrSize);
|
|
mEmptySet: begin
|
|
setMagicType(m, tySet, 1);
|
|
addSon(m.typ, newTypeS(tyEmpty, c));
|
|
end;
|
|
mIntSetBaseType: begin
|
|
setMagicType(m, tyRange, intSize);
|
|
//intSetBaseType := m.typ;
|
|
exit
|
|
end;
|
|
mNil: setMagicType(m, tyNil, ptrSize);
|
|
mExpr: setMagicType(m, tyExpr, 0);
|
|
mStmt: setMagicType(m, tyStmt, 0);
|
|
mTypeDesc: setMagicType(m, tyTypeDesc, 0);
|
|
mArray, mOpenArray, mRange, mSet, mSeq, mOrdinal: exit;
|
|
else liMessage(m.info, errTypeExpected);
|
|
end;
|
|
//registerSysType(m.typ);
|
|
end;
|