diff options
Diffstat (limited to 'nim')
58 files changed, 8387 insertions, 3388 deletions
diff --git a/nim/ast.pas b/nim/ast.pas index 6d5acf425..587284d56 100644 --- a/nim/ast.pas +++ b/nim/ast.pas @@ -65,140 +65,149 @@ for key, val in enums.iteritems(): cog.out(b) ]]]*) type - TSymKind = ( - skUnknownSym, skConditional, skDynLib, skParam, - skTypeParam, skTemp, skType, skConst, - skVar, skProc, skIterator, skConverter, - skMacro, skTemplate, skField, skEnumField, - skForVar, skModule, skLabel); - TSymKinds = set of TSymKind; -const - SymKindToStr: array [TSymKind] of string = ( - 'skUnknownSym', 'skConditional', 'skDynLib', 'skParam', - 'skTypeParam', 'skTemp', 'skType', 'skConst', - 'skVar', 'skProc', 'skIterator', 'skConverter', - 'skMacro', 'skTemplate', 'skField', 'skEnumField', - 'skForVar', 'skModule', 'skLabel'); -type TNodeKind = ( nkNone, nkEmpty, nkIdent, nkSym, - nkType, nkCharLit, nkRCharLit, nkIntLit, - nkInt8Lit, nkInt16Lit, nkInt32Lit, nkInt64Lit, - nkFloatLit, nkFloat32Lit, nkFloat64Lit, nkStrLit, - nkRStrLit, nkTripleStrLit, nkNilLit, nkDotCall, + nkType, nkCharLit, nkIntLit, nkInt8Lit, + nkInt16Lit, nkInt32Lit, nkInt64Lit, nkFloatLit, + nkFloat32Lit, nkFloat64Lit, nkStrLit, nkRStrLit, + nkTripleStrLit, nkMetaNode, nkNilLit, nkDotCall, nkCommand, nkCall, nkGenericCall, nkExplicitTypeListCall, nkExprEqExpr, nkExprColonExpr, nkIdentDefs, nkInfix, nkPrefix, nkPostfix, nkPar, nkCurly, nkBracket, nkBracketExpr, nkPragmaExpr, nkRange, nkDotExpr, nkCheckedFieldExpr, nkDerefExpr, nkIfExpr, nkElifExpr, nkElseExpr, nkLambda, nkAccQuoted, - nkHeaderQuoted, nkSetConstr, nkConstSetConstr, nkArrayConstr, - nkConstArrayConstr, nkRecordConstr, nkConstRecordConstr, nkTableConstr, - nkConstTableConstr, nkQualified, nkHiddenStdConv, nkHiddenSubConv, - nkHiddenCallConv, nkConv, nkCast, nkAddr, - nkAsgn, nkDefaultTypeParam, nkGenericParams, nkFormalParams, - nkOfInherit, nkModule, nkProcDef, nkConverterDef, - nkMacroDef, nkTemplateDef, nkIteratorDef, nkOfBranch, - nkElifBranch, nkExceptBranch, nkElse, nkMacroStmt, - nkAsmStmt, nkPragma, nkIfStmt, nkWhenStmt, - nkForStmt, nkWhileStmt, nkCaseStmt, nkVarSection, - nkConstSection, nkConstDef, nkTypeSection, nkTypeDef, - nkYieldStmt, nkTryStmt, nkFinally, nkRaiseStmt, - nkReturnStmt, nkBreakStmt, nkContinueStmt, nkBlockStmt, - nkGotoStmt, nkDiscardStmt, nkStmtList, nkImportStmt, - nkFromStmt, nkImportAs, nkIncludeStmt, nkAccessStmt, - nkCommentStmt, nkStmtListExpr, nkBlockExpr, nkVm, - nkTypeOfExpr, nkRecordTy, nkObjectTy, nkRecList, - nkRecCase, nkRecWhen, nkRefTy, nkPtrTy, - nkVarTy, nkProcTy, nkEnumTy, nkEnumFieldDef); + nkHeaderQuoted, nkTableConstr, nkQualified, nkHiddenStdConv, + nkHiddenSubConv, nkHiddenCallConv, nkConv, nkCast, + nkAddr, nkHiddenAddr, nkHiddenDeref, nkObjDownConv, + nkObjUpConv, nkChckRangeF, nkChckRange64, nkChckRange, + nkStringToCString, nkCStringToString, nkPassAsOpenArray, nkAsgn, + nkDefaultTypeParam, nkGenericParams, nkFormalParams, nkOfInherit, + nkModule, nkProcDef, nkConverterDef, nkMacroDef, + nkTemplateDef, nkIteratorDef, nkOfBranch, nkElifBranch, + nkExceptBranch, nkElse, nkMacroStmt, nkAsmStmt, + nkPragma, nkIfStmt, nkWhenStmt, nkForStmt, + nkWhileStmt, nkCaseStmt, nkVarSection, nkConstSection, + nkConstDef, nkTypeSection, nkTypeDef, nkYieldStmt, + nkTryStmt, nkFinally, nkRaiseStmt, nkReturnStmt, + nkBreakStmt, nkContinueStmt, nkBlockStmt, nkDiscardStmt, + nkStmtList, nkImportStmt, nkFromStmt, nkImportAs, + nkIncludeStmt, nkAccessStmt, nkCommentStmt, nkStmtListExpr, + nkBlockExpr, nkVm, nkTypeOfExpr, nkObjectTy, + nkTupleTy, nkRecList, nkRecCase, nkRecWhen, + nkRefTy, nkPtrTy, nkVarTy, nkProcTy, + nkEnumTy, nkEnumFieldDef, nkReturnToken); TNodeKinds = set of TNodeKind; const NodeKindToStr: array [TNodeKind] of string = ( 'nkNone', 'nkEmpty', 'nkIdent', 'nkSym', - 'nkType', 'nkCharLit', 'nkRCharLit', 'nkIntLit', - 'nkInt8Lit', 'nkInt16Lit', 'nkInt32Lit', 'nkInt64Lit', - 'nkFloatLit', 'nkFloat32Lit', 'nkFloat64Lit', 'nkStrLit', - 'nkRStrLit', 'nkTripleStrLit', 'nkNilLit', 'nkDotCall', + 'nkType', 'nkCharLit', 'nkIntLit', 'nkInt8Lit', + 'nkInt16Lit', 'nkInt32Lit', 'nkInt64Lit', 'nkFloatLit', + 'nkFloat32Lit', 'nkFloat64Lit', 'nkStrLit', 'nkRStrLit', + 'nkTripleStrLit', 'nkMetaNode', 'nkNilLit', 'nkDotCall', 'nkCommand', 'nkCall', 'nkGenericCall', 'nkExplicitTypeListCall', 'nkExprEqExpr', 'nkExprColonExpr', 'nkIdentDefs', 'nkInfix', 'nkPrefix', 'nkPostfix', 'nkPar', 'nkCurly', 'nkBracket', 'nkBracketExpr', 'nkPragmaExpr', 'nkRange', 'nkDotExpr', 'nkCheckedFieldExpr', 'nkDerefExpr', 'nkIfExpr', 'nkElifExpr', 'nkElseExpr', 'nkLambda', 'nkAccQuoted', - 'nkHeaderQuoted', 'nkSetConstr', 'nkConstSetConstr', 'nkArrayConstr', - 'nkConstArrayConstr', 'nkRecordConstr', 'nkConstRecordConstr', 'nkTableConstr', - 'nkConstTableConstr', 'nkQualified', 'nkHiddenStdConv', 'nkHiddenSubConv', - 'nkHiddenCallConv', 'nkConv', 'nkCast', 'nkAddr', - 'nkAsgn', 'nkDefaultTypeParam', 'nkGenericParams', 'nkFormalParams', - 'nkOfInherit', 'nkModule', 'nkProcDef', 'nkConverterDef', - 'nkMacroDef', 'nkTemplateDef', 'nkIteratorDef', 'nkOfBranch', - 'nkElifBranch', 'nkExceptBranch', 'nkElse', 'nkMacroStmt', - 'nkAsmStmt', 'nkPragma', 'nkIfStmt', 'nkWhenStmt', - 'nkForStmt', 'nkWhileStmt', 'nkCaseStmt', 'nkVarSection', - 'nkConstSection', 'nkConstDef', 'nkTypeSection', 'nkTypeDef', - 'nkYieldStmt', 'nkTryStmt', 'nkFinally', 'nkRaiseStmt', - 'nkReturnStmt', 'nkBreakStmt', 'nkContinueStmt', 'nkBlockStmt', - 'nkGotoStmt', 'nkDiscardStmt', 'nkStmtList', 'nkImportStmt', - 'nkFromStmt', 'nkImportAs', 'nkIncludeStmt', 'nkAccessStmt', - 'nkCommentStmt', 'nkStmtListExpr', 'nkBlockExpr', 'nkVm', - 'nkTypeOfExpr', 'nkRecordTy', 'nkObjectTy', 'nkRecList', - 'nkRecCase', 'nkRecWhen', 'nkRefTy', 'nkPtrTy', - 'nkVarTy', 'nkProcTy', 'nkEnumTy', 'nkEnumFieldDef'); + 'nkHeaderQuoted', 'nkTableConstr', 'nkQualified', 'nkHiddenStdConv', + 'nkHiddenSubConv', 'nkHiddenCallConv', 'nkConv', 'nkCast', + 'nkAddr', 'nkHiddenAddr', 'nkHiddenDeref', 'nkObjDownConv', + 'nkObjUpConv', 'nkChckRangeF', 'nkChckRange64', 'nkChckRange', + 'nkStringToCString', 'nkCStringToString', 'nkPassAsOpenArray', 'nkAsgn', + 'nkDefaultTypeParam', 'nkGenericParams', 'nkFormalParams', 'nkOfInherit', + 'nkModule', 'nkProcDef', 'nkConverterDef', 'nkMacroDef', + 'nkTemplateDef', 'nkIteratorDef', 'nkOfBranch', 'nkElifBranch', + 'nkExceptBranch', 'nkElse', 'nkMacroStmt', 'nkAsmStmt', + 'nkPragma', 'nkIfStmt', 'nkWhenStmt', 'nkForStmt', + 'nkWhileStmt', 'nkCaseStmt', 'nkVarSection', 'nkConstSection', + 'nkConstDef', 'nkTypeSection', 'nkTypeDef', 'nkYieldStmt', + 'nkTryStmt', 'nkFinally', 'nkRaiseStmt', 'nkReturnStmt', + 'nkBreakStmt', 'nkContinueStmt', 'nkBlockStmt', 'nkDiscardStmt', + 'nkStmtList', 'nkImportStmt', 'nkFromStmt', 'nkImportAs', + 'nkIncludeStmt', 'nkAccessStmt', 'nkCommentStmt', 'nkStmtListExpr', + 'nkBlockExpr', 'nkVm', 'nkTypeOfExpr', 'nkObjectTy', + 'nkTupleTy', 'nkRecList', 'nkRecCase', 'nkRecWhen', + 'nkRefTy', 'nkPtrTy', 'nkVarTy', 'nkProcTy', + 'nkEnumTy', 'nkEnumFieldDef', 'nkReturnToken'); type TSymFlag = ( - sfGeneric, sfForward, sfImportc, sfExportc, + sfTypeCheck, sfForward, sfImportc, sfExportc, sfVolatile, sfUsed, sfWrite, sfRegister, sfPure, sfCodeGenerated, sfPrivate, sfGlobal, sfResult, sfNoSideEffect, sfMainModule, sfSystemModule, - sfNoReturn, sfReturnsNew, sfInInterface, sfNoStatic, + sfNoReturn, sfAddrTaken, sfInInterface, sfNoStatic, sfCompilerProc, sfCppMethod, sfDiscriminant, sfDeprecated, sfInClosure, sfIsCopy, sfStar, sfMinus); TSymFlags = set of TSymFlag; const SymFlagToStr: array [TSymFlag] of string = ( - 'sfGeneric', 'sfForward', 'sfImportc', 'sfExportc', + 'sfTypeCheck', 'sfForward', 'sfImportc', 'sfExportc', 'sfVolatile', 'sfUsed', 'sfWrite', 'sfRegister', 'sfPure', 'sfCodeGenerated', 'sfPrivate', 'sfGlobal', 'sfResult', 'sfNoSideEffect', 'sfMainModule', 'sfSystemModule', - 'sfNoReturn', 'sfReturnsNew', 'sfInInterface', 'sfNoStatic', + 'sfNoReturn', 'sfAddrTaken', 'sfInInterface', 'sfNoStatic', 'sfCompilerProc', 'sfCppMethod', 'sfDiscriminant', 'sfDeprecated', 'sfInClosure', 'sfIsCopy', 'sfStar', 'sfMinus'); type TTypeKind = ( tyNone, tyBool, tyChar, tyEmptySet, - tyArrayConstr, tyNil, tyRecordConstr, tyGeneric, - tyGenericInst, tyGenericParam, tyEnum, tyAnyEnum, - tyArray, tyRecord, tyObject, tyTuple, - tySet, tyRange, tyPtr, tyRef, - tyVar, tySequence, tyProc, tyPointer, - tyOpenArray, tyString, tyCString, tyForward, - tyInt, tyInt8, tyInt16, tyInt32, - tyInt64, tyFloat, tyFloat32, tyFloat64, - tyFloat128); + tyArrayConstr, tyNil, tyGeneric, tyGenericInst, + tyGenericParam, tyEnum, tyAnyEnum, tyArray, + tyObject, tyTuple, tySet, tyRange, + tyPtr, tyRef, tyVar, tySequence, + tyProc, tyPointer, tyOpenArray, tyString, + tyCString, tyForward, tyInt, tyInt8, + tyInt16, tyInt32, tyInt64, tyFloat, + tyFloat32, tyFloat64, tyFloat128); TTypeKinds = set of TTypeKind; const TypeKindToStr: array [TTypeKind] of string = ( 'tyNone', 'tyBool', 'tyChar', 'tyEmptySet', - 'tyArrayConstr', 'tyNil', 'tyRecordConstr', 'tyGeneric', - 'tyGenericInst', 'tyGenericParam', 'tyEnum', 'tyAnyEnum', - 'tyArray', 'tyRecord', 'tyObject', 'tyTuple', - 'tySet', 'tyRange', 'tyPtr', 'tyRef', - 'tyVar', 'tySequence', 'tyProc', 'tyPointer', - 'tyOpenArray', 'tyString', 'tyCString', 'tyForward', - 'tyInt', 'tyInt8', 'tyInt16', 'tyInt32', - 'tyInt64', 'tyFloat', 'tyFloat32', 'tyFloat64', - 'tyFloat128'); + 'tyArrayConstr', 'tyNil', 'tyGeneric', 'tyGenericInst', + 'tyGenericParam', 'tyEnum', 'tyAnyEnum', 'tyArray', + 'tyObject', 'tyTuple', 'tySet', 'tyRange', + 'tyPtr', 'tyRef', 'tyVar', 'tySequence', + 'tyProc', 'tyPointer', 'tyOpenArray', 'tyString', + 'tyCString', 'tyForward', 'tyInt', 'tyInt8', + 'tyInt16', 'tyInt32', 'tyInt64', 'tyFloat', + 'tyFloat32', 'tyFloat64', 'tyFloat128'); +type + TNodeFlag = ( + nfNone, nfBase2, nfBase8, nfBase16, + nfAllConst); + TNodeFlags = set of TNodeFlag; +const + NodeFlagToStr: array [TNodeFlag] of string = ( + 'nfNone', 'nfBase2', 'nfBase8', 'nfBase16', + 'nfAllConst'); type TTypeFlag = ( tfIsDistinct, tfGeneric, tfExternal, tfImported, tfInfoGenerated, tfSemChecked, tfHasOutParams, tfEnumHasWholes, - tfVarargs, tfAssignable); + tfVarargs, tfFinal); TTypeFlags = set of TTypeFlag; const TypeFlagToStr: array [TTypeFlag] of string = ( 'tfIsDistinct', 'tfGeneric', 'tfExternal', 'tfImported', 'tfInfoGenerated', 'tfSemChecked', 'tfHasOutParams', 'tfEnumHasWholes', - 'tfVarargs', 'tfAssignable'); + 'tfVarargs', 'tfFinal'); +type + TSymKind = ( + skUnknownSym, skConditional, skDynLib, skParam, + skTypeParam, skTemp, skType, skConst, + skVar, skProc, skIterator, skConverter, + skMacro, skTemplate, skField, skEnumField, + skForVar, skModule, skLabel); + TSymKinds = set of TSymKind; +const + SymKindToStr: array [TSymKind] of string = ( + 'skUnknownSym', 'skConditional', 'skDynLib', 'skParam', + 'skTypeParam', 'skTemp', 'skType', 'skConst', + 'skVar', 'skProc', 'skIterator', 'skConverter', + 'skMacro', 'skTemplate', 'skField', 'skEnumField', + 'skForVar', 'skModule', 'skLabel'); {[[[end]]]} type @@ -228,20 +237,28 @@ type mEqProc, mEqUntracedRef, mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, mUnaryMinusI64, mAbsI, mAbsI64, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusI64, mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, - mZe, mZe64, mToU8, mToU16, mToU32, mToFloat, - mToBiggestFloat, mToInt, mToBiggestInt, mAnd, mOr, mEqStr, - mLeStr, mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, - mPlusSet, mMinusSet, mSymDiffSet, mConStrStr, mConArrArr, mConArrT, - mConTArr, mConTT, mSlice, mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mAppendSeqSeq, mInRange, mInSet, mIs, mAsgn, mRepr, - mExit, mSetLengthStr, mSetLengthSeq, mAssert, mSwap, mArray, - mOpenArray, mRange, mTuple, mSet, mSeq, mCompileDate, - mCompileTime, mNimrodVersion, mNimrodMajor, mNimrodMinor, mNimrodPatch, mCpuEndian + mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, + mToU8, mToU16, mToU32, mToFloat, mToBiggestFloat, mToInt, + mToBiggestInt, mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, + mCStrToStr, mStrToStr, mAnd, mOr, mEqStr, mLeStr, + mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, + mMinusSet, mSymDiffSet, mConStrStr, mConArrArr, mConArrT, mConTArr, + mConTT, mSlice, mAppendStrCh, mAppendStrStr, mAppendSeqElem, mAppendSeqSeq, + mInRange, mInSet, mIs, mAsgn, mRepr, mExit, + mSetLengthStr, mSetLengthSeq, mAssert, mSwap, mIsNil, mArray, + mOpenArray, mRange, mSet, mSeq, mCompileDate, mCompileTime, + mNimrodVersion, mNimrodMajor, mNimrodMinor, mNimrodPatch, mCpuEndian, mNaN, + mInf, mNegInf, mNLen, mNChild, mNSetChild, mNAdd, + mNAddMultiple, mNDel, mNKind, mNIntVal, mNFloatVal, mNSymbol, + mNIdent, mNGetType, mNStrVal, mNSetIntVal, mNSetFloatVal, mNSetSymbol, + mNSetIdent, mNSetType, mNSetStrVal, mNNewNimNode, mNCopyNimNode, mNCopyNimTree, + mStrToIdent, mIdentToStr, mEqIdent, mNHint, mNWarning, mNError //[[[end]]] ); type PNode = ^TNode; + PNodePtr = ^{@ptr}PNode; TNodeSeq = array of PNode; PType = ^TType; @@ -254,22 +271,22 @@ type comment: string; sons: TNodeSeq; // else! info: TLineInfo; - base: TNumericalBase; // only valid for int or float literals + flags: TNodeFlags; case Kind: TNodeKind of - nkCharLit, nkRCharLit, - nkIntLit, nkInt8Lit, nkInt16Lit, nkInt32Lit, nkInt64Lit: + nkCharLit, nkIntLit, nkInt8Lit, nkInt16Lit, nkInt32Lit, nkInt64Lit: (intVal: biggestInt); nkFloatLit, nkFloat32Lit, nkFloat64Lit: (floatVal: biggestFloat); nkSym: (sym: PSym); nkIdent: (ident: PIdent); + nkMetaNode: (nodePtr: PNodePtr); end; {@emit record // keep this below 32 bytes; otherwise the AST grows too much typ: PType; comment: string; info: TLineInfo; - base: TNumericalBase; // only valid for int or float literals + flags: TNodeFlags; case Kind: TNodeKind of nkCharLit..nkInt64Lit: (intVal: biggestInt); @@ -279,6 +296,7 @@ type (strVal: string); nkSym: (sym: PSym); nkIdent: (ident: PIdent); + nkMetaNode: (nodePtr: PNodePtr); else (sons: TNodeSeq); end; } @@ -305,29 +323,29 @@ type locCall, // location is a call expression locOther // location is something other ); - + TLocFlag = ( - // lfIndirect, // location needs to be derefered - lfOnStack, // location is on hardware stack - lfOnHeap, // location is on heap - lfOnData, // location is in the static constant data - lfOnUnknown, // location is unknown (stack, heap or static) - // other backend-flags: + lfIndirect, // backend introduced a pointer lfNoDeepCopy, // no need for a deep copy lfNoDecl, // do not declare it in C lfDynamicLib, // link symbol to dynamic library lfHeader // include header file for symbol ); + TStorageLoc = ( + OnUnknown, // location is unknown (stack, heap or static) + OnStack, // location is on hardware stack + OnHeap // location is on heap or global (reference counting needed) + ); + TLocFlags = set of TLocFlag; TLoc = record k: TLocKind; // kind of location + s: TStorageLoc; + flags: TLocFlags; // location's flags t: PType; // type of location - r: PRope; // rope value of location (C code generator) + r: PRope; // rope value of location (code generators) a: int; // location's "address", i.e. slot for temporaries - flags: TLocFlags; // location's flags - indirect: int; // count the number of dereferences needed to access the - // location end; // ---------------- end of backend information ------------------------------ @@ -447,7 +465,7 @@ type PLib = ^TLib; const - OverloadableSyms = {@set}[skProc, skIterator, skEnumField]; + OverloadableSyms = {@set}[skProc, skIterator, skConverter]; const // "MagicToStr" array: MagicToStr: array [TMagic] of string = ( @@ -474,15 +492,22 @@ const // "MagicToStr" array: 'EqProc', 'EqUntracedRef', 'LePtr', 'LtPtr', 'EqCString', 'Xor', 'UnaryMinusI', 'UnaryMinusI64', 'AbsI', 'AbsI64', 'Not', 'UnaryPlusI', 'BitnotI', 'UnaryPlusI64', 'BitnotI64', 'UnaryPlusF64', 'UnaryMinusF64', 'AbsF64', - 'Ze', 'Ze64', 'ToU8', 'ToU16', 'ToU32', 'ToFloat', - 'ToBiggestFloat', 'ToInt', 'ToBiggestInt', 'And', 'Or', 'EqStr', - 'LeStr', 'LtStr', 'EqSet', 'LeSet', 'LtSet', 'MulSet', - 'PlusSet', 'MinusSet', 'SymDiffSet', 'ConStrStr', 'ConArrArr', 'ConArrT', - 'ConTArr', 'ConTT', 'Slice', 'AppendStrCh', 'AppendStrStr', 'AppendSeqElem', - 'AppendSeqSeq', 'InRange', 'InSet', 'Is', 'Asgn', 'Repr', - 'Exit', 'SetLengthStr', 'SetLengthSeq', 'Assert', 'Swap', 'Array', - 'OpenArray', 'Range', 'Tuple', 'Set', 'Seq', 'CompileDate', - 'CompileTime', 'NimrodVersion', 'NimrodMajor', 'NimrodMinor', 'NimrodPatch', 'CpuEndian' + 'Ze8ToI', 'Ze8ToI64', 'Ze16ToI', 'Ze16ToI64', 'Ze32ToI64', 'ZeIToI64', + 'ToU8', 'ToU16', 'ToU32', 'ToFloat', 'ToBiggestFloat', 'ToInt', + 'ToBiggestInt', 'CharToStr', 'BoolToStr', 'IntToStr', 'Int64ToStr', 'FloatToStr', + 'CStrToStr', 'StrToStr', 'And', 'Or', 'EqStr', 'LeStr', + 'LtStr', 'EqSet', 'LeSet', 'LtSet', 'MulSet', 'PlusSet', + 'MinusSet', 'SymDiffSet', 'ConStrStr', 'ConArrArr', 'ConArrT', 'ConTArr', + 'ConTT', 'Slice', 'AppendStrCh', 'AppendStrStr', 'AppendSeqElem', 'AppendSeqSeq', + 'InRange', 'InSet', 'Is', 'Asgn', 'Repr', 'Exit', + 'SetLengthStr', 'SetLengthSeq', 'Assert', 'Swap', 'IsNil', 'Array', + 'OpenArray', 'Range', 'Set', 'Seq', 'CompileDate', 'CompileTime', + 'NimrodVersion', 'NimrodMajor', 'NimrodMinor', 'NimrodPatch', 'CpuEndian', 'NaN', + 'Inf', 'NegInf', 'NLen', 'NChild', 'NSetChild', 'NAdd', + 'NAddMultiple', 'NDel', 'NKind', 'NIntVal', 'NFloatVal', 'NSymbol', + 'NIdent', 'NGetType', 'NStrVal', 'NSetIntVal', 'NSetFloatVal', 'NSetSymbol', + 'NSetIdent', 'NSetType', 'NSetStrVal', 'NNewNimNode', 'NCopyNimNode', 'NCopyNimTree', + 'StrToIdent', 'IdentToStr', 'EqIdent', 'NHint', 'NWarning', 'NError' //[[[end]]] ); @@ -490,7 +515,7 @@ const GenericTypes: TTypeKinds = {@set}[tyGeneric, tyGenericParam]; StructuralEquivTypes: TTypeKinds = {@set}[ - tyEmptySet, tyArrayConstr, tyNil, tyRecordConstr, tyTuple, + tyEmptySet, tyArrayConstr, tyNil, tyTuple, tyArray, tySet, tyRange, @@ -503,16 +528,16 @@ const ConcreteTypes: TTypeKinds = {@set}[ // types of the expr that may occur in:: // var x = expr - tyBool, tyChar, tyEnum, tyArray, tyRecord, tyObject, tySet, tyTuple, + tyBool, tyChar, tyEnum, tyArray, tyObject, tySet, tyTuple, tyRange, tyPtr, tyRef, tyVar, tySequence, tyProc, tyPointer, tyOpenArray, tyString, tyCString, tyInt..tyInt64, tyFloat..tyFloat128 ]; - ConstantDataTypes: TTypeKinds = {@set}[tyArray, tyRecord, tySet, tyTuple]; - ExportableSymKinds = {@set}[skVar, skConst, skProc, skType, skEnumField, - skIterator, skMacro, skTemplate]; + ConstantDataTypes: TTypeKinds = {@set}[tyArray, tySet, tyTuple]; + ExportableSymKinds = {@set}[skVar, skConst, skProc, skType, + skIterator, skMacro, skTemplate, skConverter]; namePos = 0; genericParamsPos = 1; paramsPos = 2; @@ -534,7 +559,7 @@ function newIntTypeNode(kind: TNodeKind; const intVal: BiggestInt; typ: PType): PNode; function newFloatNode(kind: TNodeKind; const floatVal: BiggestFloat): PNode; function newStrNode(kind: TNodeKind; const strVal: string): PNode; -function newIdentNode(ident: PIdent): PNode; +function newIdentNode(ident: PIdent; const info: TLineInfo): PNode; function newSymNode(sym: PSym): PNode; function newNodeI(kind: TNodeKind; const info: TLineInfo): PNode; function newNodeIT(kind: TNodeKind; const info: TLineInfo; typ: PType): PNode; @@ -548,7 +573,7 @@ procedure initNodeTable(out x: TNodeTable); // copy procs: function copyType(t: PType; owner: PSym): PType; -function copySym(s: PSym; owner: PSym): PSym; +function copySym(s: PSym; keepId: bool = false): PSym; procedure assignType(dest, src: PType); procedure copyStrTable(out dest: TStrTable; const src: TStrTable); @@ -620,7 +645,7 @@ begin if b.kind in [nkStrLit..nkTripleStrLit] then result := a.strVal <= b.strVal; end - else assert(false); + else InternalError(a.info, 'leValue'); end end; @@ -638,7 +663,7 @@ begin if b.kind in [nkStrLit..nkTripleStrLit] then result := a.strVal = b.strVal; end - else assert(false); + else InternalError(a.info, 'SameValue'); end end; @@ -652,7 +677,7 @@ begin nkStrLit..nkTripleStrLit: result := a.strVal; else begin - assert(false); + InternalError(a.info, 'valueToString'); result := '' end end @@ -663,6 +688,9 @@ var i: int; begin dest.counter := src.counter; +{@emit + if isNil(src.data) then exit; +} setLength(dest.data, length(src.data)); for i := 0 to high(src.data) do dest.data[i] := src.data[i]; @@ -673,6 +701,9 @@ var i: int; begin dest.counter := src.counter; +{@emit + if isNil(src.data) then exit; +} setLength(dest.data, length(src.data)); for i := 0 to high(src.data) do dest.data[i] := src.data[i]; @@ -683,6 +714,9 @@ var i: int; begin dest.counter := src.counter; +{@emit + if isNil(src.data) then exit; +} setLength(dest.data, length(src.data)); for i := 0 to high(src.data) do dest.data[i] := src.data[i]; @@ -700,7 +734,7 @@ begin FillChar(result^, sizeof(result^), 0); {@emit} result.kind := kind; - result.info := UnknownLineInfo; + result.info := UnknownLineInfo(); end; function newIntNode(kind: TNodeKind; const intVal: BiggestInt): PNode; @@ -728,10 +762,11 @@ begin result.strVal := strVal end; -function newIdentNode(ident: PIdent): PNode; +function newIdentNode(ident: PIdent; const info: TLineInfo): PNode; begin result := newNode(nkIdent); - result.ident := ident + result.ident := ident; + result.info := info; end; function newSymNode(sym: PSym): PNode; @@ -778,8 +813,9 @@ begin dest.n := src.n; dest.size := src.size; dest.align := src.align; + dest.containerID := src.containerID; newSons(dest, sonsLen(src)); - for i := 0 to sonsLen(src)-1 do + for i := 0 to sonsLen(src)-1 do dest.sons[i] := src.sons[i]; end; @@ -793,14 +829,13 @@ begin // backend-info should not be copied end; -function copySym(s: PSym; owner: PSym): PSym; +function copySym(s: PSym; keepId: bool = false): PSym; begin - result := newSym(s.kind, s.name, owner); + result := newSym(s.kind, s.name, s.owner); result.ast := nil; // BUGFIX; was: s.ast which made problems result.info := s.info; result.typ := s.typ; - if owner = s.owner then result.id := s.id - else result.id := getID(); + if keepId then result.id := s.id else result.id := getID(); result.flags := s.flags; result.magic := s.magic; copyStrTable(result.tab, s.tab); @@ -820,7 +855,7 @@ begin result.Name := Name; result.Kind := symKind; result.flags := {@set}[]; - result.info := UnknownLineInfo; + result.info := UnknownLineInfo(); result.options := gOptions; result.owner := owner; result.offset := -1; @@ -971,8 +1006,8 @@ begin if src = nil then begin result := nil; exit end; result := newNode(src.kind); result.info := src.info; - result.typ := src.typ; - result.base := src.base; + result.typ := src.typ; + result.flags := src.flags; case src.Kind of nkCharLit..nkInt64Lit: result.intVal := src.intVal; @@ -984,6 +1019,8 @@ begin result.ident := src.ident; nkStrLit..nkTripleStrLit: result.strVal := src.strVal; + nkMetaNode: + result.nodePtr := src.nodePtr; else begin end; end; end; @@ -994,11 +1031,30 @@ var i: int; begin if src = nil then begin result := nil; exit end; - result := copyNode(src); - result.sons := nil; // BUGFIX - newSons(result, sonsLen(src)); - for i := 0 to sonsLen(src)-1 do - result.sons[i] := copyTree(src.sons[i]); + result := newNode(src.kind); + result.info := src.info; + result.typ := src.typ; + result.flags := src.flags; + case src.Kind of + nkCharLit..nkInt64Lit: + result.intVal := src.intVal; + nkFloatLit, nkFloat32Lit, nkFloat64Lit: + result.floatVal := src.floatVal; + nkSym: + result.sym := src.sym; + nkIdent: + result.ident := src.ident; + nkStrLit..nkTripleStrLit: + result.strVal := src.strVal; + nkMetaNode: + result.nodePtr := src.nodePtr; + else begin + result.sons := nil; + newSons(result, sonsLen(src)); + for i := 0 to sonsLen(src)-1 do + result.sons[i] := copyTree(src.sons[i]); + end; + end end; function lastSon(n: PNode): PNode; @@ -1016,8 +1072,8 @@ var i: int; begin for i := 0 to sonsLen(n)-1 do begin - if (n.sons[i] <> nil) and (n.sons[i].kind = kind) then begin - result := true; exit + if (n.sons[i] <> nil) and (n.sons[i].kind = kind) then begin + result := true; exit end end; result := false @@ -1031,9 +1087,9 @@ begin nkEmpty..nkNilLit: result := n.kind = kind; else begin for i := 0 to sonsLen(n)-1 do begin - if (n.sons[i] <> nil) and (n.sons[i].kind = kind) - or hasSubnodeWith(n.sons[i], kind) then begin - result := true; exit + if (n.sons[i] <> nil) and (n.sons[i].kind = kind) + or hasSubnodeWith(n.sons[i], kind) then begin + result := true; exit end end; result := false diff --git a/nim/astalgo.pas b/nim/astalgo.pas index 5ab1683b3..a7ee3fc83 100644 --- a/nim/astalgo.pas +++ b/nim/astalgo.pas @@ -136,6 +136,10 @@ procedure debug(n: PNode); overload; function IdTableGet(const t: TIdTable; key: PIdObj): PObject; procedure IdTablePut(var t: TIdTable; key: PIdObj; val: PObject); +function IdTableHasObjectAsKey(const t: TIdTable; key: PIdObj): bool; +// checks if `t` contains the `key` (compared by the pointer value, not only +// `key`'s id) + function IdNodeTableGet(const t: TIdNodeTable; key: PIdObj): PNode; procedure IdNodeTablePut(var t: TIdNodeTable; key: PIdObj; val: PNode); @@ -180,8 +184,6 @@ function nextTry(h, maxHash: THash): THash; implementation function lookupInRecord(n: PNode; field: PIdent): PSym; -// XXX: transform in a node that contains the runtime check for the -// field, if it is in a case-part... var i: int; begin @@ -194,7 +196,7 @@ begin end end; nkRecCase: begin - assert(n.sons[0].kind = nkSym); + if (n.sons[0].kind <> nkSym) then InternalError(n.info, 'lookupInRecord'); result := lookupInRecord(n.sons[0], field); if result <> nil then exit; for i := 1 to sonsLen(n)-1 do begin @@ -203,7 +205,7 @@ begin result := lookupInRecord(lastSon(n.sons[i]), field); if result <> nil then exit; end; - else internalError('lookupInRecord(record case branch)'); + else internalError(n.info, 'lookupInRecord(record case branch)'); end end end; @@ -226,7 +228,8 @@ var i: int; begin for i := start to sonsLen(list)-1 do begin - assert(list.sons[i].kind = nkSym); + if list.sons[i].kind <> nkSym then + InternalError(list.info, 'getSymFromList'); result := list.sons[i].sym; if result.name.id = ident.id then exit end; @@ -342,7 +345,7 @@ end; function lineInfoToStr(const info: TLineInfo): PRope; begin - result := ropeFormat('[$1, $2, $3]', [makeYamlString(toFilename(info)), + result := ropef('[$1, $2, $3]', [makeYamlString(toFilename(info)), toRope(toLinenumber(info)), toRope(toColumn(info))]); end; @@ -367,11 +370,11 @@ begin for i := 0 to high(n.data) do if n.data[i] <> nil then begin if mycount > 0 then app(result, ','+''); - appRopeFormat(result, '$n$1$2', + appf(result, '$n$1$2', [istr, symToYamlAux(n.data[i], marker, indent+2, maxRecDepth-1)]); inc(mycount) end; - if mycount > 0 then appRopeFormat(result, '$n$1', [spaces(indent)]); + if mycount > 0 then appf(result, '$n$1', [spaces(indent)]); app(result, ']'+''); assert(mycount = n.counter); end; @@ -387,10 +390,10 @@ begin i := 0; while i <= high(c) do begin if i > 0 then app(result, ','+''); - appRopeFormat(result, '$n$1"$2": $3', [istr, c[i], c[i+1]]); + appf(result, '$n$1"$2": $3', [istr, c[i], c[i+1]]); inc(i, 2) end; - appRopeFormat(result, '$n$1}', [spaces(indent)]); + appf(result, '$n$1}', [spaces(indent)]); end; function symToYamlAux(n: PSym; var marker: TObjectSet; @@ -401,7 +404,7 @@ begin if n = nil then result := toRope('null') else if ObjectSetContainsOrIncl(marker, n) then - result := ropeFormat('"$1 @$2"', [ + result := ropef('"$1 @$2"', [ toRope(n.name.s), toRope(strutils.toHex({@cast}TAddress(n), sizeof(n)*2))]) else begin @@ -427,7 +430,7 @@ begin if n = nil then result := toRope('null') else if objectSetContainsOrIncl(marker, n) then - result := ropeFormat('"$1 @$2"', [ + result := ropef('"$1 @$2"', [ toRope(typeKindToStr[n.kind]), toRope(strutils.toHex({@cast}TAddress(n), sizeof(n)*2))]) else begin @@ -453,48 +456,48 @@ begin result := toRope('null') else begin istr := spaces(indent+2); - result := ropeFormat('{$n$1"kind": $2', + result := ropef('{$n$1"kind": $2', [istr, makeYamlString(nodeKindToStr[n.kind])]); if maxRecDepth <> 0 then begin - appRopeFormat(result, ',$n$1"typ": $2', - [istr, typeToYamlAux(n.typ, marker, indent+2, maxRecDepth)]); - appRopeFormat(result, ',$n$1"info": $2', + appf(result, ',$n$1"info": $2', [istr, lineInfoToStr(n.info)]); case n.kind of nkCharLit..nkInt64Lit: - appRopeFormat(result, '$n$1"intVal": $2', [istr, toRope(n.intVal)]); + appf(result, '$n$1"intVal": $2', [istr, toRope(n.intVal)]); nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appRopeFormat(result, '$n$1"floatVal": $2', + appf(result, '$n$1"floatVal": $2', [istr, toRopeF(n.floatVal)]); nkStrLit..nkTripleStrLit: - appRopeFormat(result, '$n$1"strVal": $2', + appf(result, '$n$1"strVal": $2', [istr, makeYamlString(n.strVal)]); nkSym: - appRopeFormat(result, ',$n$1"sym": $2', + appf(result, ',$n$1"sym": $2', [istr, symToYamlAux(n.sym, marker, indent+2, maxRecDepth)]); nkIdent: begin if n.ident <> nil then - appRopeFormat(result, '$n$1"ident": $2', + appf(result, '$n$1"ident": $2', [istr, makeYamlString(n.ident.s)]) else - appRopeFormat(result, '$n$1"ident": null', [istr]) + appf(result, '$n$1"ident": null', [istr]) end else begin if sonsLen(n) > 0 then begin - appRopeFormat(result, ',$n$1"sons": [', [istr]); + appf(result, ',$n$1"sons": [', [istr]); for i := 0 to sonsLen(n)-1 do begin if i > 0 then app(result, ','+''); - appRopeFormat(result, '$n$1$2', + appf(result, '$n$1$2', [spaces(indent+4), treeToYamlAux(n.sons[i], marker, indent + 4, maxRecDepth-1)]); end; - appRopeFormat(result, '$n$1]', [istr]); + appf(result, '$n$1]', [istr]); end end - end + end; + appf(result, ',$n$1"typ": $2', + [istr, typeToYamlAux(n.typ, marker, indent+2, maxRecDepth)]); end; - appRopeFormat(result, '$n$1}', [spaces(indent)]); + appf(result, '$n$1}', [spaces(indent)]); end end; @@ -523,19 +526,88 @@ begin end; // these are for debugging only: +function debugType(n: PType): PRope; +var + i: int; +begin + if n = nil then + result := toRope('null') + else begin + result := toRope(typeKindToStr[n.kind]); + app(result, '('+''); + for i := 0 to sonsLen(n)-1 do begin + if i > 0 then app(result, ', '); + if n.sons[i] = nil then app(result, 'null') + else app(result, debugType(n.sons[i])); + // app(result, typeKindToStr[n.sons[i].kind]); + end; + app(result, ')'+''); + end +end; + +function debugTree(n: PNode; indent: int; maxRecDepth: int): PRope; +var + istr: PRope; + i: int; +begin + if n = nil then + result := toRope('null') + else begin + istr := spaces(indent+2); + result := ropef('{$n$1"kind": $2', + [istr, makeYamlString(nodeKindToStr[n.kind])]); + if maxRecDepth <> 0 then begin + case n.kind of + nkCharLit..nkInt64Lit: + appf(result, '$n$1"intVal": $2', [istr, toRope(n.intVal)]); + nkFloatLit, nkFloat32Lit, nkFloat64Lit: + appf(result, '$n$1"floatVal": $2', + [istr, toRopeF(n.floatVal)]); + nkStrLit..nkTripleStrLit: + appf(result, '$n$1"strVal": $2', + [istr, makeYamlString(n.strVal)]); + nkSym: + appf(result, ',$n$1"sym": $2_$3', + [istr, toRope(n.sym.name.s), toRope(n.sym.id)]); + + nkIdent: begin + if n.ident <> nil then + appf(result, '$n$1"ident": $2', + [istr, makeYamlString(n.ident.s)]) + else + appf(result, '$n$1"ident": null', [istr]) + end + else begin + if sonsLen(n) > 0 then begin + appf(result, ',$n$1"sons": [', [istr]); + for i := 0 to sonsLen(n)-1 do begin + if i > 0 then app(result, ','+''); + appf(result, '$n$1$2', + [spaces(indent+4), + debugTree(n.sons[i], indent + 4, maxRecDepth-1)]); + end; + appf(result, '$n$1]', [istr]); + end + end + end; + end; + appf(result, '$n$1}', [spaces(indent)]); + end +end; + procedure debug(n: PSym); overload; begin - writeln(output, ropeToStr(symToYaml(n, 0, 3))); + writeln(output, ropeToStr(ropef('$1_$2', [toRope(n.name.s), toRope(n.id)]))); end; procedure debug(n: PType); overload; begin - writeln(output, ropeToStr(typeToYaml(n, 0, 3))); + writeln(output, ropeToStr(debugType(n))); end; procedure debug(n: PNode); overload; begin - writeln(output, ropeToStr(treeToYaml(n, 0, -1))); + writeln(output, ropeToStr(debugTree(n, 0, 100))); end; // -------------------- node sets -------------------------------------------- @@ -748,7 +820,8 @@ var begin h := n.name.h and high(data); while data[h] <> nil do begin - assert(data[h] <> n); + if data[h] = n then + InternalError(n.info, 'StrTableRawInsert: ' + n.name.s); h := nextTry(h, high(data)) end; assert(data[h] = nil); @@ -963,6 +1036,15 @@ begin result := -1 end; +function IdTableHasObjectAsKey(const t: TIdTable; key: PIdObj): bool; +var + index: int; +begin + index := IdTableRawGet(t, key); + if index >= 0 then result := t.data[index].key = key + else result := false +end; + function IdTableGet(const t: TIdTable; key: PIdObj): PObject; var index: int; @@ -999,6 +1081,7 @@ begin end else begin if mustRehash(length(t.data), t.counter) then begin + {@emit n := [];} setLength(n, length(t.data) * growthFactor); {@ignore} fillChar(n[0], length(n)*sizeof(n[0]), 0); @@ -1083,6 +1166,7 @@ begin end else begin if mustRehash(length(t.data), t.counter) then begin + {@emit n := [];} setLength(n, length(t.data) * growthFactor); {@ignore} fillChar(n[0], length(n)*sizeof(n[0]), 0); diff --git a/nim/bitsets.pas b/nim/bitsets.pas index 6270fbb6a..ba039a786 100644 --- a/nim/bitsets.pas +++ b/nim/bitsets.pas @@ -49,17 +49,20 @@ end; procedure BitSetIncl(var x: TBitSet; const elem: BiggestInt); begin - x[int(elem div ElemSize)] := x[int(elem div ElemSize)] or (1 shl (elem mod ElemSize)) + assert(elem >= 0); + x[int(elem div ElemSize)] := toU8(x[int(elem div ElemSize)] or + int(1 shl (elem mod ElemSize))) end; procedure BitSetExcl(var x: TBitSet; const elem: BiggestInt); begin - x[int(elem div ElemSize)] := x[int(elem div ElemSize)] and - not (1 shl (elem mod ElemSize)) + x[int(elem div ElemSize)] := toU8(x[int(elem div ElemSize)] and + not int(1 shl (elem mod ElemSize))) end; procedure BitSetInit(out b: TBitSet; len: int); begin + {@emit b := [];} setLength(b, len); {@ignore} fillChar(b[0], length(b)*sizeof(b[0]), 0); @@ -70,28 +73,28 @@ procedure BitSetUnion(var x: TBitSet; const y: TBitSet); var i: int; begin - for i := 0 to high(x) do x[i] := x[i] or int(y[i]) + for i := 0 to high(x) do x[i] := toU8(x[i] or int(y[i])) end; procedure BitSetDiff(var x: TBitSet; const y: TBitSet); var i: int; begin - for i := 0 to high(x) do x[i] := x[i] and not int(y[i]) + for i := 0 to high(x) do x[i] := toU8(x[i] and not int(y[i])) end; procedure BitSetSymDiff(var x: TBitSet; const y: TBitSet); var i: int; begin - for i := 0 to high(x) do x[i] := x[i] xor int(y[i]) + for i := 0 to high(x) do x[i] := toU8(x[i] xor int(y[i])) end; procedure BitSetIntersect(var x: TBitSet; const y: TBitSet); var i: int; begin - for i := 0 to high(x) do x[i] := x[i] and int(y[i]) + for i := 0 to high(x) do x[i] := toU8(x[i] and int(y[i])) end; function BitSetEquals(const x, y: TBitSet): Boolean; diff --git a/nim/ccgexprs.pas b/nim/ccgexprs.pas index 027f6a816..7668f114a 100644 --- a/nim/ccgexprs.pas +++ b/nim/ccgexprs.pas @@ -17,25 +17,34 @@ begin // Nimrod has the same bug for the same reasons :-) result := toRope('(-2147483647 -1)') else if i > low(int64) then - result := ropeFormat('IL64($1)', [toRope(i)]) + result := ropef('IL64($1)', [toRope(i)]) else result := toRope('(IL64(-9223372036854775807) - IL64(1))') end; +function int32Literal(i: Int): PRope; +begin + if i = low(int32) then + // Nimrod has the same bug for the same reasons :-) + result := toRope('(-2147483647 -1)') + else + result := toRope(i) +end; + function genHexLiteral(v: PNode): PRope; // in C hex literals are unsigned (at least I think so) // so we don't generate hex literals any longer. begin - assert(v.kind in [nkIntLit..nkInt64Lit]); + if not (v.kind in [nkIntLit..nkInt64Lit]) then + internalError(v.info, 'genHexLiteral'); result := intLiteral(v.intVal) end; -function getStrLit(const s: string): PRope; +function getStrLit(m: BModule; const s: string): PRope; begin - inc(currMod.unique); - result := con('Str', toRope(currMod.unique)); - appRopeFormat(currMod.s[cfsData], - 'STRING_LITERAL($1, $2, $3);$n', + inc(gunique); + result := con('Str', toRope(gunique)); + appf(m.s[cfsData], 'STRING_LITERAL($1, $2, $3);$n', [result, makeCString(s), ToRope(length(s))]) end; @@ -45,15 +54,21 @@ var begin if ty = nil then internalError(v.info, 'genLiteral: ty is nil'); case v.kind of - nkIntLit..nkInt64Lit, nkCharLit..nkRCharLit: begin + nkCharLit..nkInt64Lit: begin case skipVarGenericRange(ty).kind of - tyChar, tyInt..tyInt64, tyNil: result := intLiteral(v.intVal); + tyChar, tyInt64, tyNil: result := intLiteral(v.intVal); + tyInt..tyInt32: begin + if (v.intVal >= low(int32)) and (v.intVal <= high(int32)) then + result := int32Literal(int32(v.intVal)) + else + result := intLiteral(v.intVal); + end; tyBool: begin if v.intVal <> 0 then result := toRope('NIM_TRUE') - else result := toRope('NIM_FALSE'); + else result := toRope('NIM_FALSE'); end; else - result := ropeFormat('(($1) $2)', [getTypeDesc( + result := ropef('(($1) $2)', [getTypeDesc(p.module, skipVarGenericRange(ty)), intLiteral(v.intVal)]) end end; @@ -61,7 +76,7 @@ begin result := toRope('0'+''); nkStrLit..nkTripleStrLit: begin if skipVarGenericRange(ty).kind = tyString then - result := ropeFormat('((string) &$1)', [getStrLit(v.strVal)]) + result := ropef('((string) &$1)', [getStrLit(p.module, v.strVal)]) else result := makeCString(v.strVal) end; @@ -81,71 +96,7 @@ begin InternalError(v.info, 'genLiteral(' +{&} nodeKindToStr[v.kind] +{&} ')'); result := nil end - end; - (* - case ty.Kind of - tyRange: result := genLiteral(p, v, ty.sons[0]); - tyInt..tyInt64, tyEnum: - result := intLiteral(v.intVal); - tyPointer, tyRef, tyPtr, tyProc: - if v.kind = nkNilLit then - result := toRope('0'+'') // 0 is better for C++ - else - result := ropeFormat('(($1) $2)', - [getTypeDesc(ty), intLiteral(v.intVal)]); - tyFloat..tyFloat128: begin - f := v.floatVal; - // BUGFIX: handle INF and NAN correctly: - if f <> f then // NAN - result := toRope('NAN') - else if f = 0.0 then - result := toRopeF(f) - else if f = 0.5 * f then - if f > 0.0 then - result := toRope('INF') - else - result := toRope('-INF') - else - result := toRopeF(f); - end; - tyString: begin // also merges constants - if v.kind = nkNilLit then result := toRope('0'+'') - else result := ropeFormat('((string) &$1)', [getStrLit(v.strVal)]); - end; - tyCString: begin - if v.kind = nkNilLit then - result := toRope('0'+'') - else if v.kind in [nkIntLit..nkInt64Lit] then begin - result := ropeFormat('((NCSTRING) $1)', [intLiteral(v.intVal)]) - end - else - result := makeCString(v.strVal) - end; - tySequence: begin - if v.kind = nkNilLit then - result := toRope('0'+'') - else if v.kind in [nkIntLit..nkInt64Lit] then - result := ropeFormat('(($1) $2)', - [getTypeDesc(ty), intLiteral(v.intVal)]) - else begin - assert(false); - result := nil // XXX: to implement - end - end; - tyChar: begin - result := toRope('''' + toCChar(Chr(int(v.intVal))) + '''') - end; - tyBool: - if v.intVal <> 0 then result := toRope('NIM_TRUE') - else result := toRope('NIM_FALSE'); - tyNil: - result := toRope('0'+''); // 0-pointer is better for C++ - tyVar: result := genLiteral(p, v, ty.sons[0]); - else begin - InternalError(v.info, 'genLiteral(' +{&} typeKindToStr[ty.kind] +{&} ')'); - result := nil - end - end*) + end end; function genLiteral(p: BProc; v: PNode): PRope; overload; @@ -160,11 +111,13 @@ begin result := 0; if CPU[hostCPU].endian = CPU[targetCPU].endian then begin for j := 0 to size-1 do - if j < length(s) then result := result or shlu(s[j], j * 8) + if j < length(s) then + result := result or shlu(Ze64(s[j]), j * 8) end else begin for j := 0 to size-1 do - if j < length(s) then result := result or shlu(s[j], (Size - 1 - j) * 8) + if j < length(s) then + result := result or shlu(Ze64(s[j]), (Size-1-j) * 8) end end; @@ -181,11 +134,11 @@ begin else frmt := '0x$1, ' end else frmt := '0x$1}$n'; - appRopeFormat(result, frmt, [toRope(toHex(cs[i], 2))]) + appf(result, frmt, [toRope(toHex(Ze64(cs[i]), 2))]) end end else - result := toRope('0x' + ToHex(bitSetToWord(cs, size), IntSize * 2)) + result := toRope('0x' + ToHex(bitSetToWord(cs, size), size * 2)) end; function genSetNode(p: BProc; n: PNode): PRope; @@ -197,9 +150,9 @@ begin toBitSet(n, cs); if size > 8 then begin result := getTempName(); - appRopeFormat(currMod.s[cfsData], - 'static $1$2 $3 = $4;', // BUGFIX - [constTok, getTypeDesc(n.typ), result, genRawSetData(cs, size)]) + appf(p.module.s[cfsData], + 'static NIM_CONST $1 $2 = $3;', + [getTypeDesc(p.module, n.typ), result, genRawSetData(cs, size)]) end else result := genRawSetData(cs, size) @@ -207,22 +160,45 @@ end; // --------------------------- assignment generator ----------------------- +function getStorageLoc(n: PNode): TStorageLoc; +begin + case n.kind of + nkSym: begin + case n.sym.kind of + skParam, skForVar, skTemp: result := OnStack; + skVar: begin + if sfGlobal in n.sym.flags then result := OnHeap + else result := OnStack + end; + else result := OnUnknown; + end + end; + //nkHiddenAddr, nkAddr: + nkDerefExpr, nkHiddenDeref: + case n.sons[0].typ.kind of + tyVar: result := OnUnknown; + tyPtr: result := OnStack; + tyRef: result := OnHeap; + else InternalError(n.info, 'getStorageLoc'); + end; + nkBracketExpr, nkDotExpr, nkObjDownConv, nkObjUpConv: + result := getStorageLoc(n.sons[0]); + else result := OnUnknown; + end +end; + function rdLoc(const a: TLoc): PRope; // 'read' location (deref if indirect) begin result := a.r; - if a.indirect > 0 then - result := ropeFormat('($2$1)', - [result, toRope(repeatChar(a.indirect, '*'))]) + if lfIndirect in a.flags then + result := ropef('(*$1 /*rdLoc*/)', [result]) end; function addrLoc(const a: TLoc): PRope; begin result := a.r; - if a.indirect = 0 then + if not (lfIndirect in a.flags) then result := con('&'+'', result) - else if a.indirect > 1 then - result := ropeFormat('($2$1)', - [result, toRope(repeatChar(a.indirect-1, '*'))]) end; function rdCharLoc(const a: TLoc): PRope; @@ -230,22 +206,22 @@ function rdCharLoc(const a: TLoc): PRope; begin result := rdLoc(a); if skipRange(a.t).kind = tyChar then - result := ropeFormat('((NU8)($1))', [result]) + result := ropef('((NU8)($1))', [result]) end; procedure genRefAssign(p: BProc; const dest, src: TLoc); begin - if (lfOnStack in dest.flags) or not (optRefcGC in gGlobalOptions) then + if (dest.s = OnStack) or not (optRefcGC in gGlobalOptions) then // location is on hardware stack - appRopeFormat(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]) - else if lfOnHeap in dest.flags then begin // location is on heap - UseMagic('asgnRef'); - appRopeFormat(p.s[cpsStmts], 'asgnRef((void**) $1, $2);$n', + appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]) + else if dest.s = OnHeap then begin // location is on heap + UseMagic(p.module, 'asgnRef'); + appf(p.s[cpsStmts], 'asgnRef((void**) $1, $2);$n', [addrLoc(dest), rdLoc(src)]) end else begin - UseMagic('unsureAsgnRef'); - appRopeFormat(p.s[cpsStmts], 'unsureAsgnRef((void**) $1, $2);$n', + UseMagic(p.module, 'unsureAsgnRef'); + appf(p.s[cpsStmts], 'unsureAsgnRef((void**) $1, $2);$n', [addrLoc(dest), rdLoc(src)]) end end; @@ -261,8 +237,7 @@ procedure genAssignment(p: BProc; const dest, src: TLoc; var ty: PType; begin; - ty := skipAbstract(dest.t); - while ty.kind = tyVar do ty := ty.sons[0]; + ty := skipVarGenericRange(dest.t); case ty.kind of tyRef: genRefAssign(p, dest, src); @@ -270,92 +245,89 @@ begin; if not (needToCopy in flags) then genRefAssign(p, dest, src) else begin - useMagic('genericSeqAssign'); // BUGFIX - appRopeFormat(p.s[cpsStmts], 'genericSeqAssign($1, $2, $3);$n', - [addrLoc(dest), rdLoc(src), genTypeInfo(currMod, dest.t)]) + useMagic(p.module, 'genericSeqAssign'); // BUGFIX + appf(p.s[cpsStmts], 'genericSeqAssign($1, $2, $3);$n', + [addrLoc(dest), rdLoc(src), genTypeInfo(p.module, dest.t)]) end end; tyString: begin if not (needToCopy in flags) then genRefAssign(p, dest, src) else begin - useMagic('copyString'); - if (lfOnStack in dest.flags) or not (optRefcGC in gGlobalOptions) then - // location is on hardware stack - appRopeFormat(p.s[cpsStmts], '$1 = copyString($2);$n', + useMagic(p.module, 'copyString'); + if (dest.s = OnStack) or not (optRefcGC in gGlobalOptions) then + appf(p.s[cpsStmts], '$1 = copyString($2);$n', [rdLoc(dest), rdLoc(src)]) - else if lfOnHeap in dest.flags then begin // location is on heap - useMagic('asgnRef'); - useMagic('copyString'); // BUGFIX - appRopeFormat(p.s[cpsStmts], 'asgnRef((void**) $1, copyString($2));$n', + else if dest.s = OnHeap then begin + useMagic(p.module, 'asgnRef'); + useMagic(p.module, 'copyString'); // BUGFIX + appf(p.s[cpsStmts], 'asgnRef((void**) $1, copyString($2));$n', [addrLoc(dest), rdLoc(src)]) end else begin - useMagic('unsureAsgnRef'); - useMagic('copyString'); // BUGFIX - appRopeFormat(p.s[cpsStmts], + useMagic(p.module, 'unsureAsgnRef'); + useMagic(p.module, 'copyString'); // BUGFIX + appf(p.s[cpsStmts], 'unsureAsgnRef((void**) $1, copyString($2));$n', [addrLoc(dest), rdLoc(src)]) end end end; - tyRecordConstr, tyRecord: - // BUGFIX + tyTuple: if needsComplexAssignment(dest.t) then begin - useMagic('genericAssign'); - appRopeFormat(p.s[cpsStmts], + useMagic(p.module, 'genericAssign'); + appf(p.s[cpsStmts], 'genericAssign((void*)$1, (void*)$2, $3);$n', - [addrLoc(dest), addrLoc(src), genTypeInfo(currMod, dest.t)]) + [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) end else - appRopeFormat(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); + appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); tyArray, tyArrayConstr: if needsComplexAssignment(dest.t) then begin - useMagic('genericAssign'); - appRopeFormat(p.s[cpsStmts], + useMagic(p.module, 'genericAssign'); + appf(p.s[cpsStmts], 'genericAssign((void*)$1, (void*)$2, $3);$n', - // XXX: is this correct for arrays? - [addrLoc(dest), addrLoc(src), genTypeInfo(currMod, dest.t)]) + [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) end else - appRopeFormat(p.s[cpsStmts], - 'memcpy((void*)$1, (const void*)$2, sizeof($1));$n', - [addrLoc(dest), addrLoc(src)]); + appf(p.s[cpsStmts], + 'memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1));$n', + [rdLoc(dest), rdLoc(src)]); tyObject: // XXX: check for subtyping? if needsComplexAssignment(dest.t) then begin - useMagic('genericAssign'); - appRopeFormat(p.s[cpsStmts], + useMagic(p.module, 'genericAssign'); + appf(p.s[cpsStmts], 'genericAssign((void*)$1, (void*)$2, $3);$n', - [addrLoc(dest), addrLoc(src), genTypeInfo(currMod, dest.t)]) + [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) end else - appRopeFormat(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); + appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); tyOpenArray: begin - // open arrays are always on the stack, really? What if a sequence is + // open arrays are always on the stack - really? What if a sequence is // passed to an open array? if needsComplexAssignment(dest.t) then begin - useMagic('genericAssignOpenArray'); - appRopeFormat(p.s[cpsStmts],// XXX: is this correct for arrays? + useMagic(p.module, 'genericAssignOpenArray'); + appf(p.s[cpsStmts],// XXX: is this correct for arrays? 'genericAssignOpenArray((void*)$1, (void*)$2, $1Len0, $3);$n', - [addrLoc(dest), addrLoc(src), genTypeInfo(currMod, dest.t)]) + [addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)]) end else - appRopeFormat(p.s[cpsStmts], - 'memcpy((void*)$1, (const void*)$2, sizeof($1[0])*$1Len0);$n', - [addrLoc(dest), addrLoc(src)]); + appf(p.s[cpsStmts], + 'memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1[0])*$1Len0);$n', + [rdLoc(dest), rdLoc(src)]); end; tySet: - if getSize(ty) <= 8 then - appRopeFormat(p.s[cpsStmts], '$1 = $2;$n', - [rdLoc(dest), rdLoc(src)]) + if mapType(ty) = ctArray then + appf(p.s[cpsStmts], 'memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n', + [rdLoc(dest), rdLoc(src), toRope(getSize(dest.t))]) else - appRopeFormat(p.s[cpsStmts], 'memcpy((void*)$1, (const void*)$2, $3);$n', - [rdLoc(dest), rdLoc(src), toRope(getSize(dest.t))]); + appf(p.s[cpsStmts], '$1 = $2;$n', + [rdLoc(dest), rdLoc(src)]); tyPtr, tyPointer, tyChar, tyBool, tyProc, tyEnum, tyCString, tyInt..tyFloat128, tyRange: - appRopeFormat(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); + appf(p.s[cpsStmts], '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]); else InternalError('genAssignment(' + typeKindToStr[ty.kind] + ')') end @@ -367,7 +339,7 @@ procedure expr(p: BProc; e: PNode; var d: TLoc); forward; function initLocExpr(p: BProc; e: PNode): TLoc; begin - result := initLoc(locNone, e.typ); + result := initLoc(locNone, getUniqueType(e.typ), OnUnknown); expr(p, e, result) end; @@ -392,7 +364,7 @@ var a: TLoc; begin if d.k <> locNone then begin // need to generate an assignment here - a := initLoc(locExpr, t); + a := initLoc(locExpr, getUniqueType(t), OnUnknown); a.r := r; if lfNoDeepCopy in d.flags then genAssignment(p, d, a, {@set}[]) @@ -402,7 +374,7 @@ begin else begin // we cannot call initLoc() here as that would overwrite // the flags field! d.k := locExpr; - d.t := t; + d.t := getUniqueType(t); d.r := r; d.a := -1 end @@ -413,12 +385,11 @@ procedure binaryStmt(p: BProc; e: PNode; var d: TLoc; var a, b: TLoc; begin - assert(d.k = locNone); - if magic <> '' then - useMagic(magic); + if (d.k <> locNone) then InternalError(e.info, 'binaryStmt'); + if magic <> '' then useMagic(p.module, magic); a := InitLocExpr(p, e.sons[1]); b := InitLocExpr(p, e.sons[2]); - appRopeFormat(p.s[cpsStmts], frmt, [rdLoc(a), rdLoc(b)]); + appf(p.s[cpsStmts], frmt, [rdLoc(a), rdLoc(b)]); freeTemp(p, a); freeTemp(p, b) end; @@ -428,12 +399,11 @@ procedure binaryStmtChar(p: BProc; e: PNode; var d: TLoc; var a, b: TLoc; begin - assert(d.k = locNone); - if magic <> '' then - useMagic(magic); + if (d.k <> locNone) then InternalError(e.info, 'binaryStmtChar'); + if magic <> '' then useMagic(p.module, magic); a := InitLocExpr(p, e.sons[1]); b := InitLocExpr(p, e.sons[2]); - appRopeFormat(p.s[cpsStmts], frmt, [rdCharLoc(a), rdCharLoc(b)]); + appf(p.s[cpsStmts], frmt, [rdCharLoc(a), rdCharLoc(b)]); freeTemp(p, a); freeTemp(p, b) end; @@ -443,13 +413,12 @@ procedure binaryExpr(p: BProc; e: PNode; var d: TLoc; var a, b: TLoc; begin - if magic <> '' then - useMagic(magic); + if magic <> '' then useMagic(p.module, magic); assert(e.sons[1].typ <> nil); assert(e.sons[2].typ <> nil); a := InitLocExpr(p, e.sons[1]); b := InitLocExpr(p, e.sons[2]); - putIntoDest(p, d, e.typ, ropeFormat(frmt, [rdLoc(a), rdLoc(b)])); + putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a), rdLoc(b)])); if d.k <> locExpr then begin // BACKPORT freeTemp(p, a); freeTemp(p, b) @@ -461,13 +430,12 @@ procedure binaryExprChar(p: BProc; e: PNode; var d: TLoc; var a, b: TLoc; begin - if magic <> '' then - useMagic(magic); + if magic <> '' then useMagic(p.module, magic); assert(e.sons[1].typ <> nil); assert(e.sons[2].typ <> nil); a := InitLocExpr(p, e.sons[1]); b := InitLocExpr(p, e.sons[2]); - putIntoDest(p, d, e.typ, ropeFormat(frmt, [rdCharLoc(a), rdCharLoc(b)])); + putIntoDest(p, d, e.typ, ropef(frmt, [rdCharLoc(a), rdCharLoc(b)])); if d.k <> locExpr then begin // BACKPORT freeTemp(p, a); freeTemp(p, b) @@ -479,10 +447,9 @@ procedure unaryExpr(p: BProc; e: PNode; var d: TLoc; var a: TLoc; begin - if magic <> '' then - useMagic(magic); + if magic <> '' then useMagic(p.module, magic); a := InitLocExpr(p, e.sons[1]); - putIntoDest(p, d, e.typ, ropeFormat(frmt, [rdLoc(a)])); + putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a)])); if d.k <> locExpr then // BACKPORT freeTemp(p, a) end; @@ -492,10 +459,9 @@ procedure unaryExprChar(p: BProc; e: PNode; var d: TLoc; var a: TLoc; begin - if magic <> '' then - useMagic(magic); + if magic <> '' then useMagic(p.module, magic); a := InitLocExpr(p, e.sons[1]); - putIntoDest(p, d, e.typ, ropeFormat(frmt, [rdCharLoc(a)])); + putIntoDest(p, d, e.typ, ropef(frmt, [rdCharLoc(a)])); if d.k <> locExpr then // BACKPORT freeTemp(p, a) end; @@ -510,15 +476,15 @@ const '($1 + $2)', '($1 - $2)', '($1 * $2)', '($1 / $2)', '($1 % $2)' ); binArithTab: array [mShrI..mXor] of string = ( - '(NS)((NU)($1) >> (NU)($2))', // ShrI - '(NS)((NU)($1) << (NU)($2))', // ShlI + '(NI)((NU)($1) >> (NU)($2))', // ShrI + '(NI)((NU)($1) << (NU)($2))', // ShlI '($1 & $2)', // BitandI '($1 | $2)', // BitorI '($1 ^ $2)', // BitxorI '(($1 <= $2) ? $1 : $2)', // MinI '(($1 >= $2) ? $1 : $2)', // MaxI - '(NS64)((NU64)($1) >> (NU64)($2))', // ShrI64 - '(NS64)((NU64)($1) << (NU64)($2))', // ShlI64 + '(NI64)((NU64)($1) >> (NU64)($2))', // ShrI64 + '(NI64)((NU64)($1) << (NU64)($2))', // ShlI64 '($1 & $2)', // BitandI64 '($1 | $2)', // BitorI64 '($1 ^ $2)', // BitxorI64 @@ -532,16 +498,16 @@ const '(($1 <= $2) ? $1 : $2)', // MinF64 '(($1 >= $2) ? $1 : $2)', // MaxF64 - '(NS)((NU)($1) + (NU)($2))', // AddU - '(NS)((NU)($1) - (NU)($2))', // SubU - '(NS)((NU)($1) * (NU)($2))', // MulU - '(NS)((NU)($1) / (NU)($2))', // DivU - '(NS)((NU)($1) % (NU)($2))', // ModU - '(NS64)((NU64)($1) + (NU64)($2))', // AddU64 - '(NS64)((NU64)($1) - (NU64)($2))', // SubU64 - '(NS64)((NU64)($1) * (NU64)($2))', // MulU64 - '(NS64)((NU64)($1) / (NU64)($2))', // DivU64 - '(NS64)((NU64)($1) % (NU64)($2))', // ModU64 + '(NI)((NU)($1) + (NU)($2))', // AddU + '(NI)((NU)($1) - (NU)($2))', // SubU + '(NI)((NU)($1) * (NU)($2))', // MulU + '(NI)((NU)($1) / (NU)($2))', // DivU + '(NI)((NU)($1) % (NU)($2))', // ModU + '(NI64)((NU64)($1) + (NU64)($2))', // AddU64 + '(NI64)((NU64)($1) - (NU64)($2))', // SubU64 + '(NI64)((NU64)($1) * (NU64)($2))', // MulU64 + '(NI64)((NU64)($1) / (NU64)($2))', // DivU64 + '(NI64)((NU64)($1) % (NU64)($2))', // ModU64 '($1 == $2)', // EqI '($1 <= $2)', // LeI @@ -587,11 +553,16 @@ const '-($1)', // UnaryMinusF64 '($1 > 0? ($1) : -($1))', // AbsF64; BUGFIX: fabs() makes problems for Tiny C, so we don't use it - '((NS)(NU)($1))', // Ze - '((NS64)(NU64)($1))', // Ze64 - '((NS8)(NU8)(NU)($1))', // ToU8 - '((NS16)(NU16)(NU)($1))', // ToU16 - '((NS32)(NU32)(NU64)($1))', // ToU32 + '((NI)(NU)(NU8)($1))', // mZe8ToI + '((NI64)(NU64)(NU8)($1))', // mZe8ToI64 + '((NI)(NU)(NU16)($1))', // mZe16ToI + '((NI64)(NU64)(NU16)($1))', // mZe16ToI64 + '((NI64)(NU64)(NU32)($1))', // mZe32ToI64 + '((NI64)(NU64)(NU)($1))', // mZeIToI64 + + '((NI8)(NU8)(NU)($1))', // ToU8 + '((NI16)(NU16)(NU)($1))', // ToU16 + '((NI32)(NU32)(NU64)($1))', // ToU32 '((double) ($1))', // ToFloat '((double) ($1))', // ToBiggestFloat @@ -641,29 +612,42 @@ procedure genDeref(p: BProc; e: PNode; var d: TLoc); var a: TLoc; begin - a := initLocExpr(p, e.sons[0]); - putIntoDest(p, d, a.t.sons[0], ropeFormat('(*$1)', [rdLoc(a)])); - if d.k <> locExpr then // BACKPORT - freeTemp(p, a) + if mapType(e.sons[0].typ) = ctArray then + expr(p, e.sons[0], d) + else begin + a := initLocExpr(p, e.sons[0]); + case skipGeneric(a.t).kind of + tyRef: d.s := OnHeap; + tyVar: d.s := OnUnknown; + tyPtr: d.s := OnStack; + else InternalError(e.info, 'genDeref ' + typekindToStr[a.t.kind]); + end; + putIntoDest(p, d, a.t.sons[0], ropef('(*$1)', [rdLoc(a)])); + end end; -procedure fillInLocation(var a, d: TLoc); +procedure genAddr(p: BProc; e: PNode; var d: TLoc); +var + a: TLoc; begin - case skipAbstract(a.t).kind of - tyRef: begin - if d.k = locNone then d.flags := {@set}[lfOnHeap]; - a.r := ropeFormat('(*$1)', [a.r]) - end; - tyPtr: begin - if d.k = locNone then d.flags := {@set}[lfOnUnknown]; - a.r := ropeFormat('(*$1)', [a.r]) - end; - // element has same flags as the array (except lfIndirect): - else - if d.k = locNone then inheritStorage(d, a) + if mapType(e.sons[0].typ) = ctArray then + expr(p, e.sons[0], d) + else begin + a := InitLocExpr(p, e.sons[0]); + putIntoDest(p, d, e.typ, addrLoc(a)); + if d.k <> locExpr then freeTemp(p, a) end end; +function genRecordFieldAux(p: BProc; e: PNode; var d, a: TLoc): PType; +begin + a := initLocExpr(p, e.sons[0]); + if (e.sons[1].kind <> nkSym) then InternalError(e.info, 'genRecordFieldAux'); + if d.k = locNone then d.s := a.s; + {@discard} getTypeDesc(p.module, a.t); // fill the record's fields.loc + result := getUniqueType(a.t); +end; + procedure genRecordField(p: BProc; e: PNode; var d: TLoc); var a: TLoc; @@ -671,45 +655,76 @@ var ty: PType; r: PRope; begin - a := initLocExpr(p, e.sons[0]); - assert(e.sons[1].kind = nkSym); - f := e.sons[1].sym; - - if d.k = locNone then inheritStorage(d, a); - // for objects we have to search the hierarchy for determining - // how much ``Sup`` we need: - ty := skipAbstract(a.t); - while true do begin - case ty.kind of - tyRef: begin - if d.k = locNone then d.flags := {@set}[lfOnHeap]; - inc(a.indirect); - end; - tyPtr: begin - if d.k = locNone then d.flags := {@set}[lfOnUnknown]; - inc(a.indirect); - end; - tyVar: begin - if d.k = locNone then d.flags := {@set}[lfOnUnknown]; - end; - else break - end; - ty := skipAbstract(ty.sons[0]); - end; + ty := genRecordFieldAux(p, e, d, a); r := rdLoc(a); - {@discard} getTypeDesc(ty); // fill the record's fields.loc + f := e.sons[1].sym; field := nil; while ty <> nil do begin - assert(ty.kind in [tyRecord, tyObject]); + assert(ty.kind in [tyTuple, tyObject]); field := lookupInRecord(ty.n, f.name); if field <> nil then break; if gCmd <> cmdCompileToCpp then app(r, '.Sup'); - ty := ty.sons[0] + ty := GetUniqueType(ty.sons[0]); end; - assert((field <> nil) and (field.loc.r <> nil)); - appRopeFormat(r, '.$1', [field.loc.r]); + if field = nil then InternalError(e.info, 'genRecordField'); + if field.loc.r = nil then InternalError(e.info, 'genRecordField'); + appf(r, '.$1', [field.loc.r]); putIntoDest(p, d, field.typ, r); - // freeTemp(p, a) // BACKPORT +end; + +procedure genInExprAux(p: BProc; e: PNode; var a, b, d: TLoc); forward; + +procedure genCheckedRecordField(p: BProc; e: PNode; var d: TLoc); +var + a, u, v, test: TLoc; + f, field, op: PSym; + ty: PType; + r: PRope; + i: int; + it: PNode; +begin + if optFieldCheck in p.options then begin + useMagic(p.module, 'raiseFieldError'); + ty := genRecordFieldAux(p, e.sons[0], d, a); + r := rdLoc(a); + f := e.sons[0].sons[1].sym; + field := nil; + while ty <> nil do begin + assert(ty.kind in [tyTuple, tyObject]); + field := lookupInRecord(ty.n, f.name); + if field <> nil then break; + if gCmd <> cmdCompileToCpp then app(r, '.Sup'); + ty := getUniqueType(ty.sons[0]) + end; + if field = nil then InternalError(e.info, 'genCheckedRecordField'); + if field.loc.r = nil then InternalError(e.info, 'genCheckedRecordField'); + // generate the checks: + for i := 1 to sonsLen(e)-1 do begin + it := e.sons[i]; + assert(it.kind = nkCall); + assert(it.sons[0].kind = nkSym); + op := it.sons[0].sym; + if op.magic = mNot then it := it.sons[1]; + assert(it.sons[2].kind = nkSym); + test := initLoc(locNone, it.typ, OnStack); + u := InitLocExpr(p, it.sons[1]); + v := initLoc(locExpr, it.sons[2].typ, OnUnknown); + v.r := ropef('$1.$2', [r, it.sons[2].sym.loc.r]); + genInExprAux(p, it, u, v, test); + if op.magic = mNot then + appf(p.s[cpsStmts], + 'if ($1) raiseFieldError(((string) &$2));$n', + [rdLoc(test), getStrLit(p.module, field.name.s)]) + else + appf(p.s[cpsStmts], + 'if (!($1)) raiseFieldError(((string) &$2));$n', + [rdLoc(test), getStrLit(p.module, field.name.s)]) + end; + appf(r, '.$1', [field.loc.r]); + putIntoDest(p, d, field.typ, r); + end + else + genRecordField(p, e.sons[0], d) end; procedure genArrayElem(p: BProc; e: PNode; var d: TLoc); @@ -720,19 +735,18 @@ var begin a := initLocExpr(p, e.sons[0]); b := initLocExpr(p, e.sons[1]); - ty := skipAbstract(a.t); - if ty.kind in [tyRef, tyPtr] then ty := skipAbstract(ty.sons[0]); + ty := skipPtrsGeneric(skipVarGenericRange(a.t)); first := intLiteral(firstOrd(ty)); // emit range check: if optBoundsCheck in p.options then if b.k <> locImmediate then begin // semantic pass has already checked: - useMagic('raiseIndexError'); - appRopeFormat(p.s[cpsStmts], + useMagic(p.module, 'raiseIndexError'); + appf(p.s[cpsStmts], 'if ($1 < $2 || $1 > $3) raiseIndexError();$n', [rdCharLoc(b), first, intLiteral(lastOrd(ty))]) end; - fillInLocation(a, d); - putIntoDest(p, d, elemType(skipVarGeneric(ty)), ropeFormat('$1[($2)-$3]', + if d.k = locNone then d.s := a.s; + putIntoDest(p, d, elemType(skipVarGeneric(ty)), ropef('$1[($2)-$3]', [rdLoc(a), rdCharLoc(b), first])); // freeTemp(p, a); // backport // freeTemp(p, b) @@ -745,9 +759,9 @@ var begin a := initLocExpr(p, e.sons[0]); b := initLocExpr(p, e.sons[1]); - ty := skipAbstract(a.t); - fillInLocation(a, d); - putIntoDest(p, d, elemType(skipVarGeneric(ty)), ropeFormat('$1[$2]', + ty := skipVarGenericRange(a.t); + if d.k = locNone then d.s := a.s; + putIntoDest(p, d, elemType(skipVarGeneric(ty)), ropef('$1[$2]', [rdLoc(a), rdCharLoc(b)])); // freeTemp(p, a); // backport // freeTemp(p, b) @@ -760,14 +774,13 @@ begin a := initLocExpr(p, e.sons[0]); b := initLocExpr(p, e.sons[1]); // emit range check: - if optBoundsCheck in p.options then - if b.k <> locImmediate then begin // semantic pass has already checked: - useMagic('raiseIndexError'); - appRopeFormat(p.s[cpsStmts], - 'if ((NU)($1) > (NU)($2Len0)) raiseIndexError();$n', [rdLoc(b), a.r]) - end; - if d.k = locNone then inheritStorage(d, a); - putIntoDest(p, d, elemType(skipVarGeneric(a.t)), ropeFormat('$1[$2]', + if optBoundsCheck in p.options then begin + useMagic(p.module, 'raiseIndexError'); + appf(p.s[cpsStmts], + 'if ((NU)($1) > (NU)($2Len0)) raiseIndexError();$n', [rdLoc(b), a.r]) + end; + if d.k = locNone then d.s := a.s; + putIntoDest(p, d, elemType(skipVarGeneric(a.t)), ropef('$1[$2]', [rdLoc(a), rdCharLoc(b)])); // freeTemp(p, a); // backport // freeTemp(p, b) @@ -780,26 +793,24 @@ var begin a := initLocExpr(p, e.sons[0]); b := initLocExpr(p, e.sons[1]); - ty := skipAbstract(a.t); - if ty.kind in [tyRef, tyPtr] then ty := skipAbstract(ty.sons[0]); + ty := skipVarGenericRange(a.t); + if ty.kind in [tyRef, tyPtr] then ty := skipVarGenericRange(ty.sons[0]); // emit range check: - if optBoundsCheck in p.options then - if b.k <> locImmediate then begin // semantic pass has already checked: - useMagic('raiseIndexError'); - if ty.kind = tyString then - appRopeFormat(p.s[cpsStmts], - 'if ((NU)($1) > (NU)($2->len)) raiseIndexError();$n', - [rdLoc(b), rdLoc(a)]) - else - appRopeFormat(p.s[cpsStmts], - 'if ((NU)($1) >= (NU)($2->len)) raiseIndexError();$n', - [rdLoc(b), rdLoc(a)]) - end; - // element has same flags as the array (except lfIndirect): - if d.k = locNone then d.flags := {@set}[lfOnHeap]; - if skipAbstract(a.t).kind in [tyRef, tyPtr] then - a.r := ropeFormat('(*$1)', [a.r]); - putIntoDest(p, d, elemType(skipVarGeneric(a.t)), ropeFormat('$1->data[$2]', + if optBoundsCheck in p.options then begin + useMagic(p.module, 'raiseIndexError'); + if ty.kind = tyString then + appf(p.s[cpsStmts], + 'if ((NU)($1) > (NU)($2->len)) raiseIndexError();$n', + [rdLoc(b), rdLoc(a)]) + else + appf(p.s[cpsStmts], + 'if ((NU)($1) >= (NU)($2->len)) raiseIndexError();$n', + [rdLoc(b), rdLoc(a)]) + end; + if d.k = locNone then d.s := OnHeap; + if skipVarGenericRange(a.t).kind in [tyRef, tyPtr] then + a.r := ropef('(*$1)', [a.r]); + putIntoDest(p, d, elemType(skipVarGeneric(a.t)), ropef('$1->data[$2]', [rdLoc(a), rdCharLoc(b)])); // freeTemp(p, a); // backport // freeTemp(p, b) @@ -834,9 +845,9 @@ begin expr(p, e.sons[1], tmp); L := getLabel(p); if m = mOr then - appRopeFormat(p.s[cpsStmts], 'if ($1) goto $2;$n', [rdLoc(tmp), L]) + appf(p.s[cpsStmts], 'if ($1) goto $2;$n', [rdLoc(tmp), L]) else // mAnd: - appRopeFormat(p.s[cpsStmts], 'if (!($1)) goto $2;$n', [rdLoc(tmp), L]); + appf(p.s[cpsStmts], 'if (!($1)) goto $2;$n', [rdLoc(tmp), L]); expr(p, e.sons[2], tmp); fixLabel(p, L); if d.k = locNone then @@ -874,10 +885,10 @@ begin nkElifExpr: begin a := initLocExpr(p, it.sons[0]); Lelse := getLabel(p); - appRopeFormat(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Lelse]); + appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Lelse]); freeTemp(p, a); expr(p, it.sons[1], tmp); - appRopeFormat(p.s[cpsStmts], 'goto $1;$n', [Lend]); + appf(p.s[cpsStmts], 'goto $1;$n', [Lend]); fixLabel(p, Lelse); end; nkElseExpr: begin @@ -905,9 +916,12 @@ var op, list: TLoc; len, i: int; begin +{@emit + a := []; +} op := initLocExpr(p, t.sons[0]); pl := con(op.r, '('+''); - typ := t.sons[0].typ; + typ := getUniqueType(t.sons[0].typ); assert(typ.kind = tyProc); invalidRetType := isInvalidReturnType(typ.sons[0]); len := sonsLen(t); @@ -918,8 +932,8 @@ begin if (i < sonsLen(typ)) then begin assert(typ.n.sons[i].kind = nkSym); param := typ.n.sons[i].sym; - if usePtrPassing(param) then app(pl, addrLoc(a[i-1])) - else app(pl, rdLoc(a[i-1])); + if ccgIntroducedPtr(param) then app(pl, addrLoc(a[i-1])) + else app(pl, rdLoc(a[i-1])); end else app(pl, rdLoc(a[i-1])); @@ -928,7 +942,7 @@ begin end; if (typ.sons[0] <> nil) and invalidRetType then begin if d.k = locNone then d := getTemp(p, typ.sons[0]); - app(pl, addrLoc(d)) + app(pl, addrLoc(d)); end; app(pl, ')'+''); for i := 0 to high(a) do @@ -938,12 +952,12 @@ begin if d.k = locNone then d := getTemp(p, typ.sons[0]); assert(d.t <> nil); // generate an assignment to d: - list := initLoc(locCall, nil); + list := initLoc(locCall, nil, OnUnknown); list.r := pl; genAssignment(p, d, list, {@set}[]) // no need for deep copying end else - appRopeFormat(p.s[cpsStmts], '$1;$n', [pl]) + appf(p.s[cpsStmts], '$1;$n', [pl]) end; procedure genStrConcat(p: BProc; e: PNode; var d: TLoc); @@ -969,30 +983,33 @@ var appends, lens: PRope; L, i: int; begin - useMagic('rawNewString'); + useMagic(p.module, 'rawNewString'); tmp := getTemp(p, e.typ); L := 0; appends := nil; lens := nil; +{@emit + a := []; +} setLength(a, sonsLen(e)-1); for i := 0 to sonsLen(e)-2 do begin // compute the length expression: a[i] := initLocExpr(p, e.sons[i+1]); - if skipAbstract(e.sons[i+1].Typ).kind = tyChar then begin + if skipVarGenericRange(e.sons[i+1].Typ).kind = tyChar then begin Inc(L); - useMagic('appendChar'); - appRopeFormat(appends, 'appendChar($1, $2);$n', [tmp.r, rdLoc(a[i])]) + useMagic(p.module, 'appendChar'); + appf(appends, 'appendChar($1, $2);$n', [tmp.r, rdLoc(a[i])]) end else begin if e.sons[i+1].kind in [nkStrLit..nkTripleStrLit] then // string literal? Inc(L, length(e.sons[i+1].strVal)) else - appRopeFormat(lens, '$1->len + ', [rdLoc(a[i])]); - useMagic('appendString'); - appRopeFormat(appends, 'appendString($1, $2);$n', [tmp.r, rdLoc(a[i])]) + appf(lens, '$1->len + ', [rdLoc(a[i])]); + useMagic(p.module, 'appendString'); + appf(appends, 'appendString($1, $2);$n', [tmp.r, rdLoc(a[i])]) end end; - appRopeFormat(p.s[cpsStmts], '$1 = rawNewString($2$3);$n', + appf(p.s[cpsStmts], '$1 = rawNewString($2$3);$n', [tmp.r, lens, toRope(L)]); app(p.s[cpsStmts], appends); for i := 0 to high(a) do @@ -1023,32 +1040,35 @@ var appends, lens: PRope; begin assert(d.k = locNone); - useMagic('resizeString'); + useMagic(p.module, 'resizeString'); L := 0; appends := nil; lens := nil; +{@emit + a := []; +} setLength(a, sonsLen(e)-1); expr(p, e.sons[1], a[0]); for i := 0 to sonsLen(e)-3 do begin // compute the length expression: a[i+1] := initLocExpr(p, e.sons[i+2]); - if skipAbstract(e.sons[i+2].Typ).kind = tyChar then begin + if skipVarGenericRange(e.sons[i+2].Typ).kind = tyChar then begin Inc(L); - useMagic('appendChar'); - appRopeFormat(appends, 'appendChar($1, $2);$n', + useMagic(p.module, 'appendChar'); + appf(appends, 'appendChar($1, $2);$n', [rdLoc(a[0]), rdLoc(a[i+1])]) end else begin if e.sons[i+2].kind in [nkStrLit..nkTripleStrLit] then // string literal? Inc(L, length(e.sons[i+2].strVal)) else - appRopeFormat(lens, '$1->len + ', [rdLoc(a[i+1])]); - useMagic('appendString'); - appRopeFormat(appends, 'appendString($1, $2);$n', + appf(lens, '$1->len + ', [rdLoc(a[i+1])]); + useMagic(p.module, 'appendString'); + appf(appends, 'appendString($1, $2);$n', [rdLoc(a[0]), rdLoc(a[i+1])]) end end; - appRopeFormat(p.s[cpsStmts], '$1 = resizeString($1, $2$3);$n', + appf(p.s[cpsStmts], '$1 = resizeString($1, $2$3);$n', [rdLoc(a[0]), lens, toRope(L)]); app(p.s[cpsStmts], appends); for i := 0 to high(a) do @@ -1062,16 +1082,15 @@ procedure genSeqElemAppend(p: BProc; e: PNode; var d: TLoc); var a, b, dest: TLoc; begin - useMagic('incrSeq'); + useMagic(p.module, 'incrSeq'); a := InitLocExpr(p, e.sons[1]); b := InitLocExpr(p, e.sons[2]); - appRopeFormat(p.s[cpsStmts], + appf(p.s[cpsStmts], '$1 = ($2) incrSeq((TGenericSeq*) $1, sizeof($3));$n', - [rdLoc(a), getTypeDesc(skipVarGeneric(e.sons[1].typ)), - getTypeDesc(skipVarGeneric(e.sons[2].Typ))]); - dest := initLoc(locExpr, b.t); - dest.flags := {@set}[lfOnHeap]; - dest.r := ropeFormat('$1->data[$1->len-1]', [rdLoc(a)]); + [rdLoc(a), getTypeDesc(p.module, skipVarGeneric(e.sons[1].typ)), + getTypeDesc(p.module, skipVarGeneric(e.sons[2].Typ))]); + dest := initLoc(locExpr, b.t, OnHeap); + dest.r := ropef('$1->data[$1->len-1]', [rdLoc(a)]); genAssignment(p, dest, b, {@set}[needToCopy]); freeTemp(p, a); freeTemp(p, b) @@ -1082,22 +1101,20 @@ var a, b: TLoc; reftype, bt: PType; begin - useMagic('newObj'); - refType := skipAbstract(e.sons[1].typ); - if refType.kind = tyVar then refType := skipAbstract(refType.sons[0]); + useMagic(p.module, 'newObj'); + refType := skipVarGenericRange(e.sons[1].typ); a := InitLocExpr(p, e.sons[1]); - b := initLoc(locExpr, a.t); - b.flags := {@set}[lfOnHeap]; - b.r := ropeFormat('($1) newObj($2, sizeof($3))', - [getTypeDesc(reftype), genTypeInfo(currMod, refType), - getTypeDesc(skipAbstract(reftype.sons[0]))]); + b := initLoc(locExpr, a.t, OnHeap); + b.r := ropef('($1) newObj($2, sizeof($3))', + [getTypeDesc(p.module, reftype), genTypeInfo(p.module, refType), + getTypeDesc(p.module, skipGenericRange(reftype.sons[0]))]); genAssignment(p, a, b, {@set}[]); // set the object type: - bt := skipAbstract(refType.sons[0]); + bt := skipGenericRange(refType.sons[0]); if containsObject(bt) then begin - useMagic('objectInit'); - appRopeFormat(p.s[cpsStmts], 'objectInit($1, $2);$n', - [rdLoc(a), genTypeInfo(currMod, bt)]) + useMagic(p.module, 'objectInit'); + appf(p.s[cpsStmts], 'objectInit($1, $2);$n', + [rdLoc(a), genTypeInfo(p.module, bt)]) end; freeTemp(p, a) end; @@ -1108,26 +1125,24 @@ var refType, bt: PType; ti: PRope; begin - useMagic('newObj'); - refType := skipAbstract(e.sons[1].typ); - if refType.kind = tyVar then refType := skipAbstract(refType.sons[0]); + useMagic(p.module, 'newObj'); + refType := skipVarGenericRange(e.sons[1].typ); a := InitLocExpr(p, e.sons[1]); f := InitLocExpr(p, e.sons[2]); - b := initLoc(locExpr, a.t); - b.flags := {@set}[lfOnHeap]; - ti := genTypeInfo(currMod, refType); - appRopeFormat(currMod.s[cfsTypeInit3], '$1->finalizer = (void*)$2;$n', [ + b := initLoc(locExpr, a.t, OnHeap); + ti := genTypeInfo(p.module, refType); + appf(p.module.s[cfsTypeInit3], '$1->finalizer = (void*)$2;$n', [ ti, rdLoc(f)]); - b.r := ropeFormat('($1) newObj($2, sizeof($3))', - [getTypeDesc(refType), ti, - getTypeDesc(skipAbstract(reftype.sons[0]))]); + b.r := ropef('($1) newObj($2, sizeof($3))', + [getTypeDesc(p.module, refType), ti, + getTypeDesc(p.module, skipGenericRange(reftype.sons[0]))]); genAssignment(p, a, b, {@set}[]); // set the object type: - bt := skipAbstract(refType.sons[0]); + bt := skipGenericRange(refType.sons[0]); if containsObject(bt) then begin - useMagic('objectInit'); - appRopeFormat(p.s[cpsStmts], 'objectInit($1, $2);$n', - [rdLoc(a), genTypeInfo(currMod, bt)]) + useMagic(p.module, 'objectInit'); + appf(p.s[cpsStmts], 'objectInit($1, $2);$n', + [rdLoc(a), genTypeInfo(p.module, bt)]) end; freeTemp(p, a); freeTemp(p, f) @@ -1139,67 +1154,92 @@ var t: PType; begin a := InitLocExpr(p, e.sons[1]); - t := skipAbstract(e.sons[1].typ); + t := skipVarGenericRange(e.sons[1].typ); case t.kind of tyInt..tyInt64: begin - UseMagic('reprInt'); - putIntoDest(p, d, e.typ, ropeFormat('reprInt($1)', [rdLoc(a)])) + UseMagic(p.module, 'reprInt'); + putIntoDest(p, d, e.typ, ropef('reprInt($1)', [rdLoc(a)])) end; tyFloat..tyFloat128: begin - UseMagic('reprFloat'); - putIntoDest(p, d, e.typ, ropeFormat('reprFloat($1)', [rdLoc(a)])) + UseMagic(p.module, 'reprFloat'); + putIntoDest(p, d, e.typ, ropef('reprFloat($1)', [rdLoc(a)])) end; tyBool: begin - UseMagic('reprBool'); - putIntoDest(p, d, e.typ, ropeFormat('reprBool($1)', [rdLoc(a)])) + UseMagic(p.module, 'reprBool'); + putIntoDest(p, d, e.typ, ropef('reprBool($1)', [rdLoc(a)])) end; tyChar: begin - UseMagic('reprChar'); - putIntoDest(p, d, e.typ, ropeFormat('reprChar($1)', [rdLoc(a)])) + UseMagic(p.module, 'reprChar'); + putIntoDest(p, d, e.typ, ropef('reprChar($1)', [rdLoc(a)])) end; tyEnum: begin - UseMagic('reprEnum'); + UseMagic(p.module, 'reprEnum'); putIntoDest(p, d, e.typ, - ropeFormat('reprEnum($1, $2)', [rdLoc(a), genTypeInfo(currMod, t)])) + ropef('reprEnum($1, $2)', [rdLoc(a), genTypeInfo(p.module, t)])) end; tyString: begin - UseMagic('reprStr'); - putIntoDest(p, d, e.typ, ropeFormat('reprStr($1)', [rdLoc(a)])) + UseMagic(p.module, 'reprStr'); + putIntoDest(p, d, e.typ, ropef('reprStr($1)', [rdLoc(a)])) end; tySet: begin - useMagic('reprSet'); - putIntoDest(p, d, e.typ, ropeFormat('reprSet($1, $2)', - [rdLoc(a), genTypeInfo(currMod, t)])) + useMagic(p.module, 'reprSet'); + putIntoDest(p, d, e.typ, ropef('reprSet($1, $2)', + [rdLoc(a), genTypeInfo(p.module, t)])) end; - tyCString, tyArray, tyOpenArray, tyArrayConstr, - tyRef, tyPtr, tyPointer, tyNil: begin - useMagic('reprAny'); - putIntoDest(p, d, e.typ, ropeFormat('reprAny($1, $2)', - [rdLoc(a), genTypeInfo(currMod, t)])) + tyOpenArray: begin + useMagic(p.module, 'reprOpenArray'); + case a.t.kind of + tyOpenArray: + putIntoDest(p, d, e.typ, ropef('$1, $1Len0', [rdLoc(a)])); + tyString, tySequence: + putIntoDest(p, d, e.typ, ropef('$1->data, $1->len', [rdLoc(a)])); + tyArray, tyArrayConstr: + putIntoDest(p, d, e.typ, ropef('$1, $2', + [rdLoc(a), toRope(lengthOrd(a.t))])); + else InternalError(e.sons[0].info, 'genRepr()') + end; + putIntoDest(p, d, e.typ, ropef('reprOpenArray($1, $2)', + [rdLoc(d), genTypeInfo(p.module, elemType(t))])) + end; + tyCString, tyArray, tyArrayConstr, + tyRef, tyPtr, tyPointer, tyNil, tySequence: begin + useMagic(p.module, 'reprAny'); + putIntoDest(p, d, e.typ, ropef('reprAny($1, $2)', + [rdLoc(a), genTypeInfo(p.module, t)])) end else begin - useMagic('reprAny'); - putIntoDest(p, d, e.typ, ropeFormat('reprAny($1, $2)', - [addrLoc(a), genTypeInfo(currMod, t)])) + useMagic(p.module, 'reprAny'); + putIntoDest(p, d, e.typ, ropef('reprAny($1, $2)', + [addrLoc(a), genTypeInfo(p.module, t)])) end end; if d.k <> locExpr then freeTemp(p, a); end; +procedure genDollar(p: BProc; n: PNode; var d: TLoc; const magic, frmt: string); +var + a: TLoc; +begin + a := InitLocExpr(p, n.sons[1]); + UseMagic(p.module, magic); + putIntoDest(p, d, n.typ, ropef(frmt, [rdLoc(a)])) +end; + procedure genArrayLen(p: BProc; e: PNode; var d: TLoc; op: TMagic); var typ: PType; begin - typ := skipAbstract(e.sons[1].Typ); - if typ.kind in [tyRef, tyPtr, tyVar] then - typ := skipAbstract(typ.sons[0]); + typ := skipPtrsGeneric(e.sons[1].Typ); case typ.kind of - tyOpenArray: + tyOpenArray: begin + while e.sons[1].kind = nkPassAsOpenArray do + e.sons[1] := e.sons[1].sons[0]; if op = mHigh then unaryExpr(p, e, d, '', '($1Len0-1)') else - unaryExpr(p, e, d, '', '$1Len0'); + unaryExpr(p, e, d, '', '$1Len0/*len*/'); + end; tyString, tySequence: if op = mHigh then unaryExpr(p, e, d, '', '($1->len-1)') @@ -1223,13 +1263,14 @@ var t: PType; begin assert(d.k = locNone); - useMagic('setLengthSeq'); + useMagic(p.module, 'setLengthSeq'); a := InitLocExpr(p, e.sons[1]); b := InitLocExpr(p, e.sons[2]); t := skipVarGeneric(e.sons[1].typ); - appRopeFormat(p.s[cpsStmts], + appf(p.s[cpsStmts], '$1 = ($3) setLengthSeq((TGenericSeq*) ($1), sizeof($4), $2);$n', - [rdLoc(a), rdLoc(b), getTypeDesc(t), getTypeDesc(t.sons[0])]); + [rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), + getTypeDesc(p.module, t.sons[0])]); freeTemp(p, a); freeTemp(p, b) end; @@ -1265,16 +1306,15 @@ begin result := rdCharLoc(a); assert(setType.kind = tySet); if (firstOrd(setType) <> 0) then - result := ropeFormat('($1-$2)', [result, toRope(firstOrd(setType))]) + result := ropef('($1-$2)', [result, toRope(firstOrd(setType))]) end; function fewCmps(s: PNode): bool; // this function estimates whether it is better to emit code // for constructing the set or generating a bunch of comparisons directly begin - assert(s.kind in [nkSetConstr, nkConstSetConstr]); - if (getSize(s.typ) <= platform.intSize) and - (s.kind = nkConstSetConstr) then + if s.kind <> nkCurly then InternalError(s.info, 'fewCmps'); + if (getSize(s.typ) <= platform.intSize) and (nfAllConst in s.flags) then result := false // it is better to emit the set generation code else if elemType(s.typ).Kind in [tyInt, tyInt16..tyInt64] then result := true // better not emit the set if int is basetype! @@ -1282,21 +1322,27 @@ begin result := sonsLen(s) <= 8 // 8 seems to be a good value end; -procedure binaryExprIn(p: BProc; e: PNode; var d: TLoc; const frmt: string); -var - a, b: TLoc; +procedure binaryExprIn(p: BProc; e: PNode; var a, b, d: TLoc; + const frmt: string); begin - assert(e.sons[1].typ <> nil); - assert(e.sons[2].typ <> nil); - a := InitLocExpr(p, e.sons[1]); - b := InitLocExpr(p, e.sons[2]); - putIntoDest(p, d, e.typ, ropeFormat(frmt, [rdLoc(a), rdSetElemLoc(b, a.t)])); + putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a), rdSetElemLoc(b, a.t)])); if d.k <> locExpr then begin freeTemp(p, a); freeTemp(p, b) end end; +procedure genInExprAux(p: BProc; e: PNode; var a, b, d: TLoc); +begin + case int(getSize(skipVarGeneric(e.sons[1].typ))) of + 1: binaryExprIn(p, e, a, b, d, '(($1 &(1<<(($2)&7)))!=0)'); + 2: binaryExprIn(p, e, a, b, d, '(($1 &(1<<(($2)&15)))!=0)'); + 4: binaryExprIn(p, e, a, b, d, '(($1 &(1<<(($2)&31)))!=0)'); + 8: binaryExprIn(p, e, a, b, d, '(($1 &(IL64(1)<<(($2)&IL64(63))))!=0)'); + else binaryExprIn(p, e, a, b, d, '(($1[$2/8] &(1<<($2%8)))!=0)'); + end +end; + procedure binaryStmtInExcl(p: BProc; e: PNode; var d: TLoc; const frmt: string); var a, b: TLoc; @@ -1304,7 +1350,7 @@ begin assert(d.k = locNone); a := InitLocExpr(p, e.sons[1]); b := InitLocExpr(p, e.sons[2]); - appRopeFormat(p.s[cpsStmts], frmt, [rdLoc(a), rdSetElemLoc(b, a.t)]); + appf(p.s[cpsStmts], frmt, [rdLoc(a), rdSetElemLoc(b, a.t)]); freeTemp(p, a); freeTemp(p, b) end; @@ -1315,25 +1361,26 @@ var c: array of TLoc; // Generate code for the 'in' operator len, i: int; begin - if (e.sons[1].Kind = nkSetConstr) and fewCmps(e.sons[1]) then begin + if (e.sons[1].Kind = nkCurly) and fewCmps(e.sons[1]) then begin // a set constructor but not a constant set: // do not emit the set, but generate a bunch of comparisons a := initLocExpr(p, e.sons[2]); - b := initLoc(locExpr, e.typ); + b := initLoc(locExpr, e.typ, OnUnknown); b.r := toRope('('+''); len := sonsLen(e.sons[1]); + {@emit c := [];} for i := 0 to len-1 do begin if e.sons[1].sons[i].Kind = nkRange then begin setLength(c, length(c)+2); c[high(c)-1] := InitLocExpr(p, e.sons[1].sons[i].sons[0]); c[high(c)] := InitLocExpr(p, e.sons[1].sons[i].sons[1]); - appRopeFormat(b.r, '$1 >= $2 && $1 <= $3', + appf(b.r, '$1 >= $2 && $1 <= $3', [rdCharLoc(a), rdCharLoc(c[high(c)-1]), rdCharLoc(c[high(c)])]) end else begin setLength(c, length(c)+1); c[high(c)] := InitLocExpr(p, e.sons[1].sons[i]); - appRopeFormat(b.r, '$1 == $2', [rdCharLoc(a), rdCharLoc(c[high(c)])]) + appf(b.r, '$1 == $2', [rdCharLoc(a), rdCharLoc(c[high(c)])]) end; if i < len - 1 then app(b.r, ' || ') @@ -1346,13 +1393,11 @@ begin end end else begin - case int(getSize(skipVarGeneric(e.sons[1].typ))) of - 1: binaryExprIn(p, e, d, '(($1 &(1<<(($2)&7)))!=0)'); - 2: binaryExprIn(p, e, d, '(($1 &(1<<(($2)&15)))!=0)'); - 4: binaryExprIn(p, e, d, '(($1 &(1<<(($2)&31)))!=0)'); - 8: binaryExprIn(p, e, d, '(($1 &(1<<(($2)&63)))!=0)'); - else binaryExprIn(p, e, d, '(($1[$2/8] &(1<<($2%8)))!=0)'); - end + assert(e.sons[1].typ <> nil); + assert(e.sons[2].typ <> nil); + a := InitLocExpr(p, e.sons[1]); + b := InitLocExpr(p, e.sons[2]); + genInExprAux(p, e, a, b, d); end end; @@ -1373,20 +1418,19 @@ var a, b, i: TLoc; ts: string; begin - setType := e.sons[1].Typ; - if setType.kind = tyVar then setType := skipAbstract(setType.sons[0]); + setType := skipVarGeneric(e.sons[1].Typ); size := int(getSize(setType)); case size of 1, 2, 4, 8: begin case op of mIncl: begin - ts := 'NS' + toString(size*8); + ts := 'NI' + toString(size*8); binaryStmtInExcl(p, e, d, - '$1 |=(1<<((' +{&} ts +{&} ')($2)%(sizeof(' +{&} ts +{&} + '$1 |=(1<<((' +{&} ts +{&} ')($2)%(sizeof(' +{&} ts +{&} ')*8)));$n'); end; mExcl: begin - ts := 'NS' + toString(size*8); + ts := 'NI' + toString(size*8); binaryStmtInExcl(p, e, d, '$1 &= ~(1 << ((' +{&} ts +{&} ')($2) % (sizeof(' +{&} ts +{&} ')*8)));$n'); @@ -1420,7 +1464,7 @@ begin b := initLocExpr(p, e.sons[2]); if d.k = locNone then d := getTemp(p, a.t); - appRopeFormat(p.s[cpsStmts], lookupOpr[op], [rdLoc(i), toRope(size), + appf(p.s[cpsStmts], lookupOpr[op], [rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b)]); freeTemp(p, a); freeTemp(p, b); @@ -1436,7 +1480,7 @@ begin b := initLocExpr(p, e.sons[2]); if d.k = locNone then d := getTemp(p, a.t); - appRopeFormat(p.s[cpsStmts], + appf(p.s[cpsStmts], 'for ($1 = 0; $1 < $2; $1++) $n' + ' $3[$1] = $4[$1] $6 $5[$1];$n', [rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b), toRope(lookupOpr[op])]); @@ -1453,6 +1497,98 @@ end; // --------------------- end of set operations ---------------------------- +procedure genOrd(p: BProc; e: PNode; var d: TLoc); +begin + unaryExprChar(p, e, d, '', '$1'); +end; + +procedure genCast(p: BProc; e: PNode; var d: TLoc); +const + ValueTypes = {@set}[tyTuple, tyObject, tyArray, tyOpenArray, tyArrayConstr]; +// we use whatever C gives us. Except if we have a value-type, we +// need to go through its address: +var + a: TLoc; +begin + a := InitLocExpr(p, e.sons[1]); + if (skipGenericRange(e.typ).kind in ValueTypes) + and not (lfIndirect in a.flags) then + putIntoDest(p, d, e.typ, ropef('(*($1*) ($2))', + [getTypeDesc(p.module, e.typ), addrLoc(a)])) + else + putIntoDest(p, d, e.typ, ropef('(($1) ($2))', + [getTypeDesc(p.module, e.typ), rdCharLoc(a)])); + if d.k <> locExpr then freeTemp(p, a) +end; + +procedure genRangeChck(p: BProc; n: PNode; var d: TLoc; const magic: string); +var + a: TLoc; + dest: PType; +begin + dest := skipVarGeneric(n.typ); + if not (optRangeCheck in p.options) then begin + a := InitLocExpr(p, n.sons[0]); + putIntoDest(p, d, n.typ, ropef('(($1) ($2))', + [getTypeDesc(p.module, dest), rdCharLoc(a)])); + end + else begin + a := InitLocExpr(p, n.sons[0]); + useMagic(p.module, magic); + putIntoDest(p, d, dest, + ropef('(($1)' +{&} magic +{&} '($2, $3, $4))', + [getTypeDesc(p.module, dest), + rdCharLoc(a), genLiteral(p, n.sons[1], dest), + genLiteral(p, n.sons[2], dest)])); + if d.k <> locExpr then freeTemp(p, a) + end +end; + +procedure genConv(p: BProc; e: PNode; var d: TLoc); +begin + genCast(p, e, d) +end; + +procedure passToOpenArray(p: BProc; n: PNode; var d: TLoc); +var + a: TLoc; + dest: PType; +begin + dest := skipVarGeneric(n.typ); + a := initLocExpr(p, n.sons[0]); + case a.t.kind of + tyOpenArray: + putIntoDest(p, d, dest, ropef('$1, $1Len0', [rdLoc(a)])); + tyString, tySequence: + putIntoDest(p, d, dest, ropef('$1->data, $1->len', [rdLoc(a)])); + tyArray, tyArrayConstr: + putIntoDest(p, d, dest, ropef('$1, $2', + [rdLoc(a), toRope(lengthOrd(a.t))])); + else InternalError(n.sons[0].info, 'passToOpenArray()') + end; + if d.k <> locExpr then freeTemp(p, a) +end; + +procedure convStrToCStr(p: BProc; n: PNode; var d: TLoc); +var + a: TLoc; +begin + a := initLocExpr(p, n.sons[0]); + putIntoDest(p, d, skipVarGeneric(n.typ), ropef('$1->data', [rdLoc(a)])); + if d.k <> locExpr then freeTemp(p, a) +end; + +procedure convCStrToStr(p: BProc; n: PNode; var d: TLoc); +var + a: TLoc; +begin + useMagic(p.module, 'cstrToNimstr'); + a := initLocExpr(p, n.sons[0]); + putIntoDest(p, d, skipVarGeneric(n.typ), + ropef('cstrToNimstr($1)', [rdLoc(a)])); + if d.k <> locExpr then freeTemp(p, a) +end; + procedure genMagicExpr(p: BProc; e: PNode; var d: TLoc; op: TMagic); var a: TLoc; @@ -1491,13 +1627,21 @@ begin mEqStr: binaryExpr(p, e, d, 'eqStrings', 'eqStrings($1, $2)'); mLeStr: binaryExpr(p, e, d, 'cmpStrings', '(cmpStrings($1, $2) <= 0)'); mLtStr: binaryExpr(p, e, d, 'cmpStrings', '(cmpStrings($1, $2) < 0)'); + mIsNil: unaryExpr(p, e, d, '', '$1 == 0'); + mIntToStr: genDollar(p, e, d, 'nimIntToStr', 'nimIntToStr($1)'); + mInt64ToStr: genDollar(p, e, d, 'nimInt64ToStr', 'nimInt64ToStr($1)'); + mBoolToStr: genDollar(p, e, d, 'nimBoolToStr', 'nimBoolToStr($1)'); + mCharToStr: genDollar(p, e, d, 'nimCharToStr', 'nimCharToStr($1)'); + mFloatToStr: genDollar(p, e, d, 'nimFloatToStr', 'nimFloatToStr($1)'); + mCStrToStr: genDollar(p, e, d, 'cstrToNimstr', 'cstrToNimstr($1)'); + mStrToStr: expr(p, e.sons[1], d); mAssert: begin if (optAssert in p.Options) then begin - useMagic('internalAssert'); + useMagic(p.module, 'internalAssert'); expr(p, e.sons[1], d); line := toRope(toLinenumber(e.info)); filen := makeCString(ToFilename(e.info)); - appRopeFormat(p.s[cpsStmts], 'internalAssert($1, $2, $3);$n', + appf(p.s[cpsStmts], 'internalAssert($1, $2, $3);$n', [filen, line, rdLoc(d)]) end end; @@ -1505,23 +1649,24 @@ begin mNewFinalize: genNewFinalize(p, e); mSizeOf: putIntoDest(p, d, e.typ, - ropeFormat('sizeof($1)', [getTypeDesc(e.sons[1].typ)])); - mChr: expr(p, e.sons[1], d); - mOrd: - // ord only allows things that are allowed in C anyway, so generate - // no code for it: - expr(p, e.sons[1], d); + ropef('sizeof($1)', [getTypeDesc(p.module, e.sons[1].typ)])); + mChr: genCast(p, e, d); // expr(p, e.sons[1], d); + mOrd: genOrd(p, e, d); mLengthArray, mHigh, mLengthStr, mLengthSeq, mLengthOpenArray: genArrayLen(p, e, d, op); mInc: begin if not (optOverflowCheck in p.Options) then binaryStmt(p, e, d, '', '$1 += $2;$n') + else if skipVarGeneric(e.sons[1].typ).kind = tyInt64 then + binaryStmt(p, e, d, 'addInt64', '$1 = addInt64($1, $2);$n') else binaryStmt(p, e, d, 'addInt', '$1 = addInt($1, $2);$n') end; ast.mDec: begin if not (optOverflowCheck in p.Options) then binaryStmt(p, e, d, '', '$1 -= $2;$n') + else if skipVarGeneric(e.sons[1].typ).kind = tyInt64 then + binaryStmt(p, e, d, 'subInt64', '$1 = subInt64($1, $2);$n') else binaryStmt(p, e, d, 'subInt', '$1 = subInt($1, $2);$n') end; @@ -1530,6 +1675,8 @@ begin mIncl, mExcl, mCard, mLtSet, mLeSet, mEqSet, mMulSet, mPlusSet, mMinusSet, mInSet: genSetOp(p, e, d, op); mExit: genCall(p, e, d); + mNLen..mNError: + liMessage(e.info, errCannotGenerateCodeForX, e.sons[0].sym.name.s); else internalError(e.info, 'genMagicExpr: ' + magicToStr[op]); end end; @@ -1544,18 +1691,18 @@ var i: int; ts: string; begin - if e.kind = nkConstSetConstr then + if nfAllConst in e.flags then putIntoDest(p, d, e.typ, genSetNode(p, e)) else begin if d.k = locNone then d := getTemp(p, e.typ); if getSize(e.typ) > 8 then begin // big set: - appRopeFormat(p.s[cpsStmts], 'memset($1, 0, sizeof($1));$n', [rdLoc(d)]); + appf(p.s[cpsStmts], 'memset($1, 0, sizeof($1));$n', [rdLoc(d)]); for i := 0 to sonsLen(e)-1 do begin if e.sons[i].kind = nkRange then begin idx := getTemp(p, getSysType(tyInt)); // our counter a := initLocExpr(p, e.sons[i].sons[1]); b := initLocExpr(p, e.sons[i].sons[2]); - appRopeFormat(p.s[cpsStmts], + appf(p.s[cpsStmts], 'for ($1 = $3; $1 <= $4; $1++) $n' + '$2[$1/8] |=(1<<($1%8));$n', [rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), @@ -1566,21 +1713,21 @@ begin end else begin a := initLocExpr(p, e.sons[i]); - appRopeFormat(p.s[cpsStmts], '$1[$2/8] |=(1<<($2%8));$n', + appf(p.s[cpsStmts], '$1[$2/8] |=(1<<($2%8));$n', [rdLoc(d), rdSetElemLoc(a, e.typ)]); freeTemp(p, a) end end end else begin // small set - ts := 'NS' + toString(getSize(e.typ)*8); - appRopeFormat(p.s[cpsStmts], '$1 = 0;$n', [rdLoc(d)]); + ts := 'NI' + toString(getSize(e.typ)*8); + appf(p.s[cpsStmts], '$1 = 0;$n', [rdLoc(d)]); for i := 0 to sonsLen(e) - 1 do begin if e.sons[i].kind = nkRange then begin idx := getTemp(p, getSysType(tyInt)); // our counter a := initLocExpr(p, e.sons[i].sons[1]); b := initLocExpr(p, e.sons[i].sons[2]); - appRopeFormat(p.s[cpsStmts], + appf(p.s[cpsStmts], 'for ($1 = $3; $1 <= $4; $1++) $n' +{&} '$2 |=(1<<((' +{&} ts +{&} ')($1)%(sizeof(' +{&}ts+{&}')*8)));$n', [rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), @@ -1591,7 +1738,7 @@ begin end else begin a := initLocExpr(p, e.sons[i]); - appRopeFormat(p.s[cpsStmts], + appf(p.s[cpsStmts], '$1 |=(1<<((' +{&} ts +{&} ')($2)%(sizeof(' +{&}ts+{&} ')*8)));$n', [rdLoc(d), rdSetElemLoc(a, e.typ)]); @@ -1602,38 +1749,42 @@ begin end end; -procedure genRecordConstr(p: BProc; t: PNode; var d: TLoc); +procedure genTupleConstr(p: BProc; n: PNode; var d: TLoc); var - i, len: int; + i: int; rec: TLoc; + it: PNode; + t: PType; begin - {@discard} getTypeDesc(t.typ); // so that any fields are initialized - if d.k = locNone then - d := getTemp(p, t.typ); - i := 0; - len := sonsLen(t); - while i < len do begin - rec := initLoc(locExpr, t.sons[i].typ); - assert(t.sons[i].sym.loc.r <> nil); - rec.r := ropeFormat('$1.$2', [rdLoc(d), t.sons[i].sym.loc.r]); - inheritStorage(rec, d); - expr(p, t.sons[i+1], rec); - inc(i, 2) + // the code generator assumes that there are only tuple constructors with + // field names! + t := getUniqueType(n.typ); + {@discard} getTypeDesc(p.module, t); // so that any fields are initialized + if d.k = locNone then d := getTemp(p, t); + if t.n = nil then InternalError(n.info, 'genTupleConstr'); + if sonsLen(t.n) <> sonsLen(n) then + InternalError(n.info, 'genTupleConstr'); + for i := 0 to sonsLen(n)-1 do begin + it := n.sons[i]; + if it.kind <> nkExprColonExpr then InternalError(n.info, 'genTupleConstr'); + rec := initLoc(locExpr, it.sons[1].typ, d.s); + if (t.n.sons[i].kind <> nkSym) then + InternalError(n.info, 'genTupleConstr'); + rec.r := ropef('$1.$2', [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)]); + expr(p, it.sons[1], rec); end end; -procedure genArrayConstr(p: BProc; t: PNode; var d: TLoc); +procedure genArrayConstr(p: BProc; n: PNode; var d: TLoc); var arr: TLoc; i: int; begin - if d.k = locNone then - d := getTemp(p, t.typ); - for i := 0 to sonsLen(t)-1 do begin - arr := initLoc(locExpr, elemType(skipGeneric(t.typ))); - arr.r := ropeFormat('$1[$2]', [rdLoc(d), intLiteral(i)]); - inheritStorage(arr, d); - expr(p, t.sons[i], arr) + if d.k = locNone then d := getTemp(p, n.typ); + for i := 0 to sonsLen(n)-1 do begin + arr := initLoc(locExpr, elemType(skipGeneric(n.typ)), d.s); + arr.r := ropef('$1[$2]', [rdLoc(d), intLiteral(i)]); + expr(p, n.sons[i], arr) end end; @@ -1642,157 +1793,27 @@ var newSeq, arr: TLoc; i: int; begin - useMagic('newSeq'); + useMagic(p.module, 'newSeq'); if d.k = locNone then d := getTemp(p, t.typ); // generate call to newSeq before adding the elements per hand: - newSeq := initLoc(locExpr, t.typ); - newSeq.r := ropeFormat('($1) newSeq($2, $3)', - [getTypeDesc(t.typ), genTypeInfo(currMod, t.typ), toRope(sonsLen(t))]); + newSeq := initLoc(locExpr, t.typ, OnHeap); + newSeq.r := ropef('($1) newSeq($2, $3)', + [getTypeDesc(p.module, t.typ), + genTypeInfo(p.module, t.typ), toRope(sonsLen(t))]); genAssignment(p, d, newSeq, {@set}[]); for i := 0 to sonsLen(t)-1 do begin - arr := initLoc(locExpr, elemType(skipGeneric(t.typ))); - arr.r := ropeFormat('$1->data[$2]', [rdLoc(d), intLiteral(i)]); - arr.flags := {@set}[lfOnHeap]; // we know that sequences are on the heap + arr := initLoc(locExpr, elemType(skipGeneric(t.typ)), OnHeap); + arr.r := ropef('$1->data[$2]', [rdLoc(d), intLiteral(i)]); + arr.s := OnHeap; // we know that sequences are on the heap expr(p, t.sons[i], arr) end end; -procedure genCast(p: BProc; e: PNode; var d: TLoc); -const - ValueTypes = {@set}[tyRecord, tyObject, tyArray, tyOpenArray, tyArrayConstr]; -// we use whatever C gives us. Except if we have a value-type, we -// need to go through its address: -var - a: TLoc; -begin - a := InitLocExpr(p, e.sons[0]); - if (skipAbstract(e.typ).kind in ValueTypes) and (a.indirect = 0) then - putIntoDest(p, d, e.typ, ropeFormat('(*($1*) ($2))', - [getTypeDesc(e.typ), addrLoc(a)])) - else - putIntoDest(p, d, e.typ, ropeFormat('(($1) ($2))', - [getTypeDesc(e.typ), rdCharLoc(a)])); - if d.k <> locExpr then - freeTemp(p, a) -end; - -procedure genConv(p: BProc; e: PNode; var d: TLoc); - // type conversion: it doesn't matter if implicit or explicit; - // type conversions are not casts! -var - a: TLoc; - r: PRope; - source, dest: PType; -begin - // numeric types need range checks: - dest := skipVarGeneric(e.typ); - case dest.kind of - tyRange, tyInt..tyInt64, tyEnum, tyChar, tyBool: begin - if not (optRangeCheck in p.options) or - (firstOrd(dest) <= firstOrd(skipVarGeneric(e.sons[0].typ))) and // first >= x - (lastOrd(skipVarGeneric(e.sons[0].typ)) <= lastOrd(dest)) then // x <= last - expr(p, e.sons[0], d) // no need for a range check - else begin // generate a range check: - a := InitLocExpr(p, e.sons[0]); - if (a.t.kind in [tyFloat..tyFloat128]) or - (dest.kind in [tyFloat..tyFloat128]) then begin - useMagic('chckRangeF'); - putIntoDest(p, d, dest, ropeFormat('chckRangeF($1, $2, $3)', - [rdCharLoc(a), genLiteral(p, dest.n.sons[0], dest), - genLiteral(p, dest.n.sons[1], dest)])) - end - else if (a.t.kind = tyInt64) or (dest.kind = tyInt64) then begin - useMagic('chckRange64'); - putIntoDest(p, d, dest, ropeFormat('chckRange64($1, $2, $3)', - [rdCharLoc(a), intLiteral(firstOrd(dest)), - intLiteral(lastOrd(dest))])) - end - else begin - useMagic('chckRange'); - putIntoDest(p, d, dest, ropeFormat('chckRange($1, $2, $3)', - [rdCharLoc(a), intLiteral(firstOrd(dest)), - intLiteral(lastOrd(dest))])) - end; - if d.k <> locExpr then - freeTemp(p, a) - end - end; - // open arrays need implicit length passed: - tyOpenArray: begin - a := initLocExpr(p, e.sons[0]); - case a.t.kind of - tyOpenArray: - putIntoDest(p, d, dest, ropeFormat('$1, $1Len0', [rdLoc(a)])); - tyString, tySequence: - putIntoDest(p, d, dest, ropeFormat('$1->data, $1->len', [rdLoc(a)])); - tyArray, tyArrayConstr: - putIntoDest(p, d, dest, ropeFormat('$1, $2', - [rdLoc(a), toRope(lengthOrd(a.t))])); - else InternalError(e.sons[0].info, 'genConv()') - end; - if d.k <> locExpr then freeTemp(p, a) - end; - // conversions from string to cstring: - tyCString: begin - if skipVarGeneric(e.sons[0].typ).kind = tyString then begin - a := initLocExpr(p, e.sons[0]); - putIntoDest(p, d, e.typ, ropeFormat('$1->data', [rdLoc(a)])); - if d.k <> locExpr then freeTemp(p, a) - end - else if not isCompatibleToCString(e.sons[0].typ) then - // ordinary type cast: - genCast(p, e, d) - else - expr(p, e.sons[0], d) // BUGFIX! - end; - // conversions from cstring to string: - tyString: begin - if skipVarGeneric(e.sons[0].typ).kind = tyCString then begin - useMagic('cstrToNimstr'); - a := initLocExpr(p, e.sons[0]); - putIntoDest(p, d, dest, ropeFormat('cstrToNimstr($1)', [rdLoc(a)])); - if d.k <> locExpr then freeTemp(p, a) - end - else // ordinary type cast: - genCast(p, e, d) - end; - // conversions between different object types: - tyObject: begin - source := skipVarGeneric(e.sons[0].typ); - // if source is a subtype of dest, downcast: - a := initLocExpr(p, e.sons[0]); - r := rdLoc(a); - while source.sons[0] <> nil do begin - source := source.sons[0]; - if gCmd <> cmdCompileToCpp then - app(r, '.Sup'); - if source.id = dest.id then break - end; - if source.id = dest.id then // we really have a downcast here: - if gCmd = cmdCompileToCpp then - putLocIntoDest(p, d, a) // downcast does C++ for us - else - putIntoDest(p, d, dest, r) - else if gCmd = cmdCompileToCpp then - genCast(p, e, d) // discard ``a`` - else // upcasts are uglier in C - putIntoDest(p, d, dest, ropeFormat('(*($1*) ($2))', - [getTypeDesc(dest), addrLoc(a)])); - if d.k <> locExpr then freeTemp(p, a) - end; - tyGenericParam, tyAnyEnum: - expr(p, e.sons[0], d); - // happens sometimes for generated assignments, etc. - else // use an ordinary cast - genCast(p, e, d) - end -end; - procedure genComplexConst(p: BProc; sym: PSym; var d: TLoc); begin - genConstPrototype(sym); + genConstPrototype(p.module, sym); assert((sym.loc.r <> nil) and (sym.loc.t <> nil)); putLocIntoDest(p, d, sym.loc) end; @@ -1806,68 +1827,83 @@ begin if len > 0 then expr(p, n.sons[len-1], d); end; +procedure upConv(p: BProc; n: PNode; var d: TLoc); +var + a: TLoc; + dest, t: PType; + r, nilCheck: PRope; +begin + a := initLocExpr(p, n.sons[0]); + dest := skipPtrsGeneric(n.typ); + if (optObjCheck in p.options) and not (isPureObject(dest)) then begin + useMagic(p.module, 'chckObj'); + r := rdLoc(a); + nilCheck := nil; + t := skipGeneric(a.t); + while t.kind in [tyVar, tyPtr, tyRef] do begin + if t.kind <> tyVar then nilCheck := r; + r := ropef('(*$1)', [r]); + t := skipGeneric(t.sons[0]) + end; + if gCmd <> cmdCompileToCpp then + while (t.kind = tyObject) and (t.sons[0] <> nil) do begin + app(r, '.Sup'); + t := skipGeneric(t.sons[0]); + end; + if nilCheck <> nil then + appf(p.s[cpsStmts], 'if ($1) chckObj($2.m_type, $3);$n', + [nilCheck, r, genTypeInfo(p.module, dest)]) + else + appf(p.s[cpsStmts], 'chckObj($1.m_type, $2);$n', + [r, genTypeInfo(p.module, dest)]); + end; + if n.sons[0].typ.kind <> tyObject then + putIntoDest(p, d, n.typ, ropef('(($1) ($2))', + [getTypeDesc(p.module, n.typ), rdLoc(a)])) + else + putIntoDest(p, d, n.typ, ropef('(*($1*) ($2))', + [getTypeDesc(p.module, dest), addrLoc(a)])); +end; + +procedure downConv(p: BProc; n: PNode; var d: TLoc); +var + a: TLoc; + dest, src: PType; + i: int; + r: PRope; +begin + if gCmd = cmdCompileToCpp then + expr(p, n.sons[0], d) // downcast does C++ for us + else begin + dest := skipPtrsGeneric(n.typ); + src := skipPtrsGeneric(n.sons[0].typ); + a := initLocExpr(p, n.sons[0]); + r := rdLoc(a); + if skipGeneric(n.sons[0].typ).kind in [tyRef, tyPtr, tyVar] then begin + app(r, '->Sup'); + for i := 2 to abs(inheritanceDiff(dest, src)) do app(r, '.Sup'); + r := con('&'+'', r); + end + else + for i := 1 to abs(inheritanceDiff(dest, src)) do app(r, '.Sup'); + putIntoDest(p, d, n.typ, r); + end +end; + procedure genBlock(p: BProc; t: PNode; var d: TLoc); forward; procedure expr(p: BProc; e: PNode; var d: TLoc); -// do not forget that lfIndirect in d.flags may be requested! var sym: PSym; - a: TLoc; ty: PType; begin case e.kind of - nkQualified: expr(p, e.sons[1], d); - nkStrLit..nkTripleStrLit, nkIntLit..nkInt64Lit, - nkFloatLit..nkFloat64Lit, nkNilLit, nkCharLit, nkRCharLit: begin - putIntoDest(p, d, e.typ, genLiteral(p, e)); - d.k := locImmediate // for removal of index checks - end; - nkCall, nkHiddenCallConv: begin - if (e.sons[0].kind = nkSym) and - (e.sons[0].sym.magic <> mNone) then - genMagicExpr(p, e, d, e.sons[0].sym.magic) - else - genCall(p, e, d) - end; - nkConstSetConstr, nkSetConstr: genSetConstr(p, e, d); - nkConstArrayConstr, nkArrayConstr: - if (skipAbstract(e.typ).kind = tySequence) then // BUGFIX - genSeqConstr(p, e, d) - else - genArrayConstr(p, e, d); - nkConstRecordConstr, nkRecordConstr: - genRecordConstr(p, e, d); - nkCast: genCast(p, e, d); - nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, e, d); - nkAddr: begin - a := InitLocExpr(p, e.sons[0]); - putIntoDest(p, d, e.typ, addrLoc(a)); - if d.k <> locExpr then - freeTemp(p, a) - end; - nkBracketExpr: begin - ty := skipAbstract(e.sons[0].typ); - if ty.kind in [tyRef, tyPtr, tyVar] then ty := skipAbstract(ty.sons[0]); - case ty.kind of - tyArray, tyArrayConstr: genArrayElem(p, e, d); - tyOpenArray: genOpenArrayElem(p, e, d); - tySequence, tyString: genSeqElem(p, e, d); - tyCString: genCStringElem(p, e, d); - else InternalError(e.info, - 'expr(nkBracketExpr, ' + typeKindToStr[ty.kind] + ')'); - end - end; - nkDerefExpr: genDeref(p, e, d); - nkDotExpr: genRecordField(p, e, d); - nkBlockExpr: genBlock(p, e, d); - nkStmtListExpr: genStmtListExpr(p, e, d); - nkIfExpr: genIfExpr(p, e, d); nkSym: begin sym := e.sym; case sym.Kind of - skProc: begin + skProc, skConverter: begin // generate prototype if not already declared in this translation unit - genProcPrototype(sym); + genProcPrototype(p.module, sym); if ((sym.loc.r = nil) or (sym.loc.t = nil)) then InternalError(e.info, 'expr: proc not init ' + sym.name.s); putLocIntoDest(p, d, sym.loc) @@ -1879,7 +1915,7 @@ begin genComplexConst(p, sym, d); skEnumField: putIntoDest(p, d, e.typ, toRope(sym.position)); skVar: begin - if (sfGlobal in sym.flags) then genVarPrototype(sym); + if (sfGlobal in sym.flags) then genVarPrototype(p.module, sym); if ((sym.loc.r = nil) or (sym.loc.t = nil)) then InternalError(e.info, 'expr: var not init ' + sym.name.s); putLocIntoDest(p, d, sym.loc); @@ -1898,7 +1934,57 @@ begin InternalError(e.info, 'expr(' +{&} symKindToStr[sym.kind] +{&} '); unknown symbol') end - end + end; + nkQualified: expr(p, e.sons[1], d); + nkStrLit..nkTripleStrLit, nkIntLit..nkInt64Lit, + nkFloatLit..nkFloat64Lit, nkNilLit, nkCharLit: begin + putIntoDest(p, d, e.typ, genLiteral(p, e)); + d.k := locImmediate // for removal of index checks + end; + nkCall, nkHiddenCallConv: begin + if (e.sons[0].kind = nkSym) and + (e.sons[0].sym.magic <> mNone) then + genMagicExpr(p, e, d, e.sons[0].sym.magic) + else + genCall(p, e, d) + end; + nkCurly: genSetConstr(p, e, d); + nkBracket: + if (skipVarGenericRange(e.typ).kind = tySequence) then // BUGFIX + genSeqConstr(p, e, d) + else + genArrayConstr(p, e, d); + nkPar: + genTupleConstr(p, e, d); + nkCast: genCast(p, e, d); + nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, e, d); + nkHiddenAddr, nkAddr: genAddr(p, e, d); + nkBracketExpr: begin + ty := skipVarGenericRange(e.sons[0].typ); + if ty.kind in [tyRef, tyPtr] then ty := skipVarGenericRange(ty.sons[0]); + case ty.kind of + tyArray, tyArrayConstr: genArrayElem(p, e, d); + tyOpenArray: genOpenArrayElem(p, e, d); + tySequence, tyString: genSeqElem(p, e, d); + tyCString: genCStringElem(p, e, d); + else InternalError(e.info, + 'expr(nkBracketExpr, ' + typeKindToStr[ty.kind] + ')'); + end + end; + nkDerefExpr, nkHiddenDeref: genDeref(p, e, d); + nkDotExpr: genRecordField(p, e, d); + nkCheckedFieldExpr: genCheckedRecordField(p, e, d); + nkBlockExpr: genBlock(p, e, d); + nkStmtListExpr: genStmtListExpr(p, e, d); + nkIfExpr: genIfExpr(p, e, d); + nkObjDownConv: downConv(p, e, d); + nkObjUpConv: upConv(p, e, d); + nkChckRangeF: genRangeChck(p, e, d, 'chckRangeF'); + nkChckRange64: genRangeChck(p, e, d, 'chckRange64'); + nkChckRange: genRangeChck(p, e, d, 'chckRange'); + nkStringToCString: convStrToCStr(p, e, d); + nkCStringToString: convCStrToStr(p, e, d); + nkPassAsOpenArray: passToOpenArray(p, e, d); else InternalError(e.info, 'expr(' +{&} nodeKindToStr[e.kind] +{&} '); unknown node kind') @@ -1915,8 +2001,8 @@ var begin result := copyNode(n); newSons(result, sonsLen(n)); - t := skipAbstract(n.Typ); - if t.kind = tyRecordConstr then + t := getUniqueType(skipVarGenericRange(n.Typ)); + if t.n = nil then InternalError(n.info, 'transformRecordExpr: invalid type'); for i := 0 to sonsLen(n)-1 do begin assert(n.sons[i].kind = nkExprColonExpr); @@ -1940,7 +2026,7 @@ begin len := sonsLen(n); result := toRope('{'+''); for i := 0 to len - 2 do - app(result, ropeFormat('$1,$n', [genConstExpr(p, n.sons[i])])); + app(result, ropef('$1,$n', [genConstExpr(p, n.sons[i])])); if len > 0 then app(result, genConstExpr(p, n.sons[len-1])); app(result, '}' + tnl) end; @@ -1951,17 +2037,19 @@ var cs: TBitSet; begin case n.Kind of - nkHiddenStdConv, nkHiddenSubConv: result := genConstExpr(p, n.sons[0]); - nkSetConstr, nkConstSetConstr: begin + nkHiddenStdConv, nkHiddenSubConv: result := genConstExpr(p, n.sons[1]); + nkCurly: begin toBitSet(n, cs); result := genRawSetData(cs, int(getSize(n.typ))) + end; + nkBracket: begin // XXX: tySequence! + result := genConstSimpleList(p, n); end; - nkConstArrayConstr: result := genConstSimpleList(p, n); - nkPar, nkConstRecordConstr, nkRecordConstr: begin - if hasSonWith(n, nkExprColonExpr) then + nkPar: begin + if hasSonWith(n, nkExprColonExpr) then trans := transformRecordExpr(n) - else + else trans := n; result := genConstSimpleList(p, trans); end diff --git a/nim/ccgstmts.pas b/nim/ccgstmts.pas index 38a9e9cdf..a59ef42d2 100644 --- a/nim/ccgstmts.pas +++ b/nim/ccgstmts.pas @@ -18,17 +18,25 @@ begin line := toLinenumber(t.info); // BUGFIX if line < 0 then line := 0; // negative numbers are not allowed in #line if optLineDir in p.Options then - appRopeFormat(p.s[cpsStmts], '#line $2 "$1"$n', + appf(p.s[cpsStmts], '#line $2 "$1"$n', [toRope(toFilename(t.info)), toRope(line)]); if ([optStackTrace, optEndb] * p.Options = [optStackTrace, optEndb]) and ((p.prc = nil) or not (sfPure in p.prc.flags)) then begin - useMagic('endb'); // new: endb support - appRopeFormat(p.s[cpsStmts], 'endb($1);$n', [toRope(line)]) + useMagic(p.module, 'endb'); // new: endb support + appf(p.s[cpsStmts], 'endb($1);$n', [toRope(line)]) end else if ([optLineTrace, optStackTrace] * p.Options = [optLineTrace, optStackTrace]) and ((p.prc = nil) or not (sfPure in p.prc.flags)) then - appRopeFormat(p.s[cpsStmts], 'F.line = $1;$n', [toRope(line)]) + appf(p.s[cpsStmts], 'F.line = $1;$n', [toRope(line)]) +end; + +procedure finishTryStmt(p: BProc; howMany: int); +var + i: int; +begin + for i := 1 to howMany do + app(p.s[cpsStmts], 'excHandler = excHandler->prev;' + tnl); end; procedure genReturnStmt(p: BProc; t: PNode); @@ -36,15 +44,16 @@ begin p.beforeRetNeeded := true; genLineDir(p, t); if (t.sons[0] <> nil) then genStmts(p, t.sons[0]); + finishTryStmt(p, p.nestedTryStmts); app(p.s[cpsStmts], 'goto BeforeRet;' + tnl) end; procedure genObjectInit(p: BProc; sym: PSym); begin if containsObject(sym.typ) then begin - useMagic('objectInit'); - appRopeFormat(p.s[cpsInit], 'objectInit($1, $2);$n', - [addrLoc(sym.loc), genTypeInfo(currMod, sym.typ)]) + useMagic(p.module, 'objectInit'); + appf(p.s[cpsInit], 'objectInit($1, $2);$n', + [addrLoc(sym.loc), genTypeInfo(p.module, sym.typ)]) end end; @@ -52,11 +61,11 @@ procedure initVariable(p: BProc; v: PSym); begin if containsGarbageCollectedRef(v.typ) or (v.ast = nil) then // Language change: always initialize variables if v.ast == nil! - if not (skipAbstract(v.typ).Kind in [tyArray, tyArrayConstr, tySet, - tyRecord, tyTuple, tyObject]) then - appRopeFormat(p.s[cpsInit], '$1 = 0;$n', [v.loc.r]) + if not (skipVarGenericRange(v.typ).Kind in [tyArray, tyArrayConstr, tySet, + tyTuple, tyObject]) then + appf(p.s[cpsStmts], '$1 = 0;$n', [v.loc.r]) else - appRopeFormat(p.s[cpsInit], 'memset((void*)&$1, 0, sizeof($1));$n', + appf(p.s[cpsStmts], 'memset((void*)&$1, 0, sizeof($1));$n', [v.loc.r]) end; @@ -73,7 +82,7 @@ begin assert(a.sons[0].kind = nkSym); v := a.sons[0].sym; if sfGlobal in v.flags then - assignGlobalVar(v) + assignGlobalVar(p.module, v) else begin assignLocalVar(p, v); initVariable(p, v) // XXX: this is not required if a.sons[2] != nil, @@ -95,19 +104,20 @@ var begin for i := 0 to sonsLen(t)-1 do begin if t.sons[i].kind = nkCommentStmt then continue; - assert(t.sons[i].kind = nkConstDef); + if t.sons[i].kind <> nkConstDef then InternalError(t.info, 'genConstStmt'); c := t.sons[i].sons[0].sym; // This can happen for forward consts: if (c.ast <> nil) and (c.typ.kind in ConstantDataTypes) and not (lfNoDecl in c.loc.flags) then begin // generate the data: - fillLoc(c.loc, locData, c.typ, mangleName(c), {@set}[lfOnData]); + fillLoc(c.loc, locData, c.typ, mangleName(c), OnUnknown); if sfImportc in c.flags then - appRopeFormat(currMod.s[cfsData], 'extern $1$2 $3;$n', - [constTok, getTypeDesc(c.typ), c.loc.r]) + appf(p.module.s[cfsData], 'extern NIM_CONST $1 $2;$n', + [getTypeDesc(p.module, c.typ), c.loc.r]) else - appRopeFormat(currMod.s[cfsData], '$1$2 $3 = $4;$n', - [constTok, getTypeDesc(c.typ), c.loc.r, genConstExpr(p, c.ast)]) + appf(p.module.s[cfsData], 'NIM_CONST $1 $2 = $3;$n', + [getTypeDesc(p.module, c.typ), c.loc.r, + genConstExpr(p, c.ast)]) end end end; @@ -139,11 +149,11 @@ begin nkElifBranch: begin a := initLocExpr(p, it.sons[0]); Lelse := getLabel(p); - appRopeFormat(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Lelse]); + appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Lelse]); freeTemp(p, a); genStmts(p, it.sons[1]); if sonsLen(n) > 1 then - appRopeFormat(p.s[cpsStmts], 'goto $1;$n', [Lend]); + appf(p.s[cpsStmts], 'goto $1;$n', [Lend]); fixLabel(p, Lelse); end; nkElse: begin @@ -166,17 +176,18 @@ var begin genLineDir(p, t); assert(sonsLen(t) = 2); - inc(p.unique); - Labl := con('L'+'', toRope(p.unique)); + inc(p.labels); + Labl := con('L'+'', toRope(p.labels)); len := length(p.blocks); setLength(p.blocks, len+1); - p.blocks[len] := p.unique; // positive because we use it right away: + p.blocks[len].id := p.labels; // positive because we use it right away: + p.blocks[len].nestedTryStmts := p.nestedTryStmts; app(p.s[cpsStmts], 'while (1) {' + tnl); a := initLocExpr(p, t.sons[0]); - appRopeFormat(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Labl]); + appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Labl]); freeTemp(p, a); genStmts(p, t.sons[1]); - appRopeFormat(p.s[cpsStmts], '} $1: ;$n', [Labl]); + appf(p.s[cpsStmts], '} $1: ;$n', [Labl]); setLength(p.blocks, length(p.blocks)-1) end; @@ -185,7 +196,7 @@ var idx: int; sym: PSym; begin - inc(p.unique); + inc(p.labels); idx := length(p.blocks); if t.sons[0] <> nil then begin // named block? assert(t.sons[0].kind = nkSym); @@ -194,14 +205,22 @@ begin sym.loc.a := idx end; setLength(p.blocks, idx+1); - p.blocks[idx] := -p.unique; // negative because it isn't used yet + p.blocks[idx].id := -p.labels; // negative because it isn't used yet + p.blocks[idx].nestedTryStmts := p.nestedTryStmts; if t.kind = nkBlockExpr then genStmtListExpr(p, t.sons[1], d) else genStmts(p, t.sons[1]); - if p.blocks[idx] > 0 then // label has been used: - appRopeFormat(p.s[cpsStmts], 'L$1: ;$n', [toRope(p.blocks[idx])]); + if p.blocks[idx].id > 0 then // label has been used: + appf(p.s[cpsStmts], 'L$1: ;$n', [toRope(p.blocks[idx].id)]); setLength(p.blocks, idx) end; +// try: +// while: +// try: +// if ...: +// break # we need to finish only one try statement here! +// finally: + procedure genBreakStmt(p: BProc; t: PNode); var idx: int; @@ -215,8 +234,9 @@ begin assert(sym.loc.k = locOther); idx := sym.loc.a end; - p.blocks[idx] := abs(p.blocks[idx]); // label is used - appRopeFormat(p.s[cpsStmts], 'goto L$1;$n', [toRope(p.blocks[idx])]) + p.blocks[idx].id := abs(p.blocks[idx].id); // label is used + finishTryStmt(p, p.nestedTryStmts - p.blocks[idx].nestedTryStmts); + appf(p.s[cpsStmts], 'goto L$1;$n', [toRope(p.blocks[idx].id)]) end; procedure genAsmStmt(p: BProc; t: PNode); @@ -245,15 +265,15 @@ begin InternalError(t.sons[i].info, 'genAsmStmt()') end end; - appRopeFormat(p.s[cpsStmts], CC[ccompiler].asmStmtFrmt, [s]); + appf(p.s[cpsStmts], CC[ccompiler].asmStmtFrmt, [s]); end; -function getRaiseFrmt(): string; +function getRaiseFrmt(p: BProc): string; begin if gCmd = cmdCompileToCpp then result := 'throw nimException($1, $2);$n' - else begin - useMagic('E_Base'); + else begin + useMagic(p.module, 'E_Base'); result := 'raiseException((E_Base*)$1, $2);$n' end end; @@ -266,14 +286,13 @@ var begin genLineDir(p, t); if t.sons[0] <> nil then begin - if gCmd <> cmdCompileToCpp then - useMagic('raiseException'); + if gCmd <> cmdCompileToCpp then useMagic(p.module, 'raiseException'); a := InitLocExpr(p, t.sons[0]); e := rdLoc(a); freeTemp(p, a); typ := t.sons[0].typ; while typ.kind in [tyVar, tyRef, tyPtr] do typ := typ.sons[0]; - appRopeFormat(p.s[cpsStmts], getRaiseFrmt(), + appf(p.s[cpsStmts], getRaiseFrmt(p), [e, makeCString(typ.sym.name.s)]) end else begin @@ -281,7 +300,7 @@ begin if gCmd = cmdCompileToCpp then app(p.s[cpsStmts], 'throw;' + tnl) else begin - useMagic('reraiseException'); + useMagic(p.module, 'reraiseException'); app(p.s[cpsStmts], 'reraiseException();' + tnl) end end @@ -309,13 +328,13 @@ begin y := initLocExpr(p, b.sons[i].sons[1]); freeTemp(p, x); freeTemp(p, y); - appRopeFormat(p.s[cpsStmts], rangeFormat, + appf(p.s[cpsStmts], rangeFormat, [rdCharLoc(e), rdCharLoc(x), rdCharLoc(y), labl]) end else begin x := initLocExpr(p, b.sons[i]); freeTemp(p, x); - appRopeFormat(p.s[cpsStmts], eqFormat, + appf(p.s[cpsStmts], eqFormat, [rdCharLoc(e), rdCharLoc(x), labl]) end end @@ -328,11 +347,11 @@ var begin Lend := getLabel(p); for i := 1 to sonsLen(t) - 1 do begin - appRopeFormat(p.s[cpsStmts], 'L$1: ;$n', [toRope(labId+i)]); + appf(p.s[cpsStmts], 'L$1: ;$n', [toRope(labId+i)]); if t.sons[i].kind = nkOfBranch then begin len := sonsLen(t.sons[i]); genStmts(p, t.sons[i].sons[len-1]); - appRopeFormat(p.s[cpsStmts], 'goto $1;$n', [Lend]) + appf(p.s[cpsStmts], 'goto $1;$n', [Lend]) end else // else statement genStmts(p, t.sons[i].sons[0]) @@ -349,15 +368,15 @@ var begin a := initLocExpr(p, t.sons[0]); // fist pass: gnerate ifs+goto: - labId := p.unique; + labId := p.labels; for i := 1 to sonsLen(t) - 1 do begin - inc(p.unique); + inc(p.labels); if t.sons[i].kind = nkOfBranch then genCaseGenericBranch(p, t.sons[i], a, rangeFormat, eqFormat, - con('L'+'', toRope(p.unique))) + con('L'+'', toRope(p.labels))) else // else statement - appRopeFormat(p.s[cpsStmts], 'goto L$1;$n', [toRope(p.unique)]); + appf(p.s[cpsStmts], 'goto L$1;$n', [toRope(p.labels)]); end; // second pass: generate statements genCaseSecondPass(p, t, labId); @@ -435,7 +454,7 @@ begin freeTemp(p, x); assert(b.sons[i].kind in [nkStrLit..nkTripleStrLit]); j := int(hashString(b.sons[i].strVal) and high(branches)); - appRopeFormat(branches[j], 'if (eqStrings($1, $2)) goto $3;$n', + appf(branches[j], 'if (eqStrings($1, $2)) goto $3;$n', [rdLoc(e), rdLoc(x), labl]) end end; @@ -446,38 +465,39 @@ var a: TLoc; branches: TRopeSeq; begin - useMagic('eqStrings'); + useMagic(p.module, 'eqStrings'); // count how many constant strings there are in the case: strings := 0; for i := 1 to sonsLen(t)-1 do if t.sons[i].kind = nkOfBranch then inc(strings, sonsLen(t.sons[i])-1); if strings > stringCaseThreshold then begin - useMagic('hashString'); + useMagic(p.module, 'hashString'); bitMask := nmath.nextPowerOfTwo(strings)-1; setLength(branches, bitMask+1); a := initLocExpr(p, t.sons[0]); // fist pass: gnerate ifs+goto: - labId := p.unique; + labId := p.labels; for i := 1 to sonsLen(t) - 1 do begin - inc(p.unique); + inc(p.labels); if t.sons[i].kind = nkOfBranch then - genCaseStringBranch(p, t.sons[i], a, con('L'+'', toRope(p.unique)), + genCaseStringBranch(p, t.sons[i], a, con('L'+'', toRope(p.labels)), branches) - else begin end + else begin // else statement: nothing to do yet // but we reserved a label, which we use later + end end; // second pass: generate switch statement based on hash of string: - appRopeFormat(p.s[cpsStmts], 'switch (hashString($1) & $2) {$n', + appf(p.s[cpsStmts], 'switch (hashString($1) & $2) {$n', [rdLoc(a), toRope(bitMask)]); for j := 0 to high(branches) do if branches[j] <> nil then - appRopeFormat(p.s[cpsStmts], 'case $1: $n$2break;$n', + appf(p.s[cpsStmts], 'case $1: $n$2break;$n', [intLiteral(j), branches[j]]); app(p.s[cpsStmts], '}' + tnl); // else statement: if t.sons[sonsLen(t)-1].kind <> nkOfBranch then - appRopeFormat(p.s[cpsStmts], 'goto L$1;$n', [toRope(p.unique)]); + appf(p.s[cpsStmts], 'goto L$1;$n', [toRope(p.labels)]); // third pass: generate statements genCaseSecondPass(p, t, labId); freeTemp(p, a); @@ -521,7 +541,7 @@ begin end; if canGenerateSwitch then begin a := initLocExpr(p, t.sons[0]); - appRopeFormat(p.s[cpsStmts], 'switch ($1) {$n', [rdCharLoc(a)]); + appf(p.s[cpsStmts], 'switch ($1) {$n', [rdCharLoc(a)]); freeTemp(p, a); for i := 1 to sonsLen(t)-1 do begin if t.sons[i].kind = nkOfBranch then begin @@ -529,19 +549,19 @@ begin for j := 0 to len-2 do begin if t.sons[i].sons[j].kind = nkRange then begin // a range if hasSwitchRange in CC[ccompiler].props then - appRopeFormat(p.s[cpsStmts], 'case $1 ... $2:$n', + appf(p.s[cpsStmts], 'case $1 ... $2:$n', [genLiteral(p, t.sons[i].sons[j].sons[0]), genLiteral(p, t.sons[i].sons[j].sons[1])]) else begin v := copyNode(t.sons[i].sons[j].sons[0]); while (v.intVal <= t.sons[i].sons[j].sons[1].intVal) do begin - appRopeFormat(p.s[cpsStmts], 'case $1:$n', [genLiteral(p, v)]); + appf(p.s[cpsStmts], 'case $1:$n', [genLiteral(p, v)]); Inc(v.intVal) end end; end else - appRopeFormat(p.s[cpsStmts], 'case $1:$n', + appf(p.s[cpsStmts], 'case $1:$n', [genLiteral(p, t.sons[i].sons[j])]); end; genStmts(p, t.sons[i].sons[len-1]) @@ -563,7 +583,7 @@ end; procedure genCaseStmt(p: BProc; t: PNode); begin genLineDir(p, t); - case skipAbstract(t.sons[0].typ).kind of + case skipVarGenericRange(t.sons[0].typ).kind of tyString: genStringCase(p, t); tyFloat..tyFloat128: genCaseGeneric(p, t, 'if ($1 >= $2 && $1 <= $3) goto $4;$n', @@ -622,21 +642,20 @@ begin exc := getTempName(); if not hasGeneralExceptSection(t) then begin rethrowFlag := getTempName(); - appRopeFormat(p.s[cpsLocals], 'volatile NIM_BOOL $1 = NIM_FALSE;$n', + appf(p.s[cpsLocals], 'volatile NIM_BOOL $1 = NIM_FALSE;$n', [rethrowFlag]) end; if optStackTrace in p.Options then app(p.s[cpsStmts], 'framePtr = (TFrame*)&F;' + tnl); app(p.s[cpsStmts], 'try {' + tnl); - inc(p.inTryStmt); + inc(p.nestedTryStmts); genStmts(p, t.sons[0]); - dec(p.inTryStmt); len := sonsLen(t); if t.sons[1].kind = nkExceptBranch then begin - appRopeFormat(p.s[cpsStmts], '} catch (NimException& $1) {$n', [exc]); + appf(p.s[cpsStmts], '} catch (NimException& $1) {$n', [exc]); if rethrowFlag <> nil then - appRopeFormat(p.s[cpsStmts], '$1 = NIM_TRUE;$n', [rethrowFlag]); - appRopeFormat(p.s[cpsStmts], 'if ($1.sp.exc) {$n', [exc]) + appf(p.s[cpsStmts], '$1 = NIM_TRUE;$n', [rethrowFlag]); + appf(p.s[cpsStmts], 'if ($1.sp.exc) {$n', [exc]) end; // XXX: this is not correct! i := 1; while (i < len) and (t.sons[i].kind = nkExceptBranch) do begin @@ -648,24 +667,25 @@ begin else begin for j := 0 to blen - 2 do begin assert(t.sons[i].sons[j].kind = nkType); - appRopeFormat(p.s[cpsStmts], 'case $1:$n', + appf(p.s[cpsStmts], 'case $1:$n', [toRope(t.sons[i].sons[j].typ.id)]) end; genStmts(p, t.sons[i].sons[blen - 1]) end; // code to clear the exception: if rethrowFlag <> nil then - appRopeFormat(p.s[cpsStmts], '$1 = NIM_FALSE; ', [rethrowFlag]); + appf(p.s[cpsStmts], '$1 = NIM_FALSE; ', [rethrowFlag]); app(p.s[cpsStmts], 'break;' + tnl); inc(i); end; if t.sons[1].kind = nkExceptBranch then // BUGFIX app(p.s[cpsStmts], '}}' + tnl); // end of catch-switch statement + dec(p.nestedTryStmts); app(p.s[cpsStmts], 'excHandler = excHandler->prev;' + tnl); if (i < len) and (t.sons[i].kind = nkFinally) then begin genStmts(p, t.sons[i].sons[0]); if rethrowFlag <> nil then - appRopeFormat(p.s[cpsStmts], 'if ($1) { throw; }$n', [rethrowFlag]) + appf(p.s[cpsStmts], 'if ($1) { throw; }$n', [rethrowFlag]) end end; @@ -698,21 +718,21 @@ begin genLineDir(p, t); safePoint := getTempName(); - useMagic('TSafePoint'); - useMagic('E_Base'); - useMagic('excHandler'); - appRopeFormat(p.s[cpsLocals], 'volatile TSafePoint $1;$n', [safePoint]); - appRopeFormat(p.s[cpsStmts], '$1.prev = excHandler;$n' + - 'excHandler = &$1;$n' + - '$1.status = setjmp($1.context);$n' + - 'if ($1.status == 0) {$n', [safePoint]); + useMagic(p.module, 'TSafePoint'); + useMagic(p.module, 'E_Base'); + useMagic(p.module, 'excHandler'); + appf(p.s[cpsLocals], 'TSafePoint $1;$n', [safePoint]); + appf(p.s[cpsStmts], '$1.prev = excHandler;$n' + + 'excHandler = &$1;$n' + + '$1.status = setjmp($1.context);$n', + [safePoint]); if optStackTrace in p.Options then app(p.s[cpsStmts], 'framePtr = (TFrame*)&F;' + tnl); + appf(p.s[cpsStmts], 'if ($1.status == 0) {$n', [safePoint]); len := sonsLen(t); - inc(p.inTryStmt); + inc(p.nestedTryStmts); genStmts(p, t.sons[0]); app(p.s[cpsStmts], '} else {' + tnl); - dec(p.inTryStmt); i := 1; while (i < len) and (t.sons[i].kind = nkExceptBranch) do begin blen := sonsLen(t.sons[i]); @@ -720,7 +740,7 @@ begin // general except section: if i > 1 then app(p.s[cpsStmts], 'else {' + tnl); genStmts(p, t.sons[i].sons[0]); - appRopeFormat(p.s[cpsStmts], '$1.status = 0;$n', [safePoint]); + appf(p.s[cpsStmts], '$1.status = 0;$n', [safePoint]); if i > 1 then app(p.s[cpsStmts], '}' + tnl); end else begin @@ -728,24 +748,25 @@ begin for j := 0 to blen - 2 do begin assert(t.sons[i].sons[j].kind = nkType); if orExpr <> nil then app(orExpr, '||'); - appRopeFormat(orExpr, '($1.exc->Sup.m_type == $2)', - [safePoint, genTypeInfo(currMod, t.sons[i].sons[j].typ)]) + appf(orExpr, '($1.exc->Sup.m_type == $2)', + [safePoint, genTypeInfo(p.module, t.sons[i].sons[j].typ)]) end; if i > 1 then app(p.s[cpsStmts], 'else '); - appRopeFormat(p.s[cpsStmts], 'if ($1) {$n', [orExpr]); + appf(p.s[cpsStmts], 'if ($1) {$n', [orExpr]); genStmts(p, t.sons[i].sons[blen - 1]); // code to clear the exception: - appRopeFormat(p.s[cpsStmts], '$1.status = 0;}$n', [safePoint]); + appf(p.s[cpsStmts], '$1.status = 0;}$n', [safePoint]); end; inc(i) end; app(p.s[cpsStmts], '}' + tnl); // end of if statement - app(p.s[cpsStmts], 'excHandler = excHandler->prev;' + tnl); + finishTryStmt(p, p.nestedTryStmts); + dec(p.nestedTryStmts); if (i < len) and (t.sons[i].kind = nkFinally) then begin genStmts(p, t.sons[i].sons[0]); - useMagic('raiseException'); - appRopeFormat(p.s[cpsStmts], 'if ($1.status != 0) { ' + - 'raiseException($1.exc, $1.exc->Name); }$n', [safePoint]) + useMagic(p.module, 'raiseException'); + appf(p.s[cpsStmts], 'if ($1.status != 0) { ' + + 'raiseException($1.exc, $1.exc->name); }$n', [safePoint]) end end; @@ -767,7 +788,7 @@ begin name := 'bp' + toString(breakPointId) end; genLineDir(p, t); // BUGFIX - appRopeFormat(gBreakpoints, + appf(gBreakpoints, 'dbgRegisterBreakpoint($1, (NCSTRING)$2, (NCSTRING)$3);$n', [toRope(toLinenumber(t.info)), makeCString(toFilename(t.info)), makeCString(name)]) @@ -852,15 +873,15 @@ begin nkCommentStmt, nkNilLit, nkIteratorDef, nkIncludeStmt, nkImportStmt, nkFromStmt, nkTemplateDef, nkMacroDef: begin end; nkPragma: genPragma(p, t); - nkProcDef: begin + nkProcDef, nkConverterDef: begin if (t.sons[genericParamsPos] = nil) then begin prc := t.sons[namePos].sym; - if (t.sons[codePos] <> nil) + if (t.sons[codePos] <> nil) or (lfDynamicLib in prc.loc.flags) then begin // BUGFIX - if IntSetContainsOrIncl(currMod.debugDeclared, prc.id) then begin + if IntSetContainsOrIncl(p.module.debugDeclared, prc.id) then begin internalError(t.info, 'genProc()'); // XXX: remove this check! end; - genProc(prc) + genProc(p.module, prc) end //else if sfCompilerProc in prc.flags then genProcPrototype(prc); end diff --git a/nim/ccgtypes.pas b/nim/ccgtypes.pas index f375daaae..329d9f60c 100644 --- a/nim/ccgtypes.pas +++ b/nim/ccgtypes.pas @@ -9,12 +9,6 @@ // ------------------------- Name Mangling -------------------------------- -function getUnique(p: BProc): PRope; -begin - inc(p.unique); - result := toRope(p.unique) -end; - function mangle(const name: string): string; var i: int; @@ -23,7 +17,7 @@ begin result := toUpper(name[strStart])+'' else result := 'HEX' + toHex(ord(name[strStart]), 2); - for i := 2 to length(name) - 1 + strStart do begin + for i := strStart+1 to length(name) + strStart-1 do begin case name[i] of 'A'..'Z': addChar(result, chr(ord(name[i]) - ord('A') + ord('a'))); '_': begin end; @@ -35,22 +29,68 @@ end; function mangleName(s: PSym): PRope; begin - if s.owner <> nil then - result := ropeFormat('$1_$2_$3', [toRope(mangle(s.owner.name.s)), - toRope(mangle(s.name.s)), - toRope(s.id)]) - else - result := ropeFormat('$1_$2', [toRope(mangle(s.name.s)), - toRope(s.id)]); + result := ropef('$1_$2', [toRope(mangle(s.name.s)), toRope(s.id)]); if optGenMapping in gGlobalOptions then if s.owner <> nil then - appRopeFormat(gMapping, '$1.$2 $3$n', + appf(gMapping, '$1.$2 $3$n', [toRope(s.owner.Name.s), toRope(s.name.s), result]) end; // ------------------------------ C type generator ------------------------ -function getTypeDesc(typ: PType): PRope; forward; +function mapType(typ: PType): TCTypeKind; +begin + case typ.kind of + tyNone: result := ctVoid; + tyBool: result := ctBool; + tyChar: result := ctChar; + tyEmptySet, tySet: begin + case int(getSize(typ)) of + 1: result := ctInt8; + 2: result := ctInt16; + 4: result := ctInt32; + 8: result := ctInt64; + else result := ctArray + end + end; + tyOpenArray, tyArrayConstr, tyArray: result := ctArray; + tyObject, tyTuple: result := ctStruct; + tyGeneric, tyGenericInst, tyGenericParam: result := mapType(lastSon(typ)); + tyEnum, tyAnyEnum: begin + if firstOrd(typ) < 0 then + result := ctInt32 + else begin + case int(getSize(typ)) of + 1: result := ctUInt8; + 2: result := ctUInt16; + 4: result := ctInt32; + else internalError('mapType'); + end + end + end; + tyRange: result := mapType(typ.sons[0]); + tyPtr, tyVar, tyRef: begin + case typ.sons[0].kind of + tyOpenArray, tyArrayConstr, tyArray: result := ctArray; + (*tySet: begin + if mapType(typ.sons[0]) = ctArray then result := ctArray + else result := ctPtr + end*) + else result := ctPtr + end + end; + tyPointer: result := ctPtr; + tySequence: result := ctNimSeq; + tyProc: result := ctProc; + tyString: result := ctNimStr; + tyCString: result := ctCString; + tyInt..tyFloat128: + result := TCTypeKind(ord(typ.kind) - ord(tyInt) + ord(ctInt)); + else InternalError('mapType'); + end +end; + +function getTypeDesc(m: BModule; typ: PType): PRope; forward; function needsComplexAssignment(typ: PType): bool; begin @@ -58,8 +98,6 @@ begin end; function isInvalidReturnType(rettype: PType): bool; -var - t: PType; begin // Arrays and sets cannot be returned by a C procedure, because C is // such a poor programming language. @@ -68,16 +106,9 @@ begin if rettype = nil then result := true else begin - t := skipAbstract(rettype); - case t.kind of - tyArray, tyArrayConstr: result := true; - tyObject, tyRecord: result := needsComplexAssignment(t); - tySet: begin - case int(getSize(t)) of - 1, 2, 4, 8: result := false; - else result := true - end - end + case mapType(rettype) of + ctArray: result := true; + ctStruct: result := needsComplexAssignment(skipGeneric(rettype)); else result := false; end end @@ -96,65 +127,46 @@ begin result := PRope(TableGetType(tab, key)) end; -var - gUnique: int; - function getTempName(): PRope; begin inc(gUnique); result := con('T'+'', toRope(gUnique)) end; -function isCArray(typ: PType): bool; -var - t: PType; -begin - t := skipVarGeneric(typ); - case t.kind of - tyArray, tyArrayConstr, tyOpenArray: result := true; - tySet: result := getSize(t) > 8; - else result := false - end -end; - -function UsePtrPassing(param: PSym): bool; -// this is pretty complicated ... +function ccgIntroducedPtr(s: PSym): bool; var pt: PType; begin - pt := param.typ; - if (sfResult in param.flags) and not isInvalidReturnType(pt) then - result := false // BUGFIX - else if pt.Kind = tyObject then begin - // objects are always passed by reference, - // otherwise implicit casting doesn't work - result := true; - end - else if (pt.kind in [tyRecordConstr, tyRecord]) and - ((getSize(pt) > platform.floatSize) or - (optByRef in param.options)) then begin - result := true; - end - else if isCArray(pt) then - result := false - else if (pt.kind = tyVar) or (getSize(pt) > platform.floatSize) then begin - result := true; + pt := s.typ; + assert(not (sfResult in s.flags)); + case pt.Kind of + tyObject: begin + if (optByRef in s.options) or (getSize(pt) > platform.floatSize) then + result := true // requested anyway + else if (tfFinal in pt.flags) and (pt.sons[0] = nil) then + result := false // no need, because no subtyping possible + else + result := true; // ordinary objects are always passed by reference, + // otherwise casting doesn't work + end; + tyTuple: + result := (getSize(pt) > platform.floatSize) or (optByRef in s.options); + else + result := false end - else - result := false end; -const - PointerTypes = {@set}[tySequence, tyString, tyRef, tyPtr, tyPointer]; - procedure fillResult(param: PSym); begin - fillLoc(param.loc, locParam, param.typ, - toRope('Result'), {@set}[lfOnUnknown]); - if UsePtrPassing(param) then param.loc.indirect := 1 + fillLoc(param.loc, locParam, param.typ, toRope('Result'), OnStack); + if (mapType(param.typ) <> ctArray) and IsInvalidReturnType(param.typ) then + begin + include(param.loc.flags, lfIndirect); + param.loc.s := OnUnknown + end end; -procedure genProcParams(t: PType; out rettype, params: PRope); +procedure genProcParams(m: BModule; t: PType; out rettype, params: PRope); var i, j: int; param: PSym; @@ -165,31 +177,25 @@ begin // C cannot return arrays (what a poor language...) rettype := toRope('void') else - rettype := getTypeDesc(t.sons[0]); + rettype := getTypeDesc(m, t.sons[0]); for i := 1 to sonsLen(t.n)-1 do begin - assert(t.n.sons[i].kind = nkSym); + if t.n.sons[i].kind <> nkSym then InternalError(t.n.info, 'genProcParams'); param := t.n.sons[i].sym; - fillLoc(param.loc, locParam, param.typ, - con(toRope('Par'), toRope(i)), {@set}[lfOnStack]); - if param.typ.kind = tyVar then begin - param.loc.flags := {@set}[lfOnUnknown]; // BUGFIX! - app(params, getTypeDesc(param.typ.sons[0])); - end - else - app(params, getTypeDesc(param.typ)); - if UsePtrPassing(param) then begin + fillLoc(param.loc, locParam, param.typ, mangleName(param), OnStack); + app(params, getTypeDesc(m, param.typ)); + if ccgIntroducedPtr(param) then begin app(params, '*'+''); - param.loc.indirect := 1 + include(param.loc.flags, lfIndirect); + param.loc.s := OnUnknown; end; app(params, ' '+''); - app(params, param.loc.r); // declare the len field for open arrays: arr := param.typ; if arr.kind = tyVar then arr := arr.sons[0]; j := 0; while arr.Kind = tyOpenArray do begin // need to pass hidden parameter: - appRopeFormat(params, ', const int $1Len$2', [param.loc.r, toRope(j)]); + appf(params, ', NI $1Len$2', [param.loc.r, toRope(j)]); inc(j); arr := arr.sons[0] end; @@ -197,8 +203,8 @@ begin end; if (t.sons[0] <> nil) and isInvalidReturnType(t.sons[0]) then begin if params <> nil then app(params, ', '); - app(params, getTypeDesc(t.sons[0])); - if not isCArray(t.sons[0]) then app(params, '*'+''); + app(params, getTypeDesc(m, t.sons[0])); + if mapType(t.sons[0]) <> ctArray then app(params, '*'+''); app(params, ' Result'); end; if t.callConv = ccClosure then begin @@ -216,11 +222,6 @@ begin params := con('('+'', params); end; -function getLengthOfSet(s: PNode): int; -begin - result := int(getSize(s.typ)) -end; - function isImportedType(t: PType): bool; begin result := (t.sym <> nil) and (sfImportc in t.sym.flags) @@ -228,25 +229,10 @@ end; function getTypeName(typ: PType): PRope; begin - if typ.sym <> nil then begin - result := typ.sym.loc.r; - if result = nil then begin - assert(typ.owner <> nil); - result := toRope(mangle(typ.owner.Name.s) + '_' +{&} - mangle(typ.sym.name.s)); - end - end + if (typ.sym <> nil) and ([sfImportc, sfExportc] * typ.sym.flags <> []) then + result := typ.sym.loc.r else begin - // we must use a unique type id here because we don't store - // whether a type has to be given a certain name because its - // forward declaration has already been given: - if typ.loc.r = nil then begin - inc(currMod.unique); - assert(typ.owner <> nil); - typ.loc.r := ropeFormat('$1_Ty$2', [ - toRope(mangle(typ.owner.Name.s)), - toRope(currMod.unique)]) - end; + if typ.loc.r = nil then typ.loc.r := con('Ty', toRope(typ.id)); result := typ.loc.r end end; @@ -262,18 +248,18 @@ end; function getSimpleTypeDesc(typ: PType): PRope; const NumericalTypeToStr: array [tyInt..tyFloat128] of string = ( - 'NS', 'NS8', 'NS16', 'NS32', 'NS64', 'NF', 'NF32', 'NF64', 'NF128'); + 'NI', 'NI8', 'NI16', 'NI32', 'NI64', 'NF', 'NF32', 'NF64', 'NF128'); begin case typ.Kind of tyPointer: result := typeNameOrLiteral(typ, 'void*'); tyEnum: begin if firstOrd(typ) < 0 then - result := typeNameOrLiteral(typ, 'NS32') + result := typeNameOrLiteral(typ, 'NI32') else begin case int(getSize(typ)) of 1: result := typeNameOrLiteral(typ, 'NU8'); 2: result := typeNameOrLiteral(typ, 'NU16'); - 4: result := typeNameOrLiteral(typ, 'NS32'); + 4: result := typeNameOrLiteral(typ, 'NI32'); else begin internalError('getSimpleTypeDesc()'); result := nil @@ -293,14 +279,14 @@ begin end end; -function getTypePre(typ: PType): PRope; +function getTypePre(m: BModule; typ: PType): PRope; begin if typ = nil then result := toRope('void') else begin result := getSimpleTypeDesc(typ); if result = nil then - result := CacheGetType(currMod.typeCache, typ) + result := CacheGetType(m.typeCache, typ) end end; @@ -310,19 +296,18 @@ begin else result := 'typedef struct $1 $1;$n' end; -function getTypeForward(typ: PType): PRope; +function getTypeForward(m: BModule; typ: PType): PRope; begin - result := CacheGetType(currMod.forwTypeCache, typ); + result := CacheGetType(m.forwTypeCache, typ); if result <> nil then exit; - result := getTypePre(typ); + result := getTypePre(m, typ); if result <> nil then exit; case typ.kind of - tySequence, tyRecord, tyObject: begin + tySequence, tyTuple, tyObject: begin result := getTypeName(typ); if not isImportedType(typ) then - appRopeFormat(currMod.s[cfsForwardTypes], - getForwardStructFormat(), [result]); - IdTablePut(currMod.forwTypeCache, typ, result) + appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]); + IdTablePut(m.forwTypeCache, typ, result) end else InternalError('getTypeForward(' + typeKindToStr[typ.kind] + ')') @@ -333,205 +318,254 @@ function mangleRecFieldName(field: PSym; rectype: PType): PRope; begin if (rectype.sym <> nil) and ([sfImportc, sfExportc] * rectype.sym.flags <> []) then - result := toRope(field.name.s) + result := field.loc.r else - result := toRope(mangle(field.name.s)) + result := toRope(mangle(field.name.s)); + if result = nil then InternalError(field.info, 'mangleRecFieldName'); end; -function genRecordFieldsAux(n: PNode; accessExpr: PRope; rectype: PType): PRope; +function genRecordFieldsAux(m: BModule; n: PNode; accessExpr: PRope; + rectype: PType): PRope; var i: int; ae, uname, sname, a: PRope; - m: PNode; + k: PNode; field: PSym; begin result := nil; case n.kind of nkRecList: begin for i := 0 to sonsLen(n)-1 do begin - app(result, genRecordFieldsAux(n.sons[i], accessExpr, rectype)); + app(result, genRecordFieldsAux(m, n.sons[i], accessExpr, rectype)); end end; nkRecCase: begin - assert(n.sons[0].kind = nkSym); - app(result, genRecordFieldsAux(n.sons[0], accessExpr, rectype)); + if (n.sons[0].kind <> nkSym) then + InternalError(n.info, 'genRecordFieldsAux'); + app(result, genRecordFieldsAux(m, n.sons[0], accessExpr, rectype)); uname := toRope(mangle(n.sons[0].sym.name.s)+ 'U'); - if accessExpr <> nil then ae := ropeFormat('$1.$2', [accessExpr, uname]) + if accessExpr <> nil then ae := ropef('$1.$2', [accessExpr, uname]) else ae := uname; app(result, 'union {'+tnl); for i := 1 to sonsLen(n)-1 do begin case n.sons[i].kind of nkOfBranch, nkElse: begin - m := lastSon(n.sons[i]); - if m.kind <> nkSym then begin + k := lastSon(n.sons[i]); + if k.kind <> nkSym then begin sname := con('S'+'', toRope(i)); - a := genRecordFieldsAux(m, ropeFormat('$1.$2', [ae, sname]), + a := genRecordFieldsAux(m, k, ropef('$1.$2', [ae, sname]), rectype); if a <> nil then begin app(result, 'struct {'); app(result, a); - appRopeFormat(result, '} $1;$n', [sname]); + appf(result, '} $1;$n', [sname]); end end - else app(result, genRecordFieldsAux(m, ae, rectype)); + else app(result, genRecordFieldsAux(m, k, ae, rectype)); end; else internalError('genRecordFieldsAux(record case branch)'); end; end; - appRopeFormat(result, '} $1;$n', [uname]) + appf(result, '} $1;$n', [uname]) end; nkSym: begin field := n.sym; assert(field.ast = nil); sname := mangleRecFieldName(field, rectype); - if accessExpr <> nil then ae := ropeFormat('$1.$2', [accessExpr, sname]) + if accessExpr <> nil then ae := ropef('$1.$2', [accessExpr, sname]) else ae := sname; - fillLoc(field.loc, locField, field.typ, ae, {@set}[]); - appRopeFormat(result, '$1 $2;$n', [getTypeDesc(field.loc.t), sname]) + fillLoc(field.loc, locField, field.typ, ae, OnUnknown); + appf(result, '$1 $2;$n', [getTypeDesc(m, field.loc.t), sname]) end; else internalError(n.info, 'genRecordFieldsAux()'); end end; -function getRecordFields(typ: PType): PRope; +function getRecordFields(m: BModule; typ: PType): PRope; begin - result := genRecordFieldsAux(typ.n, nil, typ); + result := genRecordFieldsAux(m, typ.n, nil, typ); end; -function getRecordDesc(typ: PType; name: PRope): PRope; +function getRecordDesc(m: BModule; typ: PType; name: PRope): PRope; var desc: PRope; + hasField: bool; begin // declare the record: + hasField := false; if typ.kind = tyObject then begin - useMagic('TNimType'); + useMagic(m, 'TNimType'); if typ.sons[0] = nil then begin - if (typ.sym <> nil) and (sfPure in typ.sym.flags) then - result := ropeFormat('struct $1 {$n', [name]) - else - result := ropeFormat('struct $1 {$nTNimType* m_type;$n', [name]) + if (typ.sym <> nil) and (sfPure in typ.sym.flags) + or (tfFinal in typ.flags) then + result := ropef('struct $1 {$n', [name]) + else begin + result := ropef('struct $1 {$nTNimType* m_type;$n', [name]); + hasField := true + end + end + else if gCmd = cmdCompileToCpp then begin + result := ropef('struct $1 : public $2 {$n', + [name, getTypeDesc(m, typ.sons[0])]); + hasField := true + end + else begin + result := ropef('struct $1 {$n $2 Sup;$n', + [name, getTypeDesc(m, typ.sons[0])]); + hasField := true end - else if gCmd = cmdCompileToCpp then - result := ropeFormat('struct $1 : public $2 {$n', - [name, getTypeDesc(typ.sons[0])]) - else - result := ropeFormat('struct $1 {$n $2 Sup;$n', - [name, getTypeDesc(typ.sons[0])]) end else - result := ropeFormat('struct $1 {$n', [name]); - desc := getRecordFields(typ); - if (typ.kind <> tyObject) and (desc = nil) and (gCmd <> cmdCompileToCpp) then + result := ropef('struct $1 {$n', [name]); + desc := getRecordFields(m, typ); + if (desc = nil) and not hasField then // no fields in struct are not valid in C, so generate a dummy: - appRopeFormat(result, 'char dummy;$n', []) + appf(result, 'char dummy;$n', []) else app(result, desc); app(result, '};' + tnl); end; -function getTypeDesc(typ: PType): PRope; +procedure pushType(m: BModule; typ: PType); +var + L: int; +begin + L := length(m.typeStack); + setLength(m.typeStack, L+1); + m.typeStack[L] := typ; +end; + +function getTypeDesc(m: BModule; typ: PType): PRope; // returns only the type's name var name, rettype, desc, recdesc: PRope; n: biggestInt; + t, et: PType; begin - if typ.sym <> nil then useHeader(typ.sym); - result := getTypePre(typ); + t := getUniqueType(typ); + if t = nil then InternalError('getTypeDesc: t == nil'); + if t.sym <> nil then useHeader(m, t.sym); + result := getTypePre(m, t); if result <> nil then exit; - case typ.Kind of + case t.Kind of tyRef, tyPtr, tyVar, tyOpenArray: begin - case typ.sons[0].Kind of - tyRecord, tyObject, tySequence: begin - // no restriction! - // We have a forward declaration for structs - name := getTypeForward(typ.sons[0]); + et := getUniqueType(t.sons[0]); + if et.kind in [tyArrayConstr, tyArray, tyOpenArray] then + et := getUniqueType(elemType(et)); + case et.Kind of + tyObject, tyTuple: begin + // no restriction! We have a forward declaration for structs + name := getTypeForward(m, et); result := con(name, '*'+''); - IdTablePut(currMod.typeCache, typ, result) + IdTablePut(m.typeCache, t, result); + pushType(m, et); + end; + tySequence: begin + // no restriction! We have a forward declaration for structs + name := getTypeForward(m, et); + result := con(name, '**'); + IdTablePut(m.typeCache, t, result); + pushType(m, et); end; else begin // else we have a strong dependency :-( - result := con(getTypeDesc(typ.sons[0]), '*'+''); - IdTablePut(currMod.typeCache, typ, result) + result := con(getTypeDesc(m, et), '*'+''); + IdTablePut(m.typeCache, t, result) end end end; tyProc: begin - result := getTypeName(typ); - IdTablePut(currMod.typeCache, typ, result); - genProcParams(typ, rettype, desc); - if not isImportedType(typ) then begin - if typ.callConv <> ccClosure then - appRopeFormat(currMod.s[cfsTypes], 'typedef $1_PTR($2, $3) $4;$n', - [toRope(CallingConvToStr[typ.callConv]), rettype, result, desc]) + result := getTypeName(t); + IdTablePut(m.typeCache, t, result); + genProcParams(m, t, rettype, desc); + if not isImportedType(t) then begin + if t.callConv <> ccClosure then + appf(m.s[cfsTypes], 'typedef $1_PTR($2, $3) $4;$n', + [toRope(CallingConvToStr[t.callConv]), rettype, result, desc]) else // procedure vars may need a closure! - appRopeFormat(currMod.s[cfsTypes], 'typedef struct $1 {$n' + - 'N_CDECL_PTR($2, PrcPart) $3;$n' + - 'void* ClPart;$n};$n', + appf(m.s[cfsTypes], 'typedef struct $1 {$n' + + 'N_CDECL_PTR($2, PrcPart) $3;$n' + + 'void* ClPart;$n};$n', [result, rettype, desc]); end end; tySequence: begin - // we cannot use getTypeForward here because then typ would be associated + // we cannot use getTypeForward here because then t would be associated // with the name of the struct, not with the pointer to the struct: - result := getTypeName(typ); - IdTablePut(currMod.typeCache, typ, con(result, '*'+'')); - if not isImportedType(typ) then begin - appRopeFormat(currMod.s[cfsForwardTypes], - getForwardStructFormat(), [result]); - appRopeFormat(currMod.s[cfsSeqTypes], - // BUGFIX: needed to introduce cfsSeqTypes + result := CacheGetType(m.forwTypeCache, t); + if result = nil then begin + result := getTypeName(t); + if not isImportedType(t) then + appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]); + IdTablePut(m.forwTypeCache, t, result); + end; + assert(CacheGetType(m.typeCache, t) = nil); + IdTablePut(m.typeCache, t, con(result, '*'+'')); + if not isImportedType(t) then + appf(m.s[cfsSeqTypes], 'struct $2 {$n' + - ' NS len, space;$n' + + ' NI len, space;$n' + ' $1 data[SEQ_DECL_SIZE];$n' + - '};$n', [getTypeDesc(typ.sons[0]), result]); - end; + '};$n', [getTypeDesc(m, t.sons[0]), result]); app(result, '*'+''); end; tyArrayConstr, tyArray: begin - n := lengthOrd(typ); + n := lengthOrd(t); if n <= 0 then n := 1; // make an array of at least one element - result := getTypeName(typ); - IdTablePut(currMod.typeCache, typ, result); - if not isImportedType(typ) then - appRopeFormat(currMod.s[cfsTypes], 'typedef $1 $2[$3];$n', - [getTypeDesc(typ.sons[1]), result, ToRope(n)]) + result := getTypeName(t); + IdTablePut(m.typeCache, t, result); + if not isImportedType(t) then + appf(m.s[cfsTypes], 'typedef $1 $2[$3];$n', + [getTypeDesc(m, t.sons[1]), result, ToRope(n)]) end; - tyObject, tyRecord, tyRecordConstr: begin - result := getTypeName(typ); - IdTablePut(currMod.typeCache, typ, result); - recdesc := getRecordDesc(typ, result); // always compute for sideeffects - if not isImportedType(typ) then - app(currMod.s[cfsTypes], recdesc); - if CacheGetType(currMod.forwTypeCache, typ) = nil then begin - if not isImportedType(typ) then - appRopeFormat(currMod.s[cfsForwardTypes], + tyObject, tyTuple: begin + result := CacheGetType(m.forwTypeCache, t); + if result = nil then begin + result := getTypeName(t); + if not isImportedType(t) then + appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]); - IdTablePut(currMod.forwTypeCache, typ, result) - end + IdTablePut(m.forwTypeCache, t, result) + end; + IdTablePut(m.typeCache, t, result); + recdesc := getRecordDesc(m, t, result); // always call for sideeffects + if not isImportedType(t) then app(m.s[cfsTypes], recdesc); end; tySet: begin - case int(getSize(typ)) of - 1: result := toRope('NS8'); - 2: result := toRope('NS16'); - 4: result := toRope('NS32'); - 8: result := toRope('NS64'); + case int(getSize(t)) of + 1: result := toRope('NU8'); + 2: result := toRope('NU16'); + 4: result := toRope('NU32'); + 8: result := toRope('NU64'); else begin - result := getTypeName(typ); - IdTablePut(currMod.typeCache, typ, result); - if not isImportedType(typ) then - appRopeFormat(currMod.s[cfsTypes], 'typedef NS8 $1[$2];$n', - [result, toRope(getSize(typ))]) + result := getTypeName(t); + IdTablePut(m.typeCache, t, result); + if not isImportedType(t) then + appf(m.s[cfsTypes], 'typedef NU8 $1[$2];$n', + [result, toRope(getSize(t))]) end end - end + end; + tyGenericInst: result := getTypeDesc(m, lastSon(t)); else begin - InternalError('getTypeDesc(' + typeKindToStr[typ.kind] + ')'); + InternalError('getTypeDesc(' + typeKindToStr[t.kind] + ')'); result := nil end end end; -function genProcHeader(prc: PSym): PRope; +procedure finishTypeDescriptions(m: BModule); +var + i: int; +begin + i := 0; + while i < length(m.typeStack) do begin + {@discard} getTypeDesc(m, m.typeStack[i]); + inc(i); + end; +end; + +function genProcHeader(m: BModule; prc: PSym): PRope; var rettype, params: PRope; begin @@ -540,9 +574,9 @@ begin result := toRope('static ') else result := nil; - fillLoc(prc.loc, locProc, prc.typ, mangleName(prc), {@set}[]); - genProcParams(prc.typ, rettype, params); - appRopeFormat(result, '$1($2, $3)$4', + fillLoc(prc.loc, locProc, prc.typ, mangleName(prc), OnUnknown); + genProcParams(m, prc.typ, rettype, params); + appf(result, '$1($2, $3)$4', [toRope(CallingConvToStr[prc.typ.callConv]), rettype, prc.loc.r, params]) end; @@ -559,19 +593,26 @@ var tmp: PRope; begin tmp := getTempName(); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimType $1;$n', [tmp]); - appRopeFormat(m.s[cfsTypeInit2], '$2 = &$1;$n', [tmp, name]); + appf(m.s[cfsTypeInit1], 'static TNimType $1;$n', [tmp]); + appf(m.s[cfsTypeInit2], '$2 = &$1;$n', [tmp, name]); end; procedure genTypeInfoAuxBase(m: BModule; typ: PType; name, base: PRope); +var + nimtypeKind: int; begin allocMemTI(m, name); - appRopeFormat(m.s[cfsTypeInit3], + if (typ.kind = tyObject) and (tfFinal in typ.flags) + and (typ.sons[0] = nil) then + nimtypeKind := ord(high(TTypeKind))+1 // tyPureObject + else + nimtypeKind := ord(typ.kind); + appf(m.s[cfsTypeInit3], '$1->size = sizeof($2);$n' + '$1->kind = $3;$n' + '$1->base = $4;$n', [ - name, getTypeDesc(typ), toRope(ord(typ.kind)), base]); - appRopeFormat(m.s[cfsVars], 'TNimType* $1;$n', [name]); + name, getTypeDesc(m, typ), toRope(nimtypeKind), base]); + appf(m.s[cfsVars], 'TNimType* $1;$n', [name]); end; procedure genTypeInfoAux(m: BModule; typ: PType; name: PRope); @@ -599,21 +640,21 @@ begin genObjectFields(m, typ, n.sons[0], expr) else if len > 0 then begin tmp := getTempName(); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', - [tmp, toRope(len)]); + appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', + [tmp, toRope(len)]); for i := 0 to len-1 do begin tmp2 := getTempName(); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp2]); - appRopeFormat(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', + appf(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp2]); + appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', [tmp, toRope(i), tmp2]); genObjectFields(m, typ, n.sons[i], tmp2); end; - appRopeFormat(m.s[cfsTypeInit3], - '$1.len = $2; $1.kind = 2; $1.sons = &$3;$n', [ + appf(m.s[cfsTypeInit3], + '$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n', [ expr, toRope(len), tmp]); end else - appRopeFormat(m.s[cfsTypeInit3], + appf(m.s[cfsTypeInit3], '$1.len = $2; $1.kind = 2;$n', [expr, toRope(len)]); end; nkRecCase: begin @@ -621,22 +662,22 @@ begin assert(n.sons[0].kind = nkSym); field := n.sons[0].sym; tmp := getTempName(); - appRopeFormat(m.s[cfsTypeInit3], '$1.kind = 3;$n' + - '$1.offset = offsetof($2, $3);$n' + - '$1.typ = $4;$n' + - '$1.name = $5;$n' + - '$1.sons = &$6;$n' + - '$1.len = $7;$n', - [expr, getTypeDesc(typ), field.loc.r, + appf(m.s[cfsTypeInit3], '$1.kind = 3;$n' + + '$1.offset = offsetof($2, $3);$n' + + '$1.typ = $4;$n' + + '$1.name = $5;$n' + + '$1.sons = &$6[0];$n' + + '$1.len = $7;$n', + [expr, getTypeDesc(m, typ), field.loc.r, genTypeInfo(m, field.typ), makeCString(field.name.s), tmp, toRope(lengthOrd(field.typ))]); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', + appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', [tmp, toRope(lengthOrd(field.typ)+1)]); for i := 1 to len-1 do begin b := n.sons[i]; // branch tmp2 := getTempName(); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp2]); + appf(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp2]); genObjectFields(m, typ, lastSon(b), tmp2); //writeln(output, renderTree(b.sons[j])); case b.kind of @@ -648,18 +689,18 @@ begin x := int(getOrdValue(b.sons[j].sons[0])); y := int(getOrdValue(b.sons[j].sons[1])); while x <= y do begin - appRopeFormat(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', + appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', [tmp, toRope(x), tmp2]); inc(x); end; end else - appRopeFormat(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', + appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', [tmp, toRope(getOrdValue(b.sons[j])), tmp2]) end end; nkElse: begin - appRopeFormat(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', + appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', [tmp, toRope(lengthOrd(field.typ)), tmp2]); end else @@ -669,13 +710,13 @@ begin end; nkSym: begin field := n.sym; - appRopeFormat(m.s[cfsTypeInit3], '$1.kind = 1;$n' + - '$1.offset = offsetof($2, $3);$n' + - '$1.typ = $4;$n' + - '$1.name = $5;$n', - [expr, getTypeDesc(typ), field.loc.r, - genTypeInfo(m, field.typ), - makeCString(field.name.s)]); + appf(m.s[cfsTypeInit3], '$1.kind = 1;$n' + + '$1.offset = offsetof($2, $3);$n' + + '$1.typ = $4;$n' + + '$1.name = $5;$n', + [expr, getTypeDesc(m, typ), field.loc.r, + genTypeInfo(m, field.typ), + makeCString(field.name.s)]); end; else internalError(n.info, 'genObjectFields'); end @@ -685,11 +726,12 @@ procedure genObjectInfo(m: BModule; typ: PType; name: PRope); var tmp: PRope; begin - genTypeInfoAux(m, typ, name); + if typ.kind = tyObject then genTypeInfoAux(m, typ, name) + else genTypeInfoAuxBase(m, typ, name, toRope('0'+'')); tmp := getTempName(); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp]); + appf(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp]); genObjectFields(m, typ, typ.n, tmp); - appRopeFormat(m.s[cfsTypeInit3], '$1->node = &$2;$n', [name, tmp]); + appf(m.s[cfsTypeInit3], '$1->node = &$2;$n', [name, tmp]); end; procedure genEnumInfo(m: BModule; typ: PType; name: PRope); @@ -702,25 +744,25 @@ begin tmp := getTempName(); tmp2 := getTempName(); len := sonsLen(typ.n); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n' + - 'static TNimNode $3;$n', - [tmp, toRope(len), tmp2]); + appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n' + + 'static TNimNode $3;$n', + [tmp, toRope(len), tmp2]); for i := 0 to len-1 do begin assert(typ.n.sons[i].kind = nkSym); field := typ.n.sons[i].sym; tmp3 := getTempName(); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp3]); - appRopeFormat(m.s[cfsTypeInit3], '$1[$2] = &$3;$n' + - '$3.kind = 1;$n' + - '$3.offset = $4;$n' + - '$3.typ = $5;$n' + - '$3.name = $6;$n', + appf(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp3]); + appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n' + + '$3.kind = 1;$n' + + '$3.offset = $4;$n' + + '$3.typ = $5;$n' + + '$3.name = $6;$n', [tmp, toRope(i), tmp3, toRope(field.position), name, makeCString(field.name.s)]); end; - appRopeFormat(m.s[cfsTypeInit3], - '$1.len = $2; $1.kind = 2; $1.sons = &$3;$n$4->node = &$1;$n', [ + appf(m.s[cfsTypeInit3], + '$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n$4->node = &$1;$n', [ tmp2, toRope(len), tmp, name]); end; @@ -731,8 +773,8 @@ begin assert(typ.sons[0] <> nil); genTypeInfoAux(m, typ, name); tmp := getTempName(); - appRopeFormat(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp]); - appRopeFormat(m.s[cfsTypeInit3], + appf(m.s[cfsTypeInit1], 'static TNimNode $1;$n', [tmp]); + appf(m.s[cfsTypeInit3], '$1.len = $2; $1.kind = 0;$n' + '$3->node = &$1;$n', [tmp, toRope(firstOrd(typ)), name]); end; @@ -746,14 +788,13 @@ function genTypeInfo(m: BModule; typ: PType): PRope; var t: PType; begin - t := typ; - if t.kind = tyGenericInst then t := lastSon(t); - result := ropeFormat('NTI$1', [toRope(t.id)]); + t := getUniqueType(typ); + result := ropef('NTI$1', [toRope(t.id)]); if not IntSetContainsOrIncl(m.typeInfoMarker, t.id) then begin // declare type information structures: - useMagic('TNimType'); - useMagic('TNimNode'); - appRopeFormat(m.s[cfsVars], 'extern TNimType* $1;$n', [result]); + useMagic(m, 'TNimType'); + useMagic(m, 'TNimNode'); + appf(m.s[cfsVars], 'extern TNimType* $1;$n', [result]); end; if IntSetContainsOrIncl(gTypeInfoGenerated, t.id) then exit; case t.kind of @@ -763,7 +804,7 @@ begin tyArrayConstr, tyArray: genArrayInfo(m, t, result); tySet: genSetInfo(m, t, result); tyEnum: genEnumInfo(m, t, result); - tyObject, tyRecord, tyRecordConstr: genObjectInfo(m, t, result); + tyObject, tyTuple: genObjectInfo(m, t, result); tyVar: result := genTypeInfo(m, typ.sons[0]); else InternalError('genTypeInfo(' + typekindToStr[t.kind] + ')'); end diff --git a/nim/ccgutils.pas b/nim/ccgutils.pas index 6817f4518..09cd504bc 100644 --- a/nim/ccgutils.pas +++ b/nim/ccgutils.pas @@ -17,15 +17,41 @@ interface uses charsets, nsystem, - ast, astalgo, ropes, lists, hashes, strutils, types; + ast, astalgo, ropes, lists, hashes, strutils, types, msgs; function toCChar(c: Char): string; function makeCString(const s: string): PRope; function TableGetType(const tab: TIdTable; key: PType): PObject; +function GetUniqueType(key: PType): PType; implementation +var + gTypeTable: TIdTable; + +function GetUniqueType(key: PType): PType; +var + t: PType; + h: THash; +begin + result := key; + if key = nil then exit; + assert(key.kind <> tyForward); + if key.kind = tyGenericInst then begin + result := GetUniqueType(lastSon(key)); + exit + end; + if IdTableHasObjectAsKey(gTypeTable, key) then exit; + // we have to do a slow linear search because types may need + // to be compared by their structure: + for h := 0 to high(gTypeTable.data) do begin + t := PType(gTypeTable.data[h].key); + if (t <> nil) and sameType(t, key) then begin result := t; exit end + end; + IdTablePut(gTypeTable, key, key); +end; + function TableGetType(const tab: TIdTable; key: PType): PObject; var t: PType; @@ -69,7 +95,7 @@ begin result := nil; res := '"'+''; for i := strStart to length(s)+strStart-1 do begin - if i mod MaxLineLength = 0 then begin + if (i-strStart+1) mod MaxLineLength = 0 then begin res := res +{&} '"' +{&} nl; app(result, toRope(res)); res := '"'+''; // reset @@ -80,4 +106,6 @@ begin app(result, toRope(res)); end; +initialization + InitIdTable(gTypeTable); end. diff --git a/nim/cgen.pas b/nim/cgen.pas index 9c0e122f2..677a9b0ac 100644 --- a/nim/cgen.pas +++ b/nim/cgen.pas @@ -43,13 +43,28 @@ type cfsProcHeaders, // section for C procs prototypes cfsProcs, // section for C procs that are not inline cfsTypeInit1, // section 1 for declarations of type information - cfsTypeInit2, // section A for initialization of type information - cfsTypeInit3, // section B for init of type information + cfsTypeInit2, // section 2 for initialization of type information + cfsTypeInit3, // section 3 for init of type information cfsDebugInit, // section for initialization of debug information cfsDynLibInit, // section for initialization of dynamic library binding cfsDynLibDeinit // section for deinitialization of dynamic libraries ); + TCTypeKind = ( // describes the type kind of a C type + ctVoid, + ctChar, + ctBool, + ctUInt, ctUInt8, ctUInt16, ctUInt32, ctUInt64, + ctInt, ctInt8, ctInt16, ctInt32, ctInt64, + ctFloat, ctFloat32, ctFloat64, ctFloat128, + ctArray, + ctStruct, + ctPtr, + ctNimStr, + ctNimSeq, + ctProc, + ctCString + ); TCFileSections = array [TCFileSection] of PRope; // TCFileSections represents a generated C file @@ -66,15 +81,20 @@ type BModule = ^TCGen; BProc = ^TCProc; + TBlock = record + id: int; // the ID of the label; positive means that it + // has been used (i.e. the label should be emitted) + nestedTryStmts: int; // how many try statements is it nested into + end; + TCProc = record // represents C proc that is currently generated s: TCProcSections; // the procs sections; short name for readability prc: PSym; // the Nimrod proc that this C proc belongs to BeforeRetNeeded: bool; // true iff 'BeforeRet' label for proc is needed - inTryStmt: Natural; // wether we are in a try statement + nestedTryStmts: Natural; // in how many nested try statements we are // (the vars must be volatile then) - unique: Natural; // for generating unique names in the C proc - blocks: array of int; // the ID of the label; positive means that it - // has been used (i.e. the label should be emitted) + labels: Natural; // for generating unique labels in the C proc + blocks: array of TBlock; // nested blocks locals: array of TLoc; // locNone means slot is free again options: TOptions; // options that should be used for code // generation; this is the same as prc.options @@ -82,8 +102,9 @@ type frameLen: int; // current length of frame descriptor sendClosure: PType; // closure record type that we pass receiveClosure: PType; // closure record type that we get + module: BModule; // used to prevent excessive parameter passing end; - + TTypeSeq = array of PType; TCGen = object(TBackend) // represents a C source file s: TCFileSections; // sections of the C file cfilename: string; // filename of the module (including path, @@ -93,55 +114,48 @@ type declaredThings: TIntSet; // things we have declared in this .c file debugDeclared: TIntSet; // for debugging purposes headerFiles: TLinkedList; // needed headers to include - unique: Natural; // for generating unique names + //unique: Natural; // for generating unique names typeInfoMarker: TIntSet; // needed for generating type information initProc: BProc; // code for init procedure + typeStack: TTypeSeq; // used for type generation end; var - currMod: BModule; // currently compiled module - // a global so that this needs not to be - // passed to every proc + gUnique: Natural; mainModProcs, mainModInit: PRope; // parts of the main module gMapping: PRope; // the generated mapping file (if requested) - constTok: PRope; // either 'const ' or nil depending on gCmd - -function initLoc(k: TLocKind; typ: PType): TLoc; +function initLoc(k: TLocKind; typ: PType; s: TStorageLoc): TLoc; begin result.k := k; - result.t := typ; + result.s := s; + result.t := GetUniqueType(typ); result.r := nil; result.a := -1; - result.indirect := 0; result.flags := {@set}[] end; procedure fillLoc(var a: TLoc; k: TLocKind; typ: PType; r: PRope; - flags: TLocFlags); + s: TStorageLoc); begin // fills the loc if it is not already initialized if a.k = locNone then begin a.k := k; - if typ.kind = tyGenericInst then a.t := lastSon(typ) else a.t := typ; + a.t := getUniqueType(typ); a.a := -1; + a.s := s; if a.r = nil then a.r := r; - a.flags := a.flags + flags end end; -procedure inheritStorage(var dest: TLoc; const src: TLoc); -begin - dest.flags := src.flags * [lfOnStack, lfOnHeap, lfOnData, lfOnUnknown] -end; - -function newProc(prc: PSym): BProc; +function newProc(prc: PSym; module: BModule): BProc; begin new(result); {@ignore} fillChar(result^, sizeof(result^), 0); {@emit} result.prc := prc; + result.module := module; if prc <> nil then result.options := prc.options else @@ -157,20 +171,19 @@ end; function isSimpleConst(typ: PType): bool; begin - result := not (skipAbstract(typ).kind in [tyRecord, tyRecordConstr, - tyObject, tyArray, + result := not (skipVarGeneric(typ).kind in [tyTuple, tyObject, tyArray, tyArrayConstr, tySet, tySequence]) end; -procedure useHeader(sym: PSym); +procedure useHeader(m: BModule; sym: PSym); begin if lfHeader in sym.loc.Flags then begin assert(sym.annex <> nil); - {@discard} lists.IncludeStr(currMod.headerFiles, PLib(sym.annex).path) + {@discard} lists.IncludeStr(m.headerFiles, PLib(sym.annex).path) end end; -procedure UseMagic(const name: string); forward; +procedure UseMagic(m: BModule; const name: string); forward; // ----------------------------- name mangling // +++++++++++++++++++++++++++++ type generation @@ -182,14 +195,14 @@ procedure UseMagic(const name: string); forward; function beEqualTypes(a, b: PType): bool; begin // returns whether two type are equal for the backend - result := sameType(skipAbstract(a), skipAbstract(b)) + result := sameType(skipGenericRange(a), skipGenericRange(b)) end; function getTemp(p: BProc; t: PType): TLoc; var i, index: int; name: PRope; -begin +begin (* for i := 0 to high(p.locals) do begin assert(i = p.locals[i].a); if (p.locals[i].k = locNone) and beEqualTypes(p.locals[i].t, t) then begin @@ -198,41 +211,41 @@ begin result := p.locals[i]; exit end - end; + end; *) // not found: index := length(p.locals); setLength(p.locals, index+1); // declare the new temporary: name := con('Loc', toRope(index)); - appRopeFormat(p.s[cpsLocals], '$1 $2; /* temporary */$n', - [getTypeDesc(t), name]); + appf(p.s[cpsLocals], '$1 $2; /* temporary */$n', + [getTypeDesc(p.module, t), name]); p.locals[index].k := locTemp; p.locals[index].a := index; p.locals[index].r := name; - p.locals[index].t := t; - p.locals[index].flags := {@set}[lfOnStack]; + p.locals[index].t := getUniqueType(t); + p.locals[index].s := OnStack; + p.locals[index].flags := {@set}[]; result := p.locals[index] // BUGFIX! end; procedure freeTemp(p: BProc; const temp: TLoc); -begin +begin (* if (temp.a >= 0) and (temp.a < length(p.locals)) and (p.locals[temp.a].k = locTemp) then - p.locals[temp.a].k := locNone + p.locals[temp.a].k := locNone *) end; // -------------------------- Variable manager ---------------------------- -procedure declareGlobalVar(s: PSym); +procedure declareGlobalVar(m: BModule; s: PSym); begin - if not IntSetContainsOrIncl(currMod.declaredThings, s.id) then begin - app(currMod.s[cfsVars], getTypeDesc(s.loc.t)); + if not IntSetContainsOrIncl(m.declaredThings, s.id) then begin + app(m.s[cfsVars], getTypeDesc(m, s.loc.t)); if sfRegister in s.flags then - app(currMod.s[cfsVars], ' register'); + app(m.s[cfsVars], ' register'); if sfVolatile in s.flags then - app(currMod.s[cfsVars], ' volatile'); - appRopeFormat(currMod.s[cfsVars], ' $1; /* $2 */$n', - [s.loc.r, toRope(s.name.s)]) + app(m.s[cfsVars], ' volatile'); + appf(m.s[cfsVars], ' $1;$n', [s.loc.r]) end end; @@ -241,39 +254,38 @@ begin //assert(s.loc.k == locNone) // not yet assigned // this need not be fullfilled for inline procs; they are regenerated // for each module that uses them! - fillLoc(s.loc, locLocalVar, s.typ, mangleName(s), {@set}[lfOnStack]); - app(p.s[cpsLocals], getTypeDesc(s.loc.t)); + fillLoc(s.loc, locLocalVar, s.typ, mangleName(s), OnStack); + app(p.s[cpsLocals], getTypeDesc(p.module, s.loc.t)); if sfRegister in s.flags then app(p.s[cpsLocals], ' register'); - if (sfVolatile in s.flags) or (p.inTryStmt > 0) then + if (sfVolatile in s.flags) or (p.nestedTryStmts > 0) then app(p.s[cpsLocals], ' volatile'); - appRopeFormat(p.s[cpsLocals], ' $1; /* $2 */$n', - [s.loc.r, toRope(s.name.s)]); + appf(p.s[cpsLocals], ' $1;$n', [s.loc.r]); // if debugging we need a new slot for the local variable: if [optStackTrace, optEndb] * p.Options = [optStackTrace, optEndb] then begin - appRopeFormat(p.s[cpsInit], + appf(p.s[cpsInit], 'F.s[$1].name = $2; F.s[$1].address = (void*)&$3; F.s[$1].typ = $4;$n', [toRope(p.frameLen), makeCString(normalize(s.name.s)), s.loc.r, - genTypeInfo(currMod, s.loc.t)]); + genTypeInfo(p.module, s.loc.t)]); inc(p.frameLen); end end; -procedure assignGlobalVar(s: PSym); +procedure assignGlobalVar(m: BModule; s: PSym); begin - fillLoc(s.loc, locGlobalVar, s.typ, mangleName(s), {@set}[lfOnData]); - useHeader(s); + fillLoc(s.loc, locGlobalVar, s.typ, mangleName(s), OnHeap); + useHeader(m, s); if lfNoDecl in s.loc.flags then exit; - if sfImportc in s.flags then app(currMod.s[cfsVars], 'extern '); - declareGlobalVar(s); - if [optStackTrace, optEndb] * currMod.module.options = + if sfImportc in s.flags then app(m.s[cfsVars], 'extern '); + declareGlobalVar(m, s); + if [optStackTrace, optEndb] * m.module.options = [optStackTrace, optEndb] then begin - useMagic('dbgRegisterGlobal'); - appRopeFormat(currMod.s[cfsDebugInit], + useMagic(m, 'dbgRegisterGlobal'); + appf(m.s[cfsDebugInit], 'dbgRegisterGlobal($1, &$2, $3);$n', [makeCString(normalize(s.owner.name.s + '.' +{&} s.name.s)), s.loc.r, - genTypeInfo(currMod, s.typ)]) + genTypeInfo(m, s.typ)]) end; end; @@ -286,12 +298,12 @@ procedure assignParam(p: BProc; s: PSym); begin assert(s.loc.r <> nil); if [optStackTrace, optEndb] * p.options = [optStackTrace, optEndb] then begin - appRopeFormat(p.s[cpsInit], + appf(p.s[cpsInit], 'F.s[$1].name = $2; F.s[$1].address = (void*)$3; ' + 'F.s[$1].typ = $4;$n', [toRope(p.frameLen), makeCString(normalize(s.name.s)), - iff(usePtrPassing(s), s.loc.r, con('&'+'', s.loc.r)), - genTypeInfo(currMod, s.loc.t)]); + iff(ccgIntroducedPtr(s), s.loc.r, con('&'+'', s.loc.r)), + genTypeInfo(p.module, s.loc.t)]); inc(p.frameLen) end end; @@ -301,19 +313,19 @@ end; // note that a label is a location too function getLabel(p: BProc): TLabel; begin - inc(p.unique); - result := con('L'+'', toRope(p.unique)) + inc(p.labels); + result := con('L'+'', toRope(p.labels)) end; procedure fixLabel(p: BProc; labl: TLabel); begin - appRopeFormat(p.s[cpsStmts], '$1: ;$n', [labl]) + appf(p.s[cpsStmts], '$1: ;$n', [labl]) end; -procedure genProcPrototype(sym: PSym); forward; -procedure genVarPrototype(sym: PSym); forward; -procedure genConstPrototype(sym: PSym); forward; -procedure genProc(prc: PSym); forward; +procedure genProcPrototype(m: BModule; sym: PSym); forward; +procedure genVarPrototype(m: BModule; sym: PSym); forward; +procedure genConstPrototype(m: BModule; sym: PSym); forward; +procedure genProc(m: BModule; prc: PSym); forward; procedure genStmts(p: BProc; t: PNode); forward; {$include 'ccgexprs.pas'} @@ -323,76 +335,76 @@ procedure genStmts(p: BProc; t: PNode); forward; // We don't finalize dynamic libs as this does the OS for us. -procedure loadDynamicLib(lib: PLib); +procedure loadDynamicLib(m: BModule; lib: PLib); var tmp: PRope; begin assert(lib <> nil); if lib.kind = libDynamic then begin lib.kind := libDynamicGenerated; - useMagic('nimLoadLibrary'); - useMagic('nimUnloadLibrary'); + useMagic(m, 'nimLoadLibrary'); + useMagic(m, 'nimUnloadLibrary'); tmp := getTempName(); - appRopeFormat(currMod.s[cfsVars], 'static void* $1;$n', [tmp]); - appRopeFormat(currMod.s[cfsDynLibInit], + appf(m.s[cfsVars], 'static void* $1;$n', [tmp]); + appf(m.s[cfsDynLibInit], '$1 = nimLoadLibrary((string) &$2);$n', - [tmp, getStrLit(lib.path)]); - appRopeFormat(currMod.s[cfsDynLibDeinit], + [tmp, getStrLit(m, lib.path)]); + appf(m.s[cfsDynLibDeinit], 'if ($1 != NIM_NIL) nimUnloadLibrary($1);$n', [tmp]); assert(lib.name = nil); lib.name := tmp end end; -procedure SymInDynamicLib(sym: PSym); +procedure SymInDynamicLib(m: BModule; sym: PSym); var lib: PLib; extname, tmp: PRope; begin lib := PLib(sym.annex); extname := sym.loc.r; - loadDynamicLib(lib); - useMagic('nimGetProcAddr'); - tmp := ropeFormat('Dl_$1', [toRope(sym.id)]); + loadDynamicLib(m, lib); + useMagic(m, 'nimGetProcAddr'); + tmp := ropef('Dl_$1', [toRope(sym.id)]); sym.loc.r := tmp; // from now on we only need the internal name sym.typ.sym := nil; // generate a new name - appRopeFormat(currMod.s[cfsDynLibInit], + appf(m.s[cfsDynLibInit], '$1 = ($2) nimGetProcAddr($3, $4);$n', - [tmp, getTypeDesc(sym.typ), lib.name, + [tmp, getTypeDesc(m, sym.typ), lib.name, makeCString(ropeToStr(extname))]); - declareGlobalVar(sym) + declareGlobalVar(m, sym) end; // ----------------------------- sections --------------------------------- -procedure UseMagic(const name: string); +procedure UseMagic(m: BModule; const name: string); var sym: PSym; begin - if (sfSystemModule in currMod.module.flags) then exit; + if (sfSystemModule in m.module.flags) then exit; // we don't know the magic symbols in the system module, but they will be // there anyway, because that is the way the code generator works sym := magicsys.getCompilerProc(name); case sym.kind of - skProc: genProcPrototype(sym); - skVar: genVarPrototype(sym); - skType: {@discard} getTypeDesc(sym.typ); + skProc, skConverter: genProcPrototype(m, sym); + skVar: genVarPrototype(m, sym); + skType: {@discard} getTypeDesc(m, sym.typ); else InternalError('useMagic: ' + name) end end; -procedure generateHeaders(); +procedure generateHeaders(m: BModule); var it: PStrEntry; begin - app(currMod.s[cfsHeaders], '#include "nimbase.h"' +{&} tnl +{&} tnl); - it := PStrEntry(currMod.headerFiles.head); + app(m.s[cfsHeaders], '#include "nimbase.h"' +{&} tnl +{&} tnl); + it := PStrEntry(m.headerFiles.head); while it <> nil do begin if not (it.data[strStart] in ['"', '<']) then - appRopeFormat(currMod.s[cfsHeaders], + appf(m.s[cfsHeaders], '#include "$1"$n', [toRope(it.data)]) else - appRopeFormat(currMod.s[cfsHeaders], '#include $1$n', [toRope(it.data)]); + appf(m.s[cfsHeaders], '#include $1$n', [toRope(it.data)]); it := PStrEntry(it.Next) end end; @@ -402,15 +414,15 @@ var slots: PRope; begin if p.frameLen > 0 then begin - useMagic('TVarSlot'); - slots := ropeFormat(' TVarSlot s[$1];$n', [toRope(p.frameLen)]) + useMagic(p.module, 'TVarSlot'); + slots := ropef(' TVarSlot s[$1];$n', [toRope(p.frameLen)]) end else slots := nil; - appRopeFormat(p.s[cpsLocals], 'volatile struct {TFrame* prev;' + - 'NCSTRING procname;NS line;NCSTRING filename;' + - 'NS len;$n$1} F;$n', [slots]); - prepend(p.s[cpsInit], ropeFormat('F.len = $1;$n', [toRope(p.frameLen)])) + appf(p.s[cpsLocals], 'volatile struct {TFrame* prev;' + + 'NCSTRING procname;NI line;NCSTRING filename;' + + 'NI len;$n$1} F;$n', [slots]); + prepend(p.s[cpsInit], ropef('F.len = $1;$n', [toRope(p.frameLen)])) end; function retIsNotVoid(s: PSym): bool; @@ -418,27 +430,27 @@ begin result := (s.typ.sons[0] <> nil) and not isInvalidReturnType(s.typ.sons[0]) end; -procedure genProc(prc: PSym); +procedure genProc(m: BModule; prc: PSym); var p: BProc; generatedProc, header, returnStmt: PRope; i: int; res, param: PSym; begin - useHeader(prc); - fillLoc(prc.loc, locProc, prc.typ, mangleName(prc), {@set}[lfOnData]); + useHeader(m, prc); + fillLoc(prc.loc, locProc, prc.typ, mangleName(prc), OnStack); if (lfNoDecl in prc.loc.Flags) then exit; if lfDynamicLib in prc.loc.flags then - SymInDynamicLib(prc) + SymInDynamicLib(m, prc) else if not (sfImportc in prc.flags) then begin // we have a real proc here: - p := newProc(prc); - header := genProcHeader(prc); + p := newProc(prc, m); + header := genProcHeader(m, prc); if (sfCompilerProc in prc.flags) - and (sfSystemModule in currMod.module.flags) - and not IntSetContains(currMod.declaredThings, prc.id) then - appRopeFormat(currMod.s[cfsProcHeaders], '$1;$n', [header]); - intSetIncl(currMod.declaredThings, prc.id); + and (sfSystemModule in m.module.flags) + and not IntSetContains(m.declaredThings, prc.id) then + appf(m.s[cfsProcHeaders], '$1;$n', [header]); + intSetIncl(m.declaredThings, prc.id); returnStmt := nil; assert(prc.ast <> nil); @@ -450,7 +462,7 @@ begin assert(res.loc.r <> nil); initVariable(p, res); genObjectInit(p, res); - returnStmt := ropeFormat('return $1;$n', [rdLoc(res.loc)]); + returnStmt := ropef('return $1;$n', [rdLoc(res.loc)]); end else if (prc.typ.sons[0] <> nil) then begin res := prc.ast.sons[resultPos].sym; // get result symbol @@ -465,13 +477,13 @@ begin genStmts(p, prc.ast.sons[codePos]); // modifies p.locals, p.init, etc. if sfPure in prc.flags then - generatedProc := ropeFormat('$1 {$n$2$3$4}$n', + generatedProc := ropef('$1 {$n$2$3$4}$n', [header, p.s[cpsLocals], p.s[cpsInit], p.s[cpsStmts]]) else begin generatedProc := con(header, '{' + tnl); if optStackTrace in prc.options then begin getFrameDecl(p); - prepend(p.s[cpsInit], ropeFormat( + prepend(p.s[cpsInit], ropef( 'F.procname = $1;$n' + 'F.prev = framePtr;$n' + 'F.filename = $2;$n' + @@ -491,86 +503,93 @@ begin //if prc.typ.callConv <> ccInline then // prc.ast.sons[codePos] := nil; end; - app(currMod.s[cfsProcs], generatedProc); + app(m.s[cfsProcs], generatedProc); end end; -procedure genVarPrototype(sym: PSym); +procedure genVarPrototype(m: BModule; sym: PSym); begin assert(sfGlobal in sym.flags); - useHeader(sym); - fillLoc(sym.loc, locGlobalVar, sym.typ, mangleName(sym), {@set}[lfOnData]); + useHeader(m, sym); + fillLoc(sym.loc, locGlobalVar, sym.typ, mangleName(sym), OnHeap); if (lfNoDecl in sym.loc.Flags) or - intSetContainsOrIncl(currMod.declaredThings, sym.id) then + intSetContainsOrIncl(m.declaredThings, sym.id) then exit; - if sym.owner.id <> currMod.module.id then begin + if sym.owner.id <> m.module.id then begin // else we already have the symbol generated! assert(sym.loc.r <> nil); - app(currMod.s[cfsVars], 'extern '); - app(currMod.s[cfsVars], getTypeDesc(sym.loc.t)); + app(m.s[cfsVars], 'extern '); + app(m.s[cfsVars], getTypeDesc(m, sym.loc.t)); if sfRegister in sym.flags then - app(currMod.s[cfsVars], ' register'); + app(m.s[cfsVars], ' register'); if sfVolatile in sym.flags then - app(currMod.s[cfsVars], ' volatile'); - appRopeFormat(currMod.s[cfsVars], ' $1; /* $2 */$n', - [sym.loc.r, toRope(sym.name.s)]) + app(m.s[cfsVars], ' volatile'); + appf(m.s[cfsVars], ' $1;$n', [sym.loc.r]) end end; -procedure genConstPrototype(sym: PSym); +procedure genConstPrototype(m: BModule; sym: PSym); begin - useHeader(sym); - fillLoc(sym.loc, locData, sym.typ, mangleName(sym), {@set}[lfOnData]); + useHeader(m, sym); + fillLoc(sym.loc, locData, sym.typ, mangleName(sym), OnUnknown); if (lfNoDecl in sym.loc.Flags) or - intSetContainsOrIncl(currMod.declaredThings, sym.id) then + intSetContainsOrIncl(m.declaredThings, sym.id) then exit; - if sym.owner.id <> currMod.module.id then begin + if sym.owner.id <> m.module.id then begin // else we already have the symbol generated! assert(sym.loc.r <> nil); - app(currMod.s[cfsData], 'extern '); - appRopeFormat(currMod.s[cfsData], '$1$2 $3; /* $4 */$n', - [constTok, getTypeDesc(sym.loc.t), sym.loc.r, toRope(sym.name.s)]) + app(m.s[cfsData], 'extern '); + appf(m.s[cfsData], 'NIM_CONST $1 $2;$n', + [getTypeDesc(m, sym.loc.t), sym.loc.r]) end end; -procedure genProcPrototype(sym: PSym); +procedure genProcPrototype(m: BModule; sym: PSym); begin - useHeader(sym); - fillLoc(sym.loc, locProc, sym.typ, mangleName(sym), {@set}[lfOnData]); + useHeader(m, sym); + fillLoc(sym.loc, locProc, sym.typ, mangleName(sym), OnStack); if lfDynamicLib in sym.loc.Flags then begin // it is a proc variable! - if (sym.owner.id <> currMod.module.id) and - not intSetContainsOrIncl(currMod.declaredThings, sym.id) then begin - app(currMod.s[cfsVars], 'extern '); + if (sym.owner.id <> m.module.id) and + not intSetContainsOrIncl(m.declaredThings, sym.id) then begin + app(m.s[cfsVars], 'extern '); // BUGFIX: declareGlobalVar() inlined, because of intSetContainsOrIncl // check - app(currMod.s[cfsVars], getTypeDesc(sym.loc.t)); - appRopeFormat(currMod.s[cfsVars], ' $1; /* $2 */$n', - [sym.loc.r, toRope(sym.name.s)]) + app(m.s[cfsVars], getTypeDesc(m, sym.loc.t)); + appf(m.s[cfsVars], ' $1;$n', [sym.loc.r]) end end else begin // it is a proc: if (lfNoDecl in sym.loc.Flags) then exit; - if intSetContainsOrIncl(currMod.declaredThings, sym.id) then exit; - appRopeFormat(currMod.s[cfsProcHeaders], '$1;$n', [genProcHeader(sym)]); + if intSetContainsOrIncl(m.declaredThings, sym.id) then exit; + appf(m.s[cfsProcHeaders], '$1;$n', [genProcHeader(m, sym)]); if (sym.typ.callConv = ccInline) - and (sym.owner.id <> currMod.module.id) then - genProc(sym) // generate the code again! -// else -// IntSetIncl(currMod.declaredThings, sym.id) + and (sym.owner.id <> m.module.id) then + genProc(m, sym) // generate the code again! end end; -function getFileHeader: PRope; +function getFileHeader(const cfilenoext: string): PRope; begin - result := ropeFormat( + result := ropef( '/* Generated by the Nimrod Compiler v$1 */$n' + '/* (c) 2008 Andreas Rumpf */$n' + - '/* Compiled for: $2, $3, $4 */$n', + '/* Compiled for: $2, $3, $4 */$n' + + '/* Command for C compiler:$n $5 */$n', [toRope(versionAsString), toRope(platform.OS[targetOS].name), toRope(platform.CPU[targetCPU].name), - toRope(extccomp.CC[extccomp.ccompiler].name)]) + toRope(extccomp.CC[extccomp.ccompiler].name), + toRope(getCompileCFileCmd(cfilenoext))]); + case platform.CPU[targetCPU].intSize of + 16: appf(result, '$ntypedef short int NI;$n' + + 'typedef unsigned short int NU;$n', []); + 32: appf(result, '$ntypedef long int NI;$n' + + 'typedef unsigned long int NU;$n', []); + 64: appf(result, '$ntypedef long long int NI;$n' + + 'typedef unsigned long long int NU;$n', []); + else begin end + end end; procedure genMainProc(m: BModule); @@ -581,13 +600,13 @@ const '$1' + '$2'; PosixMain = - 'NS cmdCount;$n' + + 'NI cmdCount;$n' + 'char** cmdLine;$n' + 'char** gEnv;$n' + 'int main(int argc, char** args, char** env) {$n' + ' int dummy[8];$n' + ' cmdLine = args;$n' + - ' cmdCount = (NS)argc;$n' + + ' cmdCount = (NI)argc;$n' + ' gEnv = env;$n' +{&} CommonMainBody +{&} ' return 0;$n' + @@ -610,7 +629,7 @@ const var frmt: TFormatStr; begin - useMagic('setStackBottom'); + useMagic(m, 'setStackBottom'); if (platform.targetOS = osWindows) and (gGlobalOptions * [optGenGuiApp, optGenDynLib] <> []) then begin if optGenGuiApp in gGlobalOptions then @@ -622,8 +641,8 @@ begin else frmt := PosixMain; if gBreakpoints <> nil then - useMagic('dbgRegisterBreakpoint'); - appRopeFormat(m.s[cfsProcs], frmt, [gBreakpoints, mainModInit]) + useMagic(m, 'dbgRegisterBreakpoint'); + appf(m.s[cfsProcs], frmt, [gBreakpoints, mainModInit]) end; procedure genInitCode(m: BModule); @@ -631,16 +650,16 @@ var initname, prc: PRope; begin initname := con(m.module.name.s, toRope('Init')); - appRopeFormat(mainModProcs, 'N_NIMCALL(void, $1)(void);$n', + appf(mainModProcs, 'N_NIMCALL(void, $1)(void);$n', [initname]); if not (sfSystemModule in m.module.flags) then - appRopeFormat(mainModInit, '$1();$n', [initname]); - prc := ropeFormat('N_NIMCALL(void, $1)(void) {$n', [initname]); + appf(mainModInit, '$1();$n', [initname]); + prc := ropef('N_NIMCALL(void, $1)(void) {$n', [initname]); if optStackTrace in m.initProc.options then begin prepend(m.initProc.s[cpsLocals], toRope('volatile TFrame F;' + tnl)); app(prc, m.initProc.s[cpsLocals]); app(prc, m.s[cfsTypeInit1]); - appRopeFormat(prc, + appf(prc, 'F.len = 0;$n' + // IMPORTANT: else the debugger crashes! 'F.procname = $1;$n' + 'F.prev = framePtr;$n' + @@ -666,12 +685,12 @@ begin app(m.s[cfsProcs], prc) end; -function genModule(m: BModule): PRope; +function genModule(m: BModule; const cfilenoext: string): PRope; var i: TCFileSection; begin - result := getFileHeader(); - generateHeaders(); + result := getFileHeader(cfilenoext); + generateHeaders(m); for i := low(TCFileSection) to cfsProcs do app(result, m.s[i]) end; @@ -688,11 +707,10 @@ begin initIdTable(result.typeCache); initIdTable(result.forwTypeCache); result.module := module; - if gCmd <> cmdCompileToCpp then - constTok := toRope('const '); intSetInit(result.typeInfoMarker); - result.initProc := newProc(nil); + result.initProc := newProc(nil, result); result.initProc.options := gOptions; +{@emit result.typeStack := [];} end; function shouldRecompile(code: PRope; const cfile, cfilenoext: string): bool; @@ -717,28 +735,27 @@ var code: PRope; begin m := BModule(b); - currMod := m; - currMod.initProc.options := gOptions; - genStmts(currMod.initProc, n); + m.initProc.options := gOptions; + genStmts(m.initProc, n); // generate code for the init statements of the module: genInitCode(m); + finishTypeDescriptions(m); if sfMainModule in m.module.flags then begin // generate mapping file (if requested): if gMapping <> nil then WriteRope(gMapping, ChangeFileExt(cfile + '_map', 'txt')); // generate main file: - app(currMod.s[cfsProcHeaders], mainModProcs); - genMainProc(currMod); + app(m.s[cfsProcHeaders], mainModProcs); + genMainProc(m); end; cfile := completeCFilePath(m.cfilename); cfilenoext := changeFileExt(cfile, ''); - code := genModule(m); + code := genModule(m, cfilenoext); if shouldRecompile(code, changeFileExt(cfile, cExt), cfilenoext) then begin addFileToCompile(cfilenoext); // is to compile end; addFileToLink(cfilenoext); - currMod := nil // free the memory end; function CBackend(b: PBackend; module: PSym; const filename: string): PBackend; @@ -749,7 +766,6 @@ begin g.backendCreator := CBackend; g.eventMask := {@set}[eAfterModule]; g.afterModuleEvent := finishModule; - currMod := g; result := g; end; diff --git a/nim/commands.pas b/nim/commands.pas index 69edd86e9..ad6f21b07 100644 --- a/nim/commands.pas +++ b/nim/commands.pas @@ -7,10 +7,10 @@ // distribution, for details about the copyright. // -// This module handles the parsing of command line arguments. - unit commands; +// This module handles the parsing of command line arguments. + interface {$include 'config.inc'} @@ -41,16 +41,14 @@ uses const {$ifdef fpc} compileDate = {$I %date%}; - compileTime = {$I %time%}; {$else} compileDate = '2008-0-0'; - compileTime = '00:00:00'; {$endif} {@emit} const HelpMessage = 'Nimrod Compiler Version $1 (' +{&} - compileDate +{&} ' ' +{&} compileTime +{&} ') [$2: $3]' +{&} nl +{&} + compileDate +{&} ') [$2: $3]' +{&} nl +{&} 'Copyright (c) 2004-2008 by Andreas Rumpf' +{&} nl; const @@ -66,7 +64,8 @@ const +{&} ' compile compile project with default code generator (C)' +{&} nl +{&} ' compile_to_c compile project with C code generator' +{&} nl +{&} ' compile_to_cpp compile project with C++ code generator' +{&} nl -+{&} ' doc generate the documentation for inputfile; ' +{&} nl ++{&} ' compile_to_ecmascript compile project to ECMAScript code (experimental)' +{&} nl ++{&} ' doc generate the documentation for inputfile;' +{&} nl +{&} ' with --run switch opens it with $BROWSER' +{&} nl +{&} 'Arguments:' +{&} nl +{&} ' arguments are passed to the program being run (if --run option is selected)' +{&} nl @@ -80,6 +79,8 @@ const +{&} ' --line_trace:on|off code generation for line trace ON|OFF' +{&} nl +{&} ' --debugger:on|off turn Embedded Nimrod Debugger ON|OFF' +{&} nl +{&} ' -x, --checks:on|off code generation for all runtime checks ON|OFF' +{&} nl ++{&} ' --obj_checks:on|off code generation for obj conversion checks ON|OFF' +{&} nl ++{&} ' --field_checks:on|off code generation for case record fields ON|OFF' +{&} nl +{&} ' --range_checks:on|off code generation for range checks ON|OFF' +{&} nl +{&} ' --bound_checks:on|off code generation for bound checks ON|OFF' +{&} nl +{&} ' --overflow_checks:on|off code generation for over-/underflow checks ON|OFF' +{&} nl @@ -174,17 +175,8 @@ const ; function getCommandLineDesc: string; -var - v: string; begin - // the Pascal version number gets a little star ('*'), the Nimrod version - // does not! This helps distinguishing the different builds. -{@ignore} - v := VersionAsString +{&} '*'; -{@emit - v := VersionAsString -} - result := format(HelpMessage, [v, platform.os[hostOS].name, + result := format(HelpMessage, [VersionAsString, platform.os[hostOS].name, cpu[hostCPU].name]) +{&} Usage end; @@ -210,6 +202,7 @@ begin cpu[hostCPU].name]) +{&} AdvancedUsage); advHelpWritten := true; helpWritten := true; + halt(0); end end; @@ -423,7 +416,7 @@ begin ProcessOnOffSwitch({@set}[optHints], arg, pass, info); wCheckpoints: ProcessOnOffSwitch({@set}[optCheckpoints], arg, pass, info); - wStackTrace, wS: + wStackTrace: ProcessOnOffSwitch({@set}[optStackTrace], arg, pass, info); wLineTrace: ProcessOnOffSwitch({@set}[optLineTrace], arg, pass, info); @@ -436,6 +429,10 @@ begin end; wChecks, wX: ProcessOnOffSwitch(checksOptions, arg, pass, info); + wObjChecks: + ProcessOnOffSwitch({@set}[optObjCheck], arg, pass, info); + wFieldChecks: + ProcessOnOffSwitch({@set}[optFieldCheck], arg, pass, info); wRangeChecks: ProcessOnOffSwitch({@set}[optRangeCheck], arg, pass, info); wBoundChecks: @@ -485,6 +482,10 @@ begin liMessage(info, errGuiConsoleOrLibExpectedButXFound, arg) end end; + wListDef: begin + if pass in {@set}[passCmd2, passPP] then + condsyms.listSymbols(); + end; wPassC, wT: begin expectArg(switch, arg, pass, info); if pass in {@set}[passCmd2, passPP] then diff --git a/nim/crc.pas b/nim/crc.pas index d669c17ee..d4c5d0661 100644 --- a/nim/crc.pas +++ b/nim/crc.pas @@ -19,7 +19,7 @@ type TCrc32 = int32; const - InitCrc32 = TCrc32($ffffffff); + InitCrc32 = TCrc32(-1); function updateCrc32(val: Byte; crc: TCrc32): TCrc32; overload; function updateCrc32(val: Char; crc: TCrc32): TCrc32; overload; diff --git a/nim/docgen.pas b/nim/docgen.pas index 9615dad35..a6d2725c3 100644 --- a/nim/docgen.pas +++ b/nim/docgen.pas @@ -40,6 +40,7 @@ type modDesc: PRope; // module description dependsOn: PRope; // dependencies id: int; // for generating IDs + splitAfter: int; // split to long entries in the TOC tocPart: array of TTocEntry; hasToc: bool; toc, section: TSections; @@ -54,7 +55,7 @@ function findIndexNode(n: PRstNode): PRstNode; var i: int; begin - if n = nil then + if n = nil then result := nil else if n.kind = rnIndex then begin result := n.sons[2]; @@ -62,7 +63,7 @@ begin result := newRstNode(rnDefList); n.sons[2] := result end - else if result.kind = rnInner then + else if result.kind = rnInner then result := result.sons[0] end else begin @@ -83,10 +84,10 @@ begin gIndexFile := appendFileExt(gIndexFile, 'txt'); d.indexValFilename := changeFileExt(extractFilename(d.filename), HtmlExt); if ExistsFile(gIndexFile) then begin - d.indexFile := rstParse(readFile(gIndexFile), false, gIndexFile, 0, 1, + d.indexFile := rstParse(readFile(gIndexFile), false, gIndexFile, 0, 1, dummyHasToc); d.theIndex := findIndexNode(d.indexFile); - if (d.theIndex = nil) or (d.theIndex.kind <> rnDefList) then + if (d.theIndex = nil) or (d.theIndex.kind <> rnDefList) then rawMessage(errXisNoValidIndexFile, gIndexFile); clearIndex(d.theIndex, d.indexValFilename); end @@ -106,6 +107,8 @@ begin end; function newDocumentor(const filename: string): PDoc; +var + s: string; begin new(result); {@ignore} @@ -115,6 +118,10 @@ begin } result.filename := filename; result.id := 100; + result.splitAfter := 25; + s := getConfigVar('split.item.toc'); + if s <> '' then + result.splitAfter := parseInt(s); end; function getVarIdx(const varnames: array of string; const id: string): int; @@ -122,7 +129,7 @@ var i: int; begin for i := 0 to high(varnames) do - if cmpIgnoreStyle(varnames[i], id) = 0 then begin + if cmpIgnoreStyle(varnames[i], id) = 0 then begin result := i; exit end; result := -1 @@ -209,12 +216,16 @@ begin end end; -function toXml(const s: string): string; +function toXml(const s: string; splitAfter: int = -1): string; var i: int; begin result := ''; - for i := strStart to length(s)+strStart-1 do addXmlChar(result, s[i]) + for i := strStart to length(s)+strStart-1 do begin + if (splitAfter >= 0) and ((i-strStart+1) mod splitAfter = 0) then + addChar(result, ' '); + addXmlChar(result, s[i]) + end end; function renderRstToHtml(d: PDoc; n: PRstNode): PRope; forward; @@ -226,8 +237,8 @@ var begin result := nil; for i := 0 to rsonsLen(n)-1 do - appRopeFormat(result, inner, [renderRstToHtml(d, n.sons[i])]); - result := ropeFormat(outer, [result]); + appf(result, inner, [renderRstToHtml(d, n.sons[i])]); + result := ropef(outer, [result]); end; procedure setIndexForSourceTerm(d: PDoc; name: PRstNode; id: int); @@ -241,7 +252,7 @@ begin addSon(h, a); a := newRstNode(rnIdx); addSon(a, name); - setIndexPair(d.theIndex, a, h); + setIndexPair(d.theIndex, a, h); end; function renderIndexTerm(d: PDoc; n: PRstNode): PRope; @@ -249,7 +260,7 @@ var a, h: PRstNode; begin inc(d.id); - result := ropeFormat('<em id="$1">$2</em>', + result := ropef('<em id="$1">$2</em>', [toRope(d.id), renderAux(d, n)]); h := newRstNode(rnHyperlink); a := newRstNode(rnLeaf, d.indexValFilename +{&} '#' +{&} toString(d.id)); @@ -277,11 +288,13 @@ var begin if n = nil then begin result := nil; exit end; result := genComment(d, n); - if result = nil then - for i := 0 to sonsLen(n)-1 do begin - result := genRecComment(d, n.sons[i]); - if result <> nil then exit - end + if result = nil then begin + if not (n.kind in [nkEmpty..nkNilLit]) then + for i := 0 to sonsLen(n)-1 do begin + result := genRecComment(d, n.sons[i]); + if result <> nil then exit + end + end else n.comment := snil end; @@ -299,18 +312,18 @@ begin end else if n.kind = nkSym then result := sfInInterface in n.sym.flags - else if n.kind = nkPragmaExpr then + else if n.kind = nkPragmaExpr then result := isVisible(n.sons[0]); end; -function getName(n: PNode): string; +function getName(n: PNode; splitAfter: int = -1): string; begin case n.kind of - nkPostfix: result := getName(n.sons[1]); - nkPragmaExpr: result := getName(n.sons[0]); - nkSym: result := toXML(n.sym.name.s); - nkIdent: result := toXML(n.ident.s); - nkAccQuoted: result := '`' +{&} getName(n.sons[0]) +{&} '`'; + nkPostfix: result := getName(n.sons[1], splitAfter); + nkPragmaExpr: result := getName(n.sons[0], splitAfter); + nkSym: result := toXML(n.sym.name.s, splitAfter); + nkIdent: result := toXML(n.ident.s, splitAfter); + nkAccQuoted: result := '`' +{&} getName(n.sons[0], splitAfter) +{&} '`'; else begin internalError(n.info, 'getName()'); result := '' @@ -354,50 +367,50 @@ begin getNextTok(r, kind, literal); case kind of tkEof: break; - tkComment: - appRopeFormat(result, '<span class="Comment">$1</span>', + tkComment: + appf(result, '<span class="Comment">$1</span>', [toRope(toXml(literal))]); - tokKeywordLow..tokKeywordHigh: - appRopeFormat(result, '<span class="Keyword">$1</span>', + tokKeywordLow..tokKeywordHigh: + appf(result, '<span class="Keyword">$1</span>', [toRope(literal)]); - tkOpr, tkHat: - appRopeFormat(result, '<span class="Operator">$1</span>', + tkOpr, tkHat: + appf(result, '<span class="Operator">$1</span>', [toRope(toXml(literal))]); - tkStrLit..tkTripleStrLit: - appRopeFormat(result, '<span class="StringLit">$1</span>', + tkStrLit..tkTripleStrLit: + appf(result, '<span class="StringLit">$1</span>', [toRope(toXml(literal))]); - tkCharLit, tkRCharLit: - appRopeFormat(result, '<span class="CharLit">$1</span>', + tkCharLit: + appf(result, '<span class="CharLit">$1</span>', [toRope(toXml(literal))]); tkIntLit..tkInt64Lit: - appRopeFormat(result, '<span class="DecNumber">$1</span>', + appf(result, '<span class="DecNumber">$1</span>', [toRope(literal)]); - tkFloatLit..tkFloat64Lit: - appRopeFormat(result, '<span class="FloatNumber">$1</span>', + tkFloatLit..tkFloat64Lit: + appf(result, '<span class="FloatNumber">$1</span>', [toRope(literal)]); tkSymbol: - appRopeFormat(result, '<span class="Identifier">$1</span>', + appf(result, '<span class="Identifier">$1</span>', [toRope(literal)]); - tkInd, tkSad, tkDed, tkSpaces: + tkInd, tkSad, tkDed, tkSpaces: app(result, literal); - //appRopeFormat(result, '<span class="Whitespace">$1</span>', + //appf(result, '<span class="Whitespace">$1</span>', // [toRope(literal)]); tkParLe, tkParRi, tkBracketLe, tkBracketRi, tkCurlyLe, tkCurlyRi, - tkBracketDotLe, tkBracketDotRi, tkCurlyDotLe, tkCurlyDotRi, + tkBracketDotLe, tkBracketDotRi, tkCurlyDotLe, tkCurlyDotRi, tkParDotLe, tkParDotRi, tkComma, tkSemiColon, tkColon, tkEquals, tkDot, tkDotDot, tkAccent: - appRopeFormat(result, '<span class="Other">$1</span>', + appf(result, '<span class="Other">$1</span>', [toRope(literal)]); else InternalError(n.info, 'docgen.genThing(' + toktypeToStr[kind] + ')'); end end; inc(d.id); app(d.section[k], ropeFormatNamedVars(getConfigVar('doc.item'), - ['name', 'header', 'desc', 'itemID'], - [name, result, comm, toRope(d.id)])); + ['name', 'header', 'desc', 'itemID'], + [name, result, comm, toRope(d.id)])); app(d.toc[k], ropeFormatNamedVars(getConfigVar('doc.item.toc'), - ['name', 'header', 'desc', 'itemID'], - [name, result, comm, toRope(d.id)])); + ['name', 'header', 'desc', 'itemID'], + [toRope(getName(nameNode, d.splitAfter)), result, comm, toRope(d.id)])); setIndexForSourceTerm(d, getRstName(nameNode), d.id); end; @@ -416,12 +429,12 @@ begin d.tocPart[len].refname := refname; d.tocPart[len].n := n; d.tocPart[len].header := result; - result := ropeFormat('<h$1><a class="toc-backref" id="$2" href="#$2_toc">$3'+ + result := ropef('<h$1><a class="toc-backref" id="$2" href="#$2_toc">$3'+ '</a></h$1>', [toRope(n.level), d.tocPart[len].refname, result]); end - else - result := ropeFormat('<h$1 id="$2">$3</h$1>', + else + result := ropef('<h$1 id="$2">$3</h$1>', [toRope(n.level), refname, result]); end; @@ -437,8 +450,8 @@ begin if d.meta[metaTitle] = nil then d.meta[metaTitle] := t else if d.meta[metaSubtitle] = nil then d.meta[metaSubtitle] := t else - result := ropeFormat('<h$1 id="$2"><center>$3</center></h$1>', - [toRope(n.level), toRope(rstnodeToRefname(n)), t]); + result := ropef('<h$1 id="$2"><center>$3</center></h$1>', + [toRope(n.level), toRope(rstnodeToRefname(n)), t]); end; function renderRstToRst(d: PDoc; n: PRstNode): PRope; forward; @@ -455,7 +468,7 @@ function renderRstToRst(d: PDoc; n: PRstNode): PRope; // this is needed for the index generation; it may also be useful for // debugging, but most code is already debugged... const - lvlToChar: array [0..8] of char = ('!', '=', '-', '~', '`', + lvlToChar: array [0..8] of char = ('!', '=', '-', '~', '`', '<', '*', '|', '+'); var L: int; @@ -469,60 +482,60 @@ begin rnHeadline: begin result := renderRstSons(d, n); L := ropeLen(result); - result := ropeFormat('$n$1$2$n$1$3', [ind, result, + result := ropef('$n$1$2$n$1$3', [ind, result, toRope(repeatChar(L, lvlToChar[n.level]))]); end; rnOverline: begin result := renderRstSons(d, n); L := ropeLen(result); - result := ropeFormat('$n$1$3$n$1$2$n$1$3', [ind, result, + result := ropef('$n$1$3$n$1$2$n$1$3', [ind, result, toRope(repeatChar(L, lvlToChar[n.level]))]); end; - rnTransition: - result := ropeFormat('$n$n$1$2$n$n', + rnTransition: + result := ropef('$n$n$1$2$n$n', [ind, toRope(repeatChar(78-d.indent, '-'))]); rnParagraph: begin result := renderRstSons(d, n); - result := ropeFormat('$n$n$1$2', [ind, result]); + result := ropef('$n$n$1$2', [ind, result]); end; rnBulletItem: begin inc(d.indent, 2); result := renderRstSons(d, n); - if result <> nil then result := ropeFormat('$n$1* $2', [ind, result]); + if result <> nil then result := ropef('$n$1* $2', [ind, result]); dec(d.indent, 2); end; rnEnumItem: begin inc(d.indent, 4); result := renderRstSons(d, n); - if result <> nil then result := ropeFormat('$n$1(#) $2', [ind, result]); + if result <> nil then result := ropef('$n$1(#) $2', [ind, result]); dec(d.indent, 4); end; rnOptionList, rnFieldList, rnDefList, rnDefItem, rnLineBlock, rnFieldName, - rnFieldBody, rnStandaloneHyperlink, rnBulletList, rnEnumList: + rnFieldBody, rnStandaloneHyperlink, rnBulletList, rnEnumList: result := renderRstSons(d, n); rnDefName: begin result := renderRstSons(d, n); - result := ropeFormat('$n$n$1$2', [ind, result]); + result := ropef('$n$n$1$2', [ind, result]); end; rnDefBody: begin inc(d.indent, 2); result := renderRstSons(d, n); if n.sons[0].kind <> rnBulletList then - result := ropeFormat('$n$1 $2', [ind, result]); + result := ropef('$n$1 $2', [ind, result]); dec(d.indent, 2); end; rnField: begin result := renderRstToRst(d, n.sons[0]); L := max(ropeLen(result)+3, 30); inc(d.indent, L); - result := ropeFormat('$n$1:$2:$3$4', [ + result := ropef('$n$1:$2:$3$4', [ ind, result, toRope(repeatChar(L-ropeLen(result)-2)), renderRstToRst(d, n.sons[1])]); dec(d.indent, L); end; rnLineBlockItem: begin result := renderRstSons(d, n); - result := ropeFormat('$n$1| $2', [ind, result]); + result := ropef('$n$1| $2', [ind, result]); end; rnBlockQuote: begin inc(d.indent, 2); @@ -531,48 +544,48 @@ begin end; rnRef: begin result := renderRstSons(d, n); - result := ropeFormat('`$1`_', [result]); + result := ropef('`$1`_', [result]); end; rnHyperlink: begin - result := ropeFormat('`$1 <$2>`_', [renderRstToRst(d, n.sons[0]), + result := ropef('`$1 <$2>`_', [renderRstToRst(d, n.sons[0]), renderRstToRst(d, n.sons[1])]); end; rnGeneralRole: begin result := renderRstToRst(d, n.sons[0]); - result := ropeFormat('`$1`:$2:', [result, renderRstToRst(d, n.sons[1])]); + result := ropef('`$1`:$2:', [result, renderRstToRst(d, n.sons[1])]); end; rnSub: begin result := renderRstSons(d, n); - result := ropeFormat('`$1`:sub:', [result]); + result := ropef('`$1`:sub:', [result]); end; rnSup: begin result := renderRstSons(d, n); - result := ropeFormat('`$1`:sup:', [result]); + result := ropef('`$1`:sup:', [result]); end; rnIdx: begin result := renderRstSons(d, n); - result := ropeFormat('`$1`:idx:', [result]); + result := ropef('`$1`:idx:', [result]); end; rnEmphasis: begin result := renderRstSons(d, n); - result := ropeFormat('*$1*', [result]); + result := ropef('*$1*', [result]); end; rnStrongEmphasis: begin result := renderRstSons(d, n); - result := ropeFormat('**$1**', [result]); + result := ropef('**$1**', [result]); end; rnInterpretedText: begin result := renderRstSons(d, n); - result := ropeFormat('`$1`', [result]); + result := ropef('`$1`', [result]); end; rnInlineLiteral: begin inc(d.verbatim); result := renderRstSons(d, n); - result := ropeFormat('``$1``', [result]); + result := ropef('``$1``', [result]); dec(d.verbatim); end; rnLeaf: begin - if (d.verbatim = 0) and (n.text = '\'+'') then + if (d.verbatim = 0) and (n.text = '\'+'') then result := toRope('\\') // XXX: escape more special characters! else result := toRope(n.text); @@ -582,10 +595,10 @@ begin if n.sons[2] <> nil then result := renderRstSons(d, n.sons[2]); dec(d.indent, 3); - result := ropeFormat('$n$n$1.. index::$n$2', [ind, result]); + result := ropef('$n$n$1.. index::$n$2', [ind, result]); end; rnContents: begin - result := ropeFormat('$n$n$1.. contents::', [ind]); + result := ropef('$n$n$1.. contents::', [ind]); end; else rawMessage(errCannotRenderX, rstnodeKindToStr[n.kind]); end; @@ -593,7 +606,7 @@ end; function renderTocEntry(d: PDoc; const e: TTocEntry): PRope; begin - result := ropeFormat('<li><a class="reference" id="$1_toc" href="#$1">$2' + + result := ropef('<li><a class="reference" id="$1_toc" href="#$1">$2' + '</a></li>$n', [e.refname, e.header]); end; @@ -614,24 +627,24 @@ begin break end; if lvl > 1 then - result := ropeFormat('<ul class="simple">$1</ul>', [result]); + result := ropef('<ul class="simple">$1</ul>', [result]); end; function renderImage(d: PDoc; n: PRstNode): PRope; var s: string; begin - result := ropeFormat('<img src="$1"', [toRope(getArgument(n))]); + result := ropef('<img src="$1"', [toRope(getArgument(n))]); s := getFieldValue(n, 'height'); - if s <> '' then appRopeFormat(result, ' height="$1"', [toRope(s)]); + if s <> '' then appf(result, ' height="$1"', [toRope(s)]); s := getFieldValue(n, 'width'); - if s <> '' then appRopeFormat(result, ' width="$1"', [toRope(s)]); + if s <> '' then appf(result, ' width="$1"', [toRope(s)]); s := getFieldValue(n, 'scale'); - if s <> '' then appRopeFormat(result, ' scale="$1"', [toRope(s)]); + if s <> '' then appf(result, ' scale="$1"', [toRope(s)]); s := getFieldValue(n, 'alt'); - if s <> '' then appRopeFormat(result, ' alt="$1"', [toRope(s)]); + if s <> '' then appf(result, ' alt="$1"', [toRope(s)]); s := getFieldValue(n, 'align'); - if s <> '' then appRopeFormat(result, ' align="$1"', [toRope(s)]); + if s <> '' then appf(result, ' align="$1"', [toRope(s)]); app(result, ' />'); if rsonsLen(n) >= 3 then app(result, renderRstToHtml(d, n.sons[2])) end; @@ -644,14 +657,14 @@ var lang: TSourceLanguage; begin m := n.sons[2].sons[0]; - assert(m.kind = rnLeaf); + if (m.kind <> rnLeaf) then InternalError('renderCodeBlock'); result := nil; langstr := strip(getArgument(n)); if langstr = '' then lang := langNimrod // default language else lang := getSourceLanguage(langstr); if lang = langNone then begin rawMessage(warnLanguageXNotSupported, langstr); - result := ropeFormat('<pre>$1</pre>', [toRope(m.text)]) + result := ropef('<pre>$1</pre>', [toRope(m.text)]) end else begin initGeneralTokenizer(g, m.text); @@ -659,16 +672,18 @@ begin getNextToken(g, lang); case g.kind of gtEof: break; - gtNone, gtWhitespace: - app(result, ncopy(m.text, g.start+strStart, g.len+g.start)); - else - appRopeFormat(result, '<span class="$2">$1</span>', - [toRope(ncopy(m.text, g.start+strStart, g.len+g.start)), + gtNone, gtWhitespace: + app(result, ncopy(m.text, g.start+strStart, + g.len+g.start-1+strStart)); + else + appf(result, '<span class="$2">$1</span>', + [toRope(ncopy(m.text, g.start+strStart, + g.len+g.start-1+strStart)), toRope(tokenClassToStr[g.kind])]); end; end; deinitGeneralTokenizer(g); - if result <> nil then result := ropeFormat('<pre>$1</pre>', [result]); + if result <> nil then result := ropef('<pre>$1</pre>', [result]); end end; @@ -697,10 +712,10 @@ begin rnDefItem: begin end; rnDefName: outer := '<dt>$1</dt>'+nl; rnDefBody: outer := '<dd>$1</dd>'+nl; - rnFieldList: + rnFieldList: outer := '<table class="docinfo" frame="void" rules="none">' + '<col class="docinfo-name" />' + - '<col class="docinfo-content" />' + + '<col class="docinfo-content" />' + '<tbody valign="top">$1' + '</tbody></table>'; rnField: outer := '<tr>$1</tr>$n'; @@ -711,7 +726,7 @@ begin exit end; - rnOptionList: + rnOptionList: outer := '<table frame="void">$1</table>'; rnOptionListItem: outer := '<tr>$1</tr>$n'; @@ -719,36 +734,36 @@ begin rnDescription: outer := '<td align="left">$1</td>$n'; rnOption, rnOptionString, - rnOptionArgument: assert(false); + rnOptionArgument: InternalError('renderRstToHtml'); rnLiteralBlock: outer := '<pre>$1</pre>'+nl; - rnQuotedLiteralBlock: assert(false); + rnQuotedLiteralBlock: InternalError('renderRstToHtml'); rnLineBlock: outer := '<p>$1</p>'; rnLineBlockItem: outer := '$1<br />'; rnBlockQuote: outer := '<blockquote>$1</blockquote>$n'; - rnTable, rnGridTable: + rnTable, rnGridTable: outer := '<table border="1" class="docutils">$1</table>'; rnTableRow: outer := '<tr>$1</tr>$n'; rnTableDataCell: outer := '<td>$1</td>'; rnTableHeaderCell: outer := '<th>$1</th>'; - rnLabel: assert(false); // used for footnotes and other things - rnFootnote: assert(false); // a footnote + rnLabel: InternalError('renderRstToHtml'); // used for footnotes and other + rnFootnote: InternalError('renderRstToHtml'); // a footnote - rnCitation: assert(false); // similar to footnote + rnCitation: InternalError('renderRstToHtml'); // similar to footnote rnRef: begin - result := ropeFormat('<a class="reference external" href="#$2">$1</a>', + result := ropef('<a class="reference external" href="#$2">$1</a>', [renderAux(d, n), toRope(rstnodeToRefname(n))]); exit end; rnStandaloneHyperlink: outer := '<a class="reference external" href="$1">$1</a>'; rnHyperlink: begin - result := ropeFormat('<a class="reference external" href="$2">$1</a>', - [renderRstToHtml(d, n.sons[0]), + result := ropef('<a class="reference external" href="$2">$1</a>', + [renderRstToHtml(d, n.sons[0]), renderRstToHtml(d, n.sons[1])]); exit end; @@ -766,8 +781,8 @@ begin // Inline markup: rnGeneralRole: begin - result := ropeFormat('<span class="$2">$1</span>', - [renderRstToHtml(d, n.sons[0]), + result := ropef('<span class="$2">$1</span>', + [renderRstToHtml(d, n.sons[0]), renderRstToHtml(d, n.sons[1])]); exit end; @@ -776,8 +791,8 @@ begin rnEmphasis: outer := '<em>$1</em>'; rnStrongEmphasis: outer := '<strong>$1</strong>'; rnInterpretedText: outer := '<cite>$1</cite>'; - rnIdx: begin - if d.theIndex = nil then + rnIdx: begin + if d.theIndex = nil then outer := '<em>$1</em>' else begin result := renderIndexTerm(d, n); exit @@ -798,7 +813,7 @@ begin d.meta[metaTitle] := renderRstToHtml(d, n.sons[0]); exit end; - else assert(false); + else InternalError('renderRstToHtml'); end; result := renderAux(d, n, outer, inner); end; @@ -809,11 +824,12 @@ var begin if n = nil then exit; case n.kind of - nkCommentStmt: app(d.modDesc, genComment(d, n)); - nkProcDef: genItem(d, n, n.sons[namePos], skProc); - nkIteratorDef: genItem(d, n, n.sons[namePos], skIterator); - nkMacroDef: genItem(d, n, n.sons[namePos], skMacro); - nkTemplateDef: genItem(d, n, n.sons[namePos], skTemplate); + nkCommentStmt: app(d.modDesc, genComment(d, n)); + nkProcDef: genItem(d, n, n.sons[namePos], skProc); + nkIteratorDef: genItem(d, n, n.sons[namePos], skIterator); + nkMacroDef: genItem(d, n, n.sons[namePos], skMacro); + nkTemplateDef: genItem(d, n, n.sons[namePos], skTemplate); + nkConverterDef: genItem(d, n, n.sons[namePos], skConverter); nkVarSection: begin for i := 0 to sonsLen(n)-1 do genItem(d, n.sons[i], n.sons[i].sons[0], skVar); @@ -860,14 +876,16 @@ var begin j := 0; toc := renderTocEntries(d, j, 1); + code := nil; + content := nil; + title := nil; for i := low(TSymKind) to high(TSymKind) do begin genSection(d, i); app(toc, d.toc[i]); end; if toc <> nil then toc := ropeFormatNamedVars(getConfigVar('doc.toc'), ['content'], [toc]); - code := nil; - for i := low(TSymKind) to high(TSymKind) do + for i := low(TSymKind) to high(TSymKind) do app(code, d.section[i]); if d.meta[metaTitle] <> nil then title := d.meta[metaTitle] @@ -880,7 +898,7 @@ begin content := ropeFormatNamedVars(getConfigVar(bodyname), ['title', 'tableofcontents', 'moduledesc', 'date', 'time', 'content'], [title, toc, d.modDesc, toRope(getDateStr()), toRope(getClockStr()), code]); - if not (optCompileOnly in gGlobalOptions) then + if not (optCompileOnly in gGlobalOptions) then code := ropeFormatNamedVars(getConfigVar('doc.file'), ['title', 'tableofcontents', 'moduledesc', 'date', 'time', 'content'], [title, toc, d.modDesc, @@ -918,13 +936,16 @@ var filen: string; d: PDoc; rst: PRstNode; + code: PRope; begin filen := appendFileExt(filename, 'txt'); d := newDocumentor(filen); initIndexFile(d); rst := rstParse(readFile(filen), false, filen, 0, 1, d.hasToc); d.modDesc := renderRstToHtml(d, rst); - writeRope(genHtmlFile(d), getOutFile(filename, HtmlExt)); + code := genHtmlFile(d); + assert(ropeInvariant(code)); + writeRope(code, getOutFile(filename, HtmlExt)); generateIndex(d); end; diff --git a/nim/ecmasgen.pas b/nim/ecmasgen.pas new file mode 100644 index 000000000..53ab4f069 --- /dev/null +++ b/nim/ecmasgen.pas @@ -0,0 +1,1869 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit ecmasgen; + +// This is the EMCAScript (also known as JavaScript) code generator. +// **Invariant: each expression only occurs once in the generated +// code!** + +interface + +{$include 'config.inc'} + +uses + nsystem, ast, astalgo, strutils, hashes, trees, platform, magicsys, + extccomp, options, nversion, nimsets, msgs, crc, bitsets, idents, + lists, types, nos, ntime, ropes, nmath, backends, ccgutils, wordrecg, rnimsyn; + +function EcmasBackend(b: PBackend; module: PSym; + const filename: string): PBackend; + +implementation + +type + TEcmasGen = object(TBackend) + end; + BModule = ^TEcmasGen; + + TEcmasTypeKind = ( + etyNone, // no type + etyNull, // null type + etyProc, // proc type + etyBool, // bool type + etyInt, // Ecmascript's int + etyFloat, // Ecmascript's float + etyString, // Ecmascript's string + etyObject, // Ecmascript's reference to an object + etyBaseIndex // base + index needed + ); + + TCompRes = record + kind: TEcmasTypeKind; + com: PRope; // computation part + // address if this is a (address, index)-tuple + res: PRope; // result part; index if this is a (address, index)-tuple + end; + + TBlock = record + id: int; // the ID of the label; positive means that it + // has been used (i.e. the label should be emitted) + nestedTryStmts: int; // how many try statements is it nested into + end; + + TGlobals = record + typeInfo, code: PRope; + typeInfoGenerated: TIntSet; + end; + PGlobals = ^TGlobals; + + TProc = record + procDef: PNode; + prc: PSym; + data: PRope; + options: TOptions; + module: BModule; + globals: PGlobals; + BeforeRetNeeded: bool; + nestedTryStmts: int; + unique: int; + blocks: array of TBlock; + end; + +function newGlobals(): PGlobals; +begin + new(result); +{@ignore} fillChar(result^, sizeof(result^), 0); {@emit} + IntSetInit(result.typeInfoGenerated); +end; + +procedure initCompRes(var r: TCompRes); +begin + r.com := nil; r.res := nil; r.kind := etyNone; +end; + +procedure initProc(var p: TProc; globals: PGlobals; module: BModule; + procDef: PNode; options: TOptions); +begin +{@ignore} + fillChar(p, sizeof(p), 0); +{@emit + p.blocks := [];} + p.options := options; + p.module := module; + p.procDef := procDef; + p.globals := globals; + if procDef <> nil then p.prc := procDef.sons[namePos].sym; +end; + +const + MappedToObject = {@set}[tyObject, tyArray, tyArrayConstr, tyTuple, + tyEmptySet, tyOpenArray, tySet, tyVar, + tyRef, tyPtr]; + +function mapType(typ: PType): TEcmasTypeKind; +begin + case skipGeneric(typ).kind of + tyVar, tyRef, tyPtr: begin + if typ.sons[0].kind in mappedToObject then + result := etyObject + else + result := etyBaseIndex + end; + tyPointer: begin + // treat a tyPointer like a typed pointer to an array of bytes + result := etyInt; + end; + tyRange: result := mapType(typ.sons[0]); + tyInt..tyInt64, tyEnum, tyAnyEnum, tyChar: + result := etyInt; + tyBool: result := etyBool; + tyFloat..tyFloat128: result := etyFloat; + tySet: begin + result := etyObject // map a set to a table + end; + tyString, tySequence: + result := etyInt; // little hack to get the right semantics + tyObject, tyArray, tyArrayConstr, tyTuple, tyEmptySet, tyOpenArray: + result := etyObject; + tyNil: result := etyNull; + tyGenericInst, tyGenericParam, tyGeneric, tyNone, tyForward: + result := etyNone; + tyProc: result := etyProc; + tyCString: result := etyString; + end +end; + +function mangle(const name: string): string; +var + i: int; +begin + result := ''; + for i := strStart to length(name) + strStart-1 do begin + case name[i] of + 'A'..'Z': addChar(result, chr(ord(name[i]) - ord('A') + ord('a'))); + '_': begin end; + 'a'..'z', '0'..'9': addChar(result, name[i]); + else result := result +{&} 'X' +{&} toHex(ord(name[i]), 2); + end + end +end; + +function mangleName(s: PSym): PRope; +begin + result := s.loc.r; + if result = nil then begin + result := toRope(mangle(s.name.s)); + app(result, '_'+''); + app(result, toRope(s.id)); + s.loc.r := result; + end +end; + +// ----------------------- type information ---------------------------------- + +function genTypeInfo(var p: TProc; typ: PType): PRope; forward; + +function genObjectFields(var p: TProc; typ: PType; n: PNode): PRope; +var + s, u: PRope; + len, i, j: int; + field: PSym; + b: PNode; +begin + result := nil; + case n.kind of + nkRecList: begin + len := sonsLen(n); + if len = 1 then // generates more compact code! + result := genObjectFields(p, typ, n.sons[0]) + else begin + s := nil; + for i := 0 to len-1 do begin + if i > 0 then app(s, ', ' + tnl); + app(s, genObjectFields(p, typ, n.sons[i])); + end; + result := ropef('{kind: 2, len: $1, offset: 0, ' + + 'typ: null, name: null, sons: [$2]}', [toRope(len), s]); + end + end; + nkSym: begin + field := n.sym; + s := genTypeInfo(p, field.typ); + result := ropef('{kind: 1, offset: "$1", len: 0, ' + + 'typ: $2, name: $3, sons: null}', [ + mangleName(field), s, makeCString(field.name.s)]); + end; + nkRecCase: begin + len := sonsLen(n); + if (n.sons[0].kind <> nkSym) then + InternalError(n.info, 'genObjectFields'); + field := n.sons[0].sym; + s := genTypeInfo(p, field.typ); + for i := 1 to len-1 do begin + b := n.sons[i]; // branch + u := nil; + case b.kind of + nkOfBranch: begin + if sonsLen(b) < 2 then + internalError(b.info, 'genObjectFields; nkOfBranch broken'); + for j := 0 to sonsLen(b)-2 do begin + if u <> nil then app(u, ', '); + if b.sons[j].kind = nkRange then begin + appf(u, '[$1, $2]', [toRope(getOrdValue(b.sons[j].sons[0])), + toRope(getOrdValue(b.sons[j].sons[1]))]); + end + else + app(u, toRope(getOrdValue(b.sons[j]))) + end + end; + nkElse: u := toRope(lengthOrd(field.typ)); + else internalError(n.info, 'genObjectFields(nkRecCase)'); + end; + if result <> nil then app(result, ', ' + tnl); + appf(result, '[SetConstr($1), $2]', + [u, genObjectFields(p, typ, lastSon(b))]); + end; + result := ropef('{kind: 3, offset: "$1", len: $3, ' + + 'typ: $2, name: $4, sons: [$5]}', [mangleName(field), s, + toRope(lengthOrd(field.typ)), + makeCString(field.name.s), + result]); + end; + else internalError(n.info, 'genObjectFields'); + end +end; + +procedure genObjectInfo(var p: TProc; typ: PType; name: PRope); +var + s: PRope; +begin + s := ropef('var $1 = {size: 0, kind: $2, base: null, node: null, ' + + 'finalizer: null};$n', [name, toRope(ord(typ.kind))]); + prepend(p.globals.typeInfo, s); + + appf(p.globals.typeInfo, 'var NNI$1 = $2;$n', + [toRope(typ.id), genObjectFields(p, typ, typ.n)]); + appf(p.globals.typeInfo, '$1.node = NNI$2;$n', [name, toRope(typ.id)]); + if (typ.kind = tyObject) and (typ.sons[0] <> nil) then begin + appf(p.globals.typeInfo, '$1.base = $2;$n', + [name, genTypeInfo(p, typ.sons[0])]); + end +end; + +procedure genEnumInfo(var p: TProc; typ: PType; name: PRope); +var + s, n: PRope; + len, i: int; + field: PSym; +begin + len := sonsLen(typ.n); + s := nil; + for i := 0 to len-1 do begin + if (typ.n.sons[i].kind <> nkSym) then + InternalError(typ.n.info, 'genEnumInfo'); + field := typ.n.sons[i].sym; + if i > 0 then app(s, ', '+tnl); + appf(s, '{kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}', + [toRope(field.position), name, makeCString(field.name.s)]); + end; + n := ropef('var NNI$1 = {kind: 2, offset: 0, typ: null, ' + + 'name: null, len: $2, sons: [$3]};$n', + [toRope(typ.id), toRope(len), s]); + + s := ropef('var $1 = {size: 0, kind: $2, base: null, node: null, ' + + 'finalizer: null};$n', [name, toRope(ord(typ.kind))]); + prepend(p.globals.typeInfo, s); + + app(p.globals.typeInfo, n); + appf(p.globals.typeInfo, '$1.node = NNI$2;$n', [name, toRope(typ.id)]); + if typ.sons[0] <> nil then begin + appf(p.globals.typeInfo, '$1.base = $2;$n', + [name, genTypeInfo(p, typ.sons[0])]); + end; +end; + +function genTypeInfo(var p: TProc; typ: PType): PRope; +var + t: PType; + s: PRope; +begin + t := typ; + if t.kind = tyGenericInst then t := lastSon(t); + result := ropef('NTI$1', [toRope(t.id)]); + if IntSetContainsOrIncl(p.globals.TypeInfoGenerated, t.id) then exit; + case t.kind of + tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, + tyInt..tyFloat128: begin + s := ropef( + 'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n', + [result, toRope(ord(t.kind))]); + prepend(p.globals.typeInfo, s); + end; + tyVar, tyRef, tyPtr, tySequence, tyRange, tySet: begin + s := ropef( + 'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n', + [result, toRope(ord(t.kind))]); + prepend(p.globals.typeInfo, s); + appf(p.globals.typeInfo, '$1.base = $2;$n', + [result, genTypeInfo(p, typ.sons[0])]); + end; + tyArrayConstr, tyArray: begin + s := ropef( + 'var $1 = {size: 0, kind: $2, base: null, node: null, finalizer: null};$n', + [result, toRope(ord(t.kind))]); + prepend(p.globals.typeInfo, s); + appf(p.globals.typeInfo, '$1.base = $2;$n', + [result, genTypeInfo(p, typ.sons[1])]); + end; + tyEnum: genEnumInfo(p, t, result); + tyObject, tyTuple: genObjectInfo(p, t, result); + else InternalError('genTypeInfo(' + typekindToStr[t.kind] + ')'); + end +end; + +// --------------------------------------------------------------------------- + +procedure gen(var p: TProc; n: PNode; var r: TCompRes); forward; +procedure genStmt(var p: TProc; n: PNode; var r: TCompRes); forward; + +procedure useMagic(var p: TProc; const ident: string); +begin + // to implement +end; + +function mergeExpr(a, b: PRope): PRope; overload; +begin + if (a <> nil) then begin + if b <> nil then result := ropef('($1, $2)', [a, b]) + else result := a + end + else result := b +end; + +function mergeExpr(const r: TCompRes): PRope; overload; +begin + result := mergeExpr(r.com, r.res); +end; + +function mergeStmt(const r: TCompRes): PRope; +begin + if r.res = nil then result := r.com + else if r.com = nil then result := r.res + else result := ropef('$1$2', [r.com, r.res]) +end; + +procedure genAnd(var p: TProc; a, b: PNode; var r: TCompRes); +var + x, y: TCompRes; +begin + gen(p, a, x); + gen(p, b, y); + r.res := ropef('($1 && $2)', [mergeExpr(x), mergeExpr(y)]) +end; + +procedure genOr(var p: TProc; a, b: PNode; var r: TCompRes); +var + x, y: TCompRes; +begin + gen(p, a, x); + gen(p, b, y); + r.res := ropef('($1 || $2)', [mergeExpr(x), mergeExpr(y)]) +end; + +type + TMagicFrmt = array [0..3] of string; + +const + // magic checked op; magic unchecked op; checked op; unchecked op + ops: array [mAddi..mStrToStr] of TMagicFrmt = ( + ('addInt', '', 'addInt($1, $2)', '($1 + $2)'), // AddI + ('subInt', '', 'subInt($1, $2)', '($1 - $2)'), // SubI + ('mulInt', '', 'mulInt($1, $2)', '($1 * $2)'), // MulI + ('divInt', '', 'divInt($1, $2)', 'Math.floor($1 / $2)'), // DivI + ('modInt', '', 'modInt($1, $2)', 'Math.floor($1 % $2)'), // ModI + ('addInt64', '', 'addInt64($1, $2)', '($1 + $2)'), // AddI64 + ('subInt64', '', 'subInt64($1, $2)', '($1 - $2)'), // SubI64 + ('mulInt64', '', 'mulInt64($1, $2)', '($1 * $2)'), // MulI64 + ('divInt64', '', 'divInt64($1, $2)', 'Math.floor($1 / $2)'), // DivI64 + ('modInt64', '', 'modInt64($1, $2)', 'Math.floor($1 % $2)'), // ModI64 + ('', '', '($1 >>> $2)', '($1 >>> $2)'), // ShrI + ('', '', '($1 << $2)', '($1 << $2)'), // ShlI + ('', '', '($1 & $2)', '($1 & $2)'), // BitandI + ('', '', '($1 | $2)', '($1 | $2)'), // BitorI + ('', '', '($1 ^ $2)', '($1 ^ $2)'), // BitxorI + ('nimMin', 'nimMin', 'nimMin($1, $2)', 'nimMin($1, $2)'), // MinI + ('nimMax', 'nimMax', 'nimMax($1, $2)', 'nimMax($1, $2)'), // MaxI + ('', '', '($1 >>> $2)', '($1 >>> $2)'), // ShrI64 + ('', '', '($1 << $2)', '($1 << $2)'), // ShlI64 + ('', '', '($1 & $2)', '($1 & $2)'), // BitandI64 + ('', '', '($1 | $2)', '($1 | $2)'), // BitorI64 + ('', '', '($1 ^ $2)', '($1 ^ $2)'), // BitxorI64 + ('nimMin', 'nimMin', 'nimMin($1, $2)', 'nimMin($1, $2)'), // MinI64 + ('nimMax', 'nimMax', 'nimMax($1, $2)', 'nimMax($1, $2)'), // MaxI64 + ('', '', '($1 + $2)', '($1 + $2)'), // AddF64 + ('', '', '($1 - $2)', '($1 - $2)'), // SubF64 + ('', '', '($1 * $2)', '($1 * $2)'), // MulF64 + ('', '', '($1 / $2)', '($1 / $2)'), // DivF64 + ('nimMin', 'nimMin', 'nimMin($1, $2)', 'nimMin($1, $2)'), // MinF64 + ('nimMax', 'nimMax', 'nimMax($1, $2)', 'nimMax($1, $2)'), // MaxF64 + ('AddU', 'AddU', 'AddU($1, $2)', 'AddU($1, $2)'), // AddU + ('SubU', 'SubU', 'SubU($1, $2)', 'SubU($1, $2)'), // SubU + ('MulU', 'MulU', 'MulU($1, $2)', 'MulU($1, $2)'), // MulU + ('DivU', 'DivU', 'DivU($1, $2)', 'DivU($1, $2)'), // DivU + ('ModU', 'ModU', 'ModU($1, $2)', 'ModU($1, $2)'), // ModU + ('AddU64', 'AddU64', 'AddU64($1, $2)', 'AddU64($1, $2)'), // AddU64 + ('SubU64', 'SubU64', 'SubU64($1, $2)', 'SubU64($1, $2)'), // SubU64 + ('MulU64', 'MulU64', 'MulU64($1, $2)', 'MulU64($1, $2)'), // MulU64 + ('DivU64', 'DivU64', 'DivU64($1, $2)', 'DivU64($1, $2)'), // DivU64 + ('ModU64', 'ModU64', 'ModU64($1, $2)', 'ModU64($1, $2)'), // ModU64 + ('', '', '($1 == $2)', '($1 == $2)'), // EqI + ('', '', '($1 <= $2)', '($1 <= $2)'), // LeI + ('', '', '($1 < $2)', '($1 < $2)'), // LtI + ('', '', '($1 == $2)', '($1 == $2)'), // EqI64 + ('', '', '($1 <= $2)', '($1 <= $2)'), // LeI64 + ('', '', '($1 < $2)', '($1 < $2)'), // LtI64 + ('', '', '($1 == $2)', '($1 == $2)'), // EqF64 + ('', '', '($1 <= $2)', '($1 <= $2)'), // LeF64 + ('', '', '($1 < $2)', '($1 < $2)'), // LtF64 + ('LeU', 'LeU', 'LeU($1, $2)', 'LeU($1, $2)'), // LeU + ('LtU', 'LtU', 'LtU($1, $2)', 'LtU($1, $2)'), // LtU + ('LeU64', 'LeU64', 'LeU64($1, $2)', 'LeU64($1, $2)'), // LeU64 + ('LtU64', 'LtU64', 'LtU64($1, $2)', 'LtU64($1, $2)'), // LtU64 + ('', '', '($1 == $2)', '($1 == $2)'), // EqEnum + ('', '', '($1 <= $2)', '($1 <= $2)'), // LeEnum + ('', '', '($1 < $2)', '($1 < $2)'), // LtEnum + ('', '', '($1 == $2)', '($1 == $2)'), // EqCh + ('', '', '($1 <= $2)', '($1 <= $2)'), // LeCh + ('', '', '($1 < $2)', '($1 < $2)'), // LtCh + ('', '', '($1 == $2)', '($1 == $2)'), // EqB + ('', '', '($1 <= $2)', '($1 <= $2)'), // LeB + ('', '', '($1 < $2)', '($1 < $2)'), // LtB + ('', '', '($1 == $2)', '($1 == $2)'), // EqRef + ('', '', '($1 == $2)', '($1 == $2)'), // EqProc + ('', '', '($1 == $2)', '($1 == $2)'), // EqUntracedRef + ('', '', '($1 <= $2)', '($1 <= $2)'), // LePtr + ('', '', '($1 < $2)', '($1 < $2)'), // LtPtr + ('', '', '($1 == $2)', '($1 == $2)'), // EqCString + ('', '', '($1 != $2)', '($1 != $2)'), // Xor + ('NegInt', '', 'NegInt($1)', '-($1)'), // UnaryMinusI + ('NegInt64', '', 'NegInt64($1)', '-($1)'), // UnaryMinusI64 + ('AbsInt', '', 'AbsInt($1)', 'Math.abs($1)'), // AbsI + ('AbsInt64', '', 'AbsInt64($1)', 'Math.abs($1)'), // AbsI64 + ('', '', '!($1)', '!($1)'), // Not + ('', '', '+($1)', '+($1)'), // UnaryPlusI + ('', '', '~($1)', '~($1)'), // BitnotI + ('', '', '+($1)', '+($1)'), // UnaryPlusI64 + ('', '', '~($1)', '~($1)'), // BitnotI64 + ('', '', '+($1)', '+($1)'), // UnaryPlusF64 + ('', '', '-($1)', '-($1)'), // UnaryMinusF64 + ('', '', 'Math.abs($1)', 'Math.abs($1)'), // AbsF64 + + ('Ze8ToI', 'Ze8ToI', 'Ze8ToI($1)', 'Ze8ToI($1)'), // mZe8ToI + ('Ze8ToI64', 'Ze8ToI64', 'Ze8ToI64($1)', 'Ze8ToI64($1)'), // mZe8ToI64 + ('Ze16ToI', 'Ze16ToI', 'Ze16ToI($1)', 'Ze16ToI($1)'), // mZe16ToI + ('Ze16ToI64', 'Ze16ToI64', 'Ze16ToI64($1)', 'Ze16ToI64($1)'), // mZe16ToI64 + ('Ze32ToI64', 'Ze32ToI64', 'Ze32ToI64($1)', 'Ze32ToI64($1)'), // mZe32ToI64 + ('ZeIToI64', 'ZeIToI64', 'ZeIToI64($1)', 'ZeIToI64($1)'), // mZeIToI64 + + ('ToU8', 'ToU8', 'ToU8($1)', 'ToU8($1)'), // ToU8 + ('ToU16', 'ToU16', 'ToU16($1)', 'ToU16($1)'), // ToU16 + ('ToU32', 'ToU32', 'ToU32($1)', 'ToU32($1)'), // ToU32 + ('', '', '$1', '$1'), // ToFloat + ('', '', '$1', '$1'), // ToBiggestFloat + ('', '', 'Math.floor($1)', 'Math.floor($1)'), // ToInt + ('', '', 'Math.floor($1)', 'Math.floor($1)'), // ToBiggestInt + + ('nimCharToStr', 'nimCharToStr', 'nimCharToStr($1)', 'nimCharToStr($1)'), + ('nimBoolToStr', 'nimBoolToStr', 'nimBoolToStr($1)', 'nimBoolToStr($1)'), + ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'), + ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'), + ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr(($1)+"")', 'cstrToNimStr(($1)+"")'), + ('cstrToNimStr', 'cstrToNimStr', 'cstrToNimStr($1)', 'cstrToNimStr($1)'), + ('', '', '$1', '$1') + ); + +procedure binaryExpr(var p: TProc; n: PNode; var r: TCompRes; + const magic, frmt: string); +var + x, y: TCompRes; +begin + if magic <> '' then useMagic(p, magic); + gen(p, n.sons[1], x); + gen(p, n.sons[2], y); + r.res := ropef(frmt, [x.res, y.res]); + r.com := mergeExpr(x.com, y.com); +end; + +procedure binaryStmt(var p: TProc; n: PNode; var r: TCompRes; + const magic, frmt: string); +var + x, y: TCompRes; +begin + if magic <> '' then useMagic(p, magic); + gen(p, n.sons[1], x); + gen(p, n.sons[2], y); + if x.com <> nil then appf(r.com, '$1;$n', [x.com]); + if y.com <> nil then appf(r.com, '$1;$n', [y.com]); + appf(r.com, frmt, [x.res, y.res]); +end; + +procedure unaryExpr(var p: TProc; n: PNode; var r: TCompRes; + const magic, frmt: string); +begin + if magic <> '' then useMagic(p, magic); + gen(p, n.sons[1], r); + r.res := ropef(frmt, [r.res]); +end; + +procedure arith(var p: TProc; n: PNode; var r: TCompRes; op: TMagic); +var + x, y: TCompRes; + i: int; +begin + if optOverflowCheck in p.options then i := 0 else i := 1; + useMagic(p, ops[op][i]); + if sonsLen(n) > 2 then begin + gen(p, n.sons[1], x); + gen(p, n.sons[2], y); + r.res := ropef(ops[op][i+2], [x.res, y.res]); + r.com := mergeExpr(x.com, y.com); + end + else begin + gen(p, n.sons[1], r); + r.res := ropef(ops[op][i+2], [r.res]) + end +end; + +procedure genLineDir(var p: TProc; n: PNode; var r: TCompRes); +var + line: int; +begin + line := toLinenumber(n.info); + if optLineDir in p.Options then // pretty useless, but better than nothing + appf(r.com, '// line $2 "$1"$n', + [toRope(toFilename(n.info)), toRope(line)]); + if ([optStackTrace, optEndb] * p.Options = [optStackTrace, optEndb]) and + ((p.prc = nil) or not (sfPure in p.prc.flags)) then begin + useMagic(p, 'endb'); + appf(r.com, 'endb($1);$n', [toRope(line)]) + end + else if ([optLineTrace, optStackTrace] * p.Options = + [optLineTrace, optStackTrace]) and ((p.prc = nil) or + not (sfPure in p.prc.flags)) then + appf(r.com, 'F.line = $1;$n', [toRope(line)]) +end; + +procedure finishTryStmt(var p: TProc; var r: TCompRes; howMany: int); +var + i: int; +begin + for i := 1 to howMany do + app(r.com, 'excHandler = excHandler.prev;' + tnl); +end; + +procedure genWhileStmt(var p: TProc; n: PNode; var r: TCompRes); +var + cond, stmt: TCompRes; + len, labl: int; +begin + genLineDir(p, n, r); + inc(p.unique); + len := length(p.blocks); + setLength(p.blocks, len+1); + p.blocks[len].id := -p.unique; + p.blocks[len].nestedTryStmts := p.nestedTryStmts; + labl := p.unique; + gen(p, n.sons[0], cond); + genStmt(p, n.sons[1], stmt); + if p.blocks[len].id > 0 then + appf(r.com, 'L$3: while ($1) {$n$2}$n', + [mergeExpr(cond), mergeStmt(stmt), toRope(labl)]) + else + appf(r.com, 'while ($1) {$n$2}$n', + [mergeExpr(cond), mergeStmt(stmt)]); + setLength(p.blocks, len); +end; + +procedure genTryStmt(var p: TProc; n: PNode; var r: TCompRes); + // code to generate: +(* + var sp = {prev: excHandler, exc: null}; + excHandler = sp; + try { + stmts; + } catch (e) { + if (e.typ && e.typ == NTI433 || e.typ == NTI2321) { + stmts; + } else if (e.typ && e.typ == NTI32342) { + stmts; + } else { + stmts; + } + } finally { + stmts; + excHandler = excHandler.prev; + } +*) +var + i, j, len, blen: int; + safePoint, orExpr, epart: PRope; + a: TCompRes; +begin + genLineDir(p, n, r); + inc(p.unique); + safePoint := ropef('Tmp$1', [toRope(p.unique)]); + appf(r.com, 'var $1 = {prev: excHandler, exc: null};$n' + + 'excHandler = $1;$n', [safePoint]); + if optStackTrace in p.Options then + app(r.com, 'framePtr = F;' + tnl); + app(r.com, 'try {' + tnl); + len := sonsLen(n); + inc(p.nestedTryStmts); + genStmt(p, n.sons[0], a); + app(r.com, mergeStmt(a)); + i := 1; + epart := nil; + while (i < len) and (n.sons[i].kind = nkExceptBranch) do begin + blen := sonsLen(n.sons[i]); + if blen = 1 then begin + // general except section: + if i > 1 then app(epart, 'else {' + tnl); + genStmt(p, n.sons[i].sons[0], a); + app(epart, mergeStmt(a)); + if i > 1 then app(epart, '}' + tnl); + end + else begin + orExpr := nil; + for j := 0 to blen-2 do begin + if (n.sons[i].sons[j].kind <> nkType) then + InternalError(n.info, 'genTryStmt'); + if orExpr <> nil then app(orExpr, '||'); + appf(orExpr, '($1.exc.m_type == $2)', + [safePoint, genTypeInfo(p, n.sons[i].sons[j].typ)]) + end; + if i > 1 then app(epart, 'else '); + appf(epart, 'if ($1.exc && $2) {$n', [safePoint, orExpr]); + genStmt(p, n.sons[i].sons[blen - 1], a); + appf(epart, '$1}$n', [mergeStmt(a)]); + end; + inc(i) + end; + if epart <> nil then + appf(r.com, '} catch (EXC) {$n$1', [epart]); + finishTryStmt(p, r, p.nestedTryStmts); + dec(p.nestedTryStmts); + app(r.com, '} finally {' + tnl + 'excHandler = excHandler.prev;' +{&} tnl); + if (i < len) and (n.sons[i].kind = nkFinally) then begin + genStmt(p, n.sons[i].sons[0], a); + app(r.com, mergeStmt(a)); + end; + app(r.com, '}' + tnl); +end; + +procedure genRaiseStmt(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; + typ: PType; +begin + genLineDir(p, n, r); + if n.sons[0] <> nil then begin + gen(p, n.sons[0], a); + if a.com <> nil then appf(r.com, '$1;$n', [a.com]); + typ := skipPtrsGeneric(n.sons[0].typ); + useMagic(p, 'raiseException'); + appf(r.com, 'raiseException($1, $2);$n', + [a.res, makeCString(typ.sym.name.s)]); + end + else begin + useMagic(p, 'reraiseException'); + app(r.com, 'reraiseException();' + tnl); + end +end; + +procedure genCaseStmt(var p: TProc; n: PNode; var r: TCompRes); +var + cond, stmt: TCompRes; + i, j: int; + it, e, v: PNode; + stringSwitch: bool; +begin + genLineDir(p, n, r); + gen(p, n.sons[0], cond); + if cond.com <> nil then + appf(r.com, '$1;$n', [cond.com]); + stringSwitch := skipVarGeneric(n.sons[0].typ).kind = tyString; + if stringSwitch then begin + useMagic(p, 'toEcmaStr'); + appf(r.com, 'switch (toEcmaStr($1)) {$n', [cond.res]) + end + else + appf(r.com, 'switch ($1) {$n', [cond.res]); + for i := 1 to sonsLen(n)-1 do begin + it := n.sons[i]; + case it.kind of + nkOfBranch: begin + for j := 0 to sonsLen(it)-2 do begin + e := it.sons[j]; + if e.kind = nkRange then begin + v := copyNode(e.sons[0]); + while (v.intVal <= e.sons[1].intVal) do begin + gen(p, v, cond); + if cond.com <> nil then + internalError(v.info, 'ecmasgen.genCaseStmt'); + appf(r.com, 'case $1: ', [cond.res]); + Inc(v.intVal) + end + end + else begin + gen(p, e, cond); + if cond.com <> nil then + internalError(e.info, 'ecmasgen.genCaseStmt'); + if stringSwitch then begin + case e.kind of + nkStrLit..nkTripleStrLit: + appf(r.com, 'case $1: ', [makeCString(e.strVal)]); + else InternalError(e.info, 'ecmasgen.genCaseStmt: 2'); + end + end + else + appf(r.com, 'case $1: ', [cond.res]); + end + end; + genStmt(p, lastSon(it), stmt); + appf(r.com, '$n$1break;$n', [mergeStmt(stmt)]); + end; + nkElse: begin + genStmt(p, it.sons[0], stmt); + appf(r.com, 'default: $n$1break;$n', [mergeStmt(stmt)]); + end + else internalError(it.info, 'ecmasgen.genCaseStmt') + end + end; + appf(r.com, '}$n', []); +end; + +procedure genStmtListExpr(var p: TProc; n: PNode; var r: TCompRes); forward; + +procedure genBlock(var p: TProc; n: PNode; var r: TCompRes); +var + idx, labl: int; + sym: PSym; +begin + inc(p.unique); + idx := length(p.blocks); + if n.sons[0] <> nil then begin // named block? + if (n.sons[0].kind <> nkSym) then InternalError(n.info, 'genBlock'); + sym := n.sons[0].sym; + sym.loc.k := locOther; + sym.loc.a := idx + end; + setLength(p.blocks, idx+1); + p.blocks[idx].id := -p.unique; // negative because it isn't used yet + p.blocks[idx].nestedTryStmts := p.nestedTryStmts; + labl := p.unique; + if n.kind = nkBlockExpr then genStmtListExpr(p, n.sons[1], r) + else genStmt(p, n.sons[1], r); + if p.blocks[idx].id > 0 then begin // label has been used: + r.com := ropef('L$1: do {$n$2} while(false);$n', + [toRope(labl), r.com]); + end; + setLength(p.blocks, idx) +end; + +procedure genBreakStmt(var p: TProc; n: PNode; var r: TCompRes); +var + idx: int; + sym: PSym; +begin + genLineDir(p, n, r); + idx := length(p.blocks)-1; + if n.sons[0] <> nil then begin // named break? + assert(n.sons[0].kind = nkSym); + sym := n.sons[0].sym; + assert(sym.loc.k = locOther); + idx := sym.loc.a + end; + p.blocks[idx].id := abs(p.blocks[idx].id); // label is used + finishTryStmt(p, r, p.nestedTryStmts - p.blocks[idx].nestedTryStmts); + appf(r.com, 'break L$1;$n', [toRope(p.blocks[idx].id)]) +end; + +procedure genAsmStmt(var p: TProc; n: PNode; var r: TCompRes); +var + i: int; +begin + genLineDir(p, n, r); + assert(n.kind = nkAsmStmt); + for i := 0 to sonsLen(n)-1 do begin + case n.sons[i].Kind of + nkStrLit..nkTripleStrLit: app(r.com, n.sons[i].strVal); + nkSym: app(r.com, mangleName(n.sons[i].sym)); + else InternalError(n.sons[i].info, 'ecmasgen: genAsmStmt()') + end + end +end; + +procedure genIfStmt(var p: TProc; n: PNode; var r: TCompRes); +var + i, toClose: int; + cond, stmt: TCompRes; + it: PNode; +begin + toClose := 0; + for i := 0 to sonsLen(n)-1 do begin + it := n.sons[i]; + if sonsLen(it) <> 1 then begin + gen(p, it.sons[0], cond); + genStmt(p, it.sons[1], stmt); + if i > 0 then begin appf(r.com, 'else {$n', []); inc(toClose) end; + if cond.com <> nil then appf(r.com, '$1;$n', [cond.com]); + appf(r.com, 'if ($1) {$n$2}', [cond.res, mergeStmt(stmt)]); + end + else begin + // else part: + genStmt(p, it.sons[0], stmt); + appf(r.com, 'else {$n$1}$n', [mergeStmt(stmt)]); + end + end; + app(r.com, repeatChar(toClose, '}')+{&}tnl); +end; + +procedure genIfExpr(var p: TProc; n: PNode; var r: TCompRes); +var + i, toClose: int; + cond, stmt: TCompRes; + it: PNode; +begin + toClose := 0; + for i := 0 to sonsLen(n)-1 do begin + it := n.sons[i]; + if sonsLen(it) <> 1 then begin + gen(p, it.sons[0], cond); + gen(p, it.sons[1], stmt); + if i > 0 then begin app(r.res, ': ('); inc(toClose); end; + r.com := mergeExpr(r.com, cond.com); + r.com := mergeExpr(r.com, stmt.com); + appf(r.res, '($1) ? ($2)', [cond.res, stmt.res]); + end + else begin + // else part: + gen(p, it.sons[0], stmt); + r.com := mergeExpr(r.com, stmt.com); + appf(r.res, ': ($1)', [stmt.res]); + end + end; + app(r.res, repeatChar(toClose, ')')); +end; + +function generateHeader(var p: TProc; typ: PType): PRope; +var + i: int; + param: PSym; + name: PRope; +begin + result := nil; + for i := 1 to sonsLen(typ.n)-1 do begin + if result <> nil then app(result, ', '); + assert(typ.n.sons[i].kind = nkSym); + param := typ.n.sons[i].sym; + name := mangleName(param); + app(result, name); + if mapType(param.typ) = etyBaseIndex then begin + app(result, ', '); + app(result, name); + app(result, '_Idx'); + end + end +end; + +const + nodeKindsNeedNoCopy = {@set}[nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, + nkFloatLit..nkFloat64Lit, + nkCurly, nkPar, + nkStringToCString, nkCStringToString, + nkCall, nkHiddenCallConv]; + +function needsNoCopy(y: PNode): bool; +begin + result := (y.kind in nodeKindsNeedNoCopy) + or (skipGeneric(y.typ).kind in [tyRef, tyPtr, tyVar]) +end; + +procedure genAsgnAux(var p: TProc; x, y: PNode; var r: TCompRes); +var + a, b: TCompRes; +begin + gen(p, x, a); + gen(p, y, b); + case mapType(x.typ) of + etyObject: begin + if a.com <> nil then appf(r.com, '$1;$n', [a.com]); + if b.com <> nil then appf(r.com, '$1;$n', [b.com]); + if needsNoCopy(y) then + appf(r.com, '$1 = $2;$n', [a.res, b.res]) + else begin + useMagic(p, 'NimCopy'); + appf(r.com, '$1 = NimCopy($2, $3);$n', + [a.res, b.res, genTypeInfo(p, y.typ)]); + end + end; + etyBaseIndex: begin + if (a.kind <> etyBaseIndex) or (b.kind <> etyBaseIndex) then + internalError(x.info, 'genAsgn'); + appf(r.com, '$1 = $2; $3 = $4;$n', [a.com, b.com, a.res, b.res]); + end + else begin + if a.com <> nil then appf(r.com, '$1;$n', [a.com]); + if b.com <> nil then appf(r.com, '$1;$n', [b.com]); + appf(r.com, '$1 = $2;$n', [a.res, b.res]); + end + end +end; + +procedure genAsgn(var p: TProc; n: PNode; var r: TCompRes); +begin + genLineDir(p, n, r); + genAsgnAux(p, n.sons[0], n.sons[1], r); +end; + +procedure genSwap(var p: TProc; n: PNode; var r: TCompRes); +var + a, b: TCompRes; + tmp, tmp2: PRope; +begin + gen(p, n.sons[1], a); + gen(p, n.sons[2], b); + inc(p.unique); + tmp := ropef('Tmp$1', [toRope(p.unique)]); + case mapType(n.sons[1].typ) of + etyBaseIndex: begin + inc(p.unique); + tmp2 := ropef('Tmp$1', [toRope(p.unique)]); + if (a.kind <> etyBaseIndex) or (b.kind <> etyBaseIndex) then + internalError(n.info, 'genSwap'); + appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1;$n', [tmp, a.com, b.com]); + appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1', [tmp2, a.res, b.res]); + end + else begin + if a.com <> nil then appf(r.com, '$1;$n', [a.com]); + if b.com <> nil then appf(r.com, '$1;$n', [b.com]); + appf(r.com, 'var $1 = $2; $2 = $3; $3 = $1', [tmp, a.res, b.res]); + end + end +end; + +procedure genFieldAddr(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; + f: PSym; +begin + r.kind := etyBaseIndex; + gen(p, n.sons[0], a); + if n.sons[1].kind <> nkSym then + InternalError(n.sons[1].info, 'genFieldAddr'); + f := n.sons[1].sym; + if f.loc.r = nil then f.loc.r := mangleName(f); + r.res := makeCString(ropeToStr(f.loc.r)); + r.com := mergeExpr(a); +end; + +procedure genFieldAccess(var p: TProc; n: PNode; var r: TCompRes); +var + f: PSym; +begin + r.kind := etyNone; + gen(p, n.sons[0], r); + if n.sons[1].kind <> nkSym then + InternalError(n.sons[1].info, 'genFieldAddr'); + f := n.sons[1].sym; + if f.loc.r = nil then f.loc.r := mangleName(f); + r.res := ropef('$1.$2', [r.res, f.loc.r]); +end; + +procedure genCheckedFieldAddr(var p: TProc; n: PNode; var r: TCompRes); +begin + genFieldAddr(p, n.sons[0], r); // XXX +end; + +procedure genCheckedFieldAccess(var p: TProc; n: PNode; var r: TCompRes); +begin + genFieldAccess(p, n.sons[0], r); // XXX +end; + +procedure genArrayAddr(var p: TProc; n: PNode; var r: TCompRes); +var + a, b: TCompRes; + first: biggestInt; + typ: PType; +begin + r.kind := etyBaseIndex; + gen(p, n.sons[0], a); + gen(p, n.sons[1], b); + r.com := mergeExpr(a); + typ := skipPtrsGeneric(n.sons[0].typ); + if typ.kind in [tyArray, tyArrayConstr] then first := FirstOrd(typ.sons[0]) + else first := 0; + if (optBoundsCheck in p.options) and not isConstExpr(n.sons[1]) then begin + useMagic(p, 'chckIndx'); + b.res := ropef('chckIndx($1, $2, $3.length)-$2', + [b.res, toRope(first), a.res]); + // XXX: BUG: a.res evaluated twice! + end + else if first <> 0 then begin + b.res := ropef('($1)-$2', [b.res, toRope(first)]); + end; + r.res := mergeExpr(b); +end; + +procedure genArrayAccess(var p: TProc; n: PNode; var r: TCompRes); +begin + genArrayAddr(p, n, r); + r.kind := etyNone; + r.res := ropef('$1[$2]', [r.com, r.res]); + r.com := nil; +end; + +(* +type + TMyList = record + x: seq[ptr ptr int] + L: int + next: ptr TMyList + +proc myAdd(head: var ptr TMyList, item: ptr TMyList) = + item.next = head + head = item + +proc changeInt(i: var int) = inc(i) + +proc f(p: ptr TMyList, x: ptr ptr int) = + add p.x, x + p.next = nil + changeInt(p.L) + +*) + +procedure genAddr(var p: TProc; n: PNode; var r: TCompRes); +var + s: PSym; +begin + case n.sons[0].kind of + nkSym: begin + s := n.sons[0].sym; + if s.loc.r = nil then InternalError(n.info, 'genAddr: 3'); + case s.kind of + skVar: begin + if mapType(n.typ) = etyObject then begin + // make addr() a no-op: + r.kind := etyNone; + r.res := s.loc.r; + r.com := nil; + end + else if sfGlobal in s.flags then begin + // globals are always indirect accessible + r.kind := etyBaseIndex; + r.com := toRope('Globals'); + r.res := makeCString(ropeToStr(s.loc.r)); + end + else if sfAddrTaken in s.flags then begin + r.kind := etyBaseIndex; + r.com := s.loc.r; + r.res := toRope('0'+''); + end + else InternalError(n.info, 'genAddr: 4'); + end; + else InternalError(n.info, 'genAddr: 2'); + end; + end; + nkCheckedFieldExpr: genCheckedFieldAddr(p, n, r); + nkDotExpr, nkQualified: genFieldAddr(p, n, r); + nkBracketExpr: genArrayAddr(p, n, r); + else InternalError(n.info, 'genAddr'); + end +end; + +procedure genSym(var p: TProc; n: PNode; var r: TCompRes); +var + s: PSym; + k: TEcmasTypeKind; +begin + s := n.sym; + if s.loc.r = nil then + InternalError(n.info, 'symbol has no generated name: ' + s.name.s); + case s.kind of + skVar, skParam, skTemp: begin + k := mapType(s.typ); + if k = etyBaseIndex then begin + r.kind := etyBaseIndex; + if [sfAddrTaken, sfGlobal] * s.flags <> [] then begin + r.com := ropef('$1[0]', [s.loc.r]); + r.res := ropef('$1[1]', [s.loc.r]); + end + else begin + r.com := s.loc.r; + r.res := con(s.loc.r, '_Idx'); + end + end + else if (k <> etyObject) and (sfAddrTaken in s.flags) then + r.res := ropef('$1[0]', [s.loc.r]) + else + r.res := s.loc.r + end + else r.res := s.loc.r; + end +end; + +procedure genDeref(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; +begin + if mapType(n.sons[0].typ) = etyObject then + gen(p, n.sons[0], r) + else begin + gen(p, n.sons[0], a); + if a.kind <> etyBaseIndex then InternalError(n.info, 'genDeref'); + r.res := ropef('$1[$2]', [a.com, a.res]) + end +end; + +procedure genCall(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; + i: int; +begin + gen(p, n.sons[0], r); + app(r.res, '('+''); + for i := 1 to sonsLen(n)-1 do begin + if i > 1 then app(r.res, ', '); + gen(p, n.sons[i], a); + if a.kind = etyBaseIndex then begin + app(r.res, a.com); + app(r.res, ', '); + app(r.res, a.res); + end + else + app(r.res, mergeExpr(a)); + end; + app(r.res, ')'+''); +end; + +function putToSeq(const s: string; indirect: bool): PRope; +begin + result := toRope(s); + if indirect then result := ropef('[$1]', [result]) +end; + +function createVar(var p: TProc; typ: PType; + indirect: bool): PRope; forward; + +function createRecordVarAux(var p: TProc; rec: PNode; var c: int): PRope; +var + i: int; +begin + result := nil; + case rec.kind of + nkRecList: begin + for i := 0 to sonsLen(rec)-1 do + app(result, createRecordVarAux(p, rec.sons[i], c)) + end; + nkRecCase: begin + app(result, createRecordVarAux(p, rec.sons[0], c)); + for i := 1 to sonsLen(rec)-1 do + app(result, createRecordVarAux(p, lastSon(rec.sons[i]), c)); + end; + nkSym: begin + if c > 0 then app(result, ', '); + app(result, mangleName(rec.sym)); + app(result, ': '); + app(result, createVar(p, rec.sym.typ, false)); + inc(c); + end; + else InternalError(rec.info, 'createRecordVarAux') + end +end; + +function createVar(var p: TProc; typ: PType; indirect: bool): PRope; +var + i, len, c: int; + t, e: PType; +begin + t := skipGeneric(typ); + case t.kind of + tyInt..tyInt64, tyEnum, tyAnyEnum, tyChar: begin + result := putToSeq('0'+'', indirect) + end; + tyFloat..tyFloat128: result := putToSeq('0.0', indirect); + tyRange: result := createVar(p, typ.sons[0], indirect); + tySet: result := toRope('{}'); + tyBool: result := putToSeq('false', indirect); + tyArray, tyArrayConstr: begin + len := int(lengthOrd(t)); + e := elemType(t); + if len > 32 then begin + useMagic(p, 'ArrayConstr'); + result := ropef('ArrayConstr($1, $2, $3)', + [toRope(len), createVar(p, e, false), + genTypeInfo(p, e)]) + end + else begin + result := toRope('['+''); + i := 0; + while i < len do begin + if i > 0 then app(result, ', '); + app(result, createVar(p, e, false)); + inc(i); + end; + app(result, ']'+''); + end + end; + tyTuple: begin + result := toRope('{'+''); + c := 0; + app(result, createRecordVarAux(p, t.n, c)); + app(result, '}'+''); + end; + tyObject: begin + result := toRope('{'+''); + c := 0; + if not (tfFinal in t.flags) or (t.sons[0] <> nil) then begin + inc(c); + appf(result, 'm_type: $1', [genTypeInfo(p, t)]); + end; + while t <> nil do begin + app(result, createRecordVarAux(p, t.n, c)); + t := t.sons[0]; + end; + app(result, '}'+''); + end; + tyVar, tyPtr, tyRef: begin + if mapType(t) = etyBaseIndex then + result := putToSeq('[null, 0]', indirect) + else + result := putToSeq('null', indirect); + end; + tySequence, tyString, tyCString, tyPointer: begin + result := putToSeq('null', indirect); + end + else begin + internalError('createVar: ' + typekindtoStr[t.kind]); + result := nil; + end + end +end; + +function isIndirect(v: PSym): bool; +begin + result := (sfAddrTaken in v.flags) and (mapType(v.typ) <> etyObject); +end; + +procedure genVarInit(var p: TProc; v: PSym; n: PNode; var r: TCompRes); +var + a: TCompRes; + s: PRope; +begin + if n = nil then begin + appf(r.com, 'var $1 = $2;$n', + [mangleName(v), createVar(p, v.typ, isIndirect(v))]) + end + else begin + {@discard} mangleName(v); + gen(p, n, a); + case mapType(v.typ) of + etyObject: begin + if a.com <> nil then appf(r.com, '$1;$n', [a.com]); + if needsNoCopy(n) then s := a.res + else begin + useMagic(p, 'NimCopy'); + s := ropef('NimCopy($1, $2)', [a.res, genTypeInfo(p, n.typ)]); + end + end; + etyBaseIndex: begin + if (a.kind <> etyBaseIndex) then InternalError(n.info, 'genVarInit'); + if [sfAddrTaken, sfGlobal] * v.flags <> [] then + appf(r.com, 'var $1 = [$2, $3];$n', [v.loc.r, a.com, a.res]) + else + appf(r.com, 'var $1 = $2; var $1_Idx = $3;$n', + [v.loc.r, a.com, a.res]); + exit + end + else begin + if a.com <> nil then appf(r.com, '$1;$n', [a.com]); + s := a.res; + end + end; + if isIndirect(v) then + appf(r.com, 'var $1 = [$2];$n', [v.loc.r, s]) + else + appf(r.com, 'var $1 = $2;$n', [v.loc.r, s]) + end; +end; + +procedure genVarStmt(var p: TProc; n: PNode; var r: TCompRes); +var + i: int; + v: PSym; + a: PNode; +begin + for i := 0 to sonsLen(n)-1 do begin + a := n.sons[i]; + if a.kind = nkCommentStmt then continue; + assert(a.kind = nkIdentDefs); + assert(a.sons[0].kind = nkSym); + v := a.sons[0].sym; + if lfNoDecl in v.loc.flags then continue; + genLineDir(p, a, r); + genVarInit(p, v, a.sons[2], r); + end +end; + +procedure genConstStmt(var p: TProc; n: PNode; var r: TCompRes); +var + c: PSym; + i: int; +begin + genLineDir(p, n, r); + for i := 0 to sonsLen(n)-1 do begin + if n.sons[i].kind = nkCommentStmt then continue; + assert(n.sons[i].kind = nkConstDef); + c := n.sons[i].sons[0].sym; + if (c.ast <> nil) and (c.typ.kind in ConstantDataTypes) and + not (lfNoDecl in c.loc.flags) then begin + genLineDir(p, n.sons[i], r); + genVarInit(p, c, c.ast, r); + end + end +end; + +procedure genNew(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; + t: Ptype; +begin + gen(p, n.sons[1], a); + t := skipVarGeneric(n.sons[1].typ).sons[0]; + if a.com <> nil then appf(r.com, '$1;$n', [a.com]); + appf(r.com, '$1 = $2;$n', [a.res, createVar(p, t, true)]); +end; + +procedure genOrd(var p: TProc; n: PNode; var r: TCompRes); +begin + case skipVarGeneric(n.sons[1].typ).kind of + tyEnum, tyAnyEnum, tyInt..tyInt64, tyChar: gen(p, n.sons[1], r); + tyBool: unaryExpr(p, n, r, '', '($1 ? 1:0)'); + else InternalError(n.info, 'genOrd'); + end +end; + +procedure genConStrStr(var p: TProc; n: PNode; var r: TCompRes); +var + a, b: TCompRes; +begin + gen(p, n.sons[1], a); + gen(p, n.sons[2], b); + r.com := mergeExpr(a.com, b.com); + if skipVarGenericRange(n.sons[1].typ).kind = tyChar then + a.res := ropef('[$1, 0]', [a.res]); + if skipVarGenericRange(n.sons[2].typ).kind = tyChar then + b.res := ropef('[$1, 0]', [b.res]); + r.res := ropef('($1.slice(0,-1)).concat($2)', [a.res, b.res]); +end; + +procedure genMagic(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; + line, filen: PRope; + op: TMagic; +begin + op := n.sons[0].sym.magic; + case op of + mOr: genOr(p, n.sons[1], n.sons[2], r); + mAnd: genAnd(p, n.sons[1], n.sons[2], r); + mAddi..mStrToStr: arith(p, n, r, op); + //mRepr: genRepr(p, n, r); + mSwap: genSwap(p, n, r); + mPred: begin // XXX: range checking? + if not (optOverflowCheck in p.Options) then + binaryExpr(p, n, r, '', '$1 - $2') + else + binaryExpr(p, n, r, 'subInt', 'subInt($1, $2)') + end; + mSucc: begin // XXX: range checking? + if not (optOverflowCheck in p.Options) then + binaryExpr(p, n, r, '', '$1 - $2') + else + binaryExpr(p, n, r, 'addInt', 'addInt($1, $2)') + end; + mAppendStrCh: binaryStmt(p, n, r, 'addChar', '$1 = addChar($1, $2)'); + mAppendStrStr: + binaryStmt(p, n, r, '', '$1 = ($1.slice(0,-1)).concat($2)'); + // XXX: make a copy of $2, because of EMCAScript's sucking semantics + mAppendSeqElem: binaryStmt(p, n, r, '', '$1.push($2)'); + mConStrStr: genConStrStr(p, n, r); + mEqStr: binaryExpr(p, n, r, 'eqStrings', 'eqStrings($1, $2)'); + mLeStr: binaryExpr(p, n, r, 'cmpStrings', '(cmpStrings($1, $2) <= 0)'); + mLtStr: binaryExpr(p, n, r, 'cmpStrings', '(cmpStrings($1, $2) < 0)'); + mIsNil: unaryExpr(p, n, r, '', '$1 == null'); + mAssert: begin + if (optAssert in p.Options) then begin + useMagic(p, 'internalAssert'); + gen(p, n.sons[1], a); + line := toRope(toLinenumber(n.info)); + filen := makeCString(ToFilename(n.info)); + appf(r.com, 'if (!($3)) internalAssert($1, $2)', + [filen, line, mergeExpr(a)]) + end + end; + mNew, mNewFinalize: genNew(p, n, r); + mSizeOf: r.res := toRope(getSize(n.sons[1].typ)); + mChr: gen(p, n.sons[1], r); // nothing to do + mOrd: genOrd(p, n, r); + mLengthStr: unaryExpr(p, n, r, '', '($1.length-1)'); + mLengthSeq, mLengthOpenArray, mLengthArray: + unaryExpr(p, n, r, '', '$1.length'); + mHigh: begin + if skipVarGeneric(n.sons[0].typ).kind = tyString then + unaryExpr(p, n, r, '', '($1.length-2)') + else + unaryExpr(p, n, r, '', '($1.length-1)'); + end; + mInc: begin + if not (optOverflowCheck in p.Options) then + binaryStmt(p, n, r, '', '$1 += $2') + else + binaryStmt(p, n, r, 'addInt', '$1 = addInt($1, $2)') + end; + ast.mDec: begin + if not (optOverflowCheck in p.Options) then + binaryStmt(p, n, r, '', '$1 -= $2') + else + binaryStmt(p, n, r, 'subInt', '$1 = subInt($1, $2)') + end; + mSetLengthStr: binaryStmt(p, n, r, '', '$1.length = ($2)-1'); + mSetLengthSeq: binaryStmt(p, n, r, '', '$1.length = $2'); + mCard: unaryExpr(p, n, r, 'SetCard', 'SetCard($1)'); + mLtSet: binaryExpr(p, n, r, 'SetLt', 'SetLt($1, $2)'); + mLeSet: binaryExpr(p, n, r, 'SetLe', 'SetLe($1, $2)'); + mEqSet: binaryExpr(p, n, r, 'SetEq', 'SetEq($1, $2)'); + mMulSet: binaryExpr(p, n, r, 'SetMul', 'SetMul($1, $2)'); + mPlusSet: binaryExpr(p, n, r, 'SetPlus', 'SetPlus($1, $2)'); + mMinusSet: binaryExpr(p, n, r, 'SetMinus', 'SetMinus($1, $2)'); + mIncl: binaryStmt(p, n, r, '', '$1[$2] = true'); + mExcl: binaryStmt(p, n, r, '', 'delete $1[$2]'); + mInSet: binaryExpr(p, n, r, '', '($1[$2] != undefined)'); + mNLen..mNError: + liMessage(n.info, errCannotGenerateCodeForX, n.sons[0].sym.name.s); + else genCall(p, n, r); + //else internalError(e.info, 'genMagic: ' + magicToStr[op]); + end +end; + +procedure genSetConstr(var p: TProc; n: PNode; var r: TCompRes); +var + a, b: TCompRes; + i: int; + it: PNode; +begin + useMagic(p, 'SetConstr'); + r.res := toRope('SetConstr('); + for i := 0 to sonsLen(n)-1 do begin + if i > 0 then app(r.res, ', '); + it := n.sons[i]; + if it.kind = nkRange then begin + gen(p, it.sons[0], a); + gen(p, it.sons[1], b); + r.com := mergeExpr(r.com, mergeExpr(a.com, b.com)); + appf(r.res, '[$1, $2]', [a.res, b.res]); + end + else begin + gen(p, it, a); + r.com := mergeExpr(r.com, a.com); + app(r.res, a.res); + end + end; + app(r.res, ')'+''); +end; + +procedure genArrayConstr(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; + i: int; +begin + r.res := toRope('['+''); + for i := 0 to sonsLen(n)-1 do begin + if i > 0 then app(r.res, ', '); + gen(p, n.sons[i], a); + r.com := mergeExpr(r.com, a.com); + app(r.res, a.res); + end; + app(r.res, ']'+''); +end; + +procedure genRecordConstr(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; + i, len: int; +begin + i := 0; + len := sonsLen(n); + r.res := toRope('{'+''); + while i < len do begin + if i > 0 then app(r.res, ', '); + if (n.sons[i].kind <> nkSym) then + internalError(n.sons[i].info, 'genRecordConstr'); + gen(p, n.sons[i+1], a); + r.com := mergeExpr(r.com, a.com); + appf(r.res, '$1: $2', [mangleName(n.sons[i].sym), a.res]); + inc(i, 2) + end +end; + +procedure genConv(var p: TProc; n: PNode; var r: TCompRes); +var + src, dest: PType; +begin + dest := skipVarGenericRange(n.typ); + src := skipVarGenericRange(n.sons[1].typ); + gen(p, n.sons[1], r); + if (dest.kind <> src.kind) and (src.kind = tyBool) then + r.res := ropef('(($1)? 1:0)', [r.res]) +end; + +procedure upConv(var p: TProc; n: PNode; var r: TCompRes); +begin + gen(p, n.sons[0], r); // XXX +end; + +procedure genRangeChck(var p: TProc; n: PNode; var r: TCompRes; + const magic: string); +var + a, b: TCompRes; +begin + gen(p, n.sons[0], r); + if optRangeCheck in p.options then begin + gen(p, n.sons[1], a); + gen(p, n.sons[2], b); + r.com := mergeExpr(r.com, mergeExpr(a.com, b.com)); + useMagic(p, 'chckRange'); + r.res := ropef('chckRange($1, $2, $3)', [r.res, a.res, b.res]); + end +end; + +procedure convStrToCStr(var p: TProc; n: PNode; var r: TCompRes); +begin + // we do an optimization here as this is likely to slow down + // much of the code otherwise: + if n.sons[0].kind = nkCStringToString then + gen(p, n.sons[0].sons[0], r) + else begin + gen(p, n.sons[0], r); + if r.res = nil then InternalError(n.info, 'convStrToCStr'); + useMagic(p, 'toEcmaStr'); + r.res := ropef('toEcmaStr($1)', [r.res]); + end; +end; + +procedure convCStrToStr(var p: TProc; n: PNode; var r: TCompRes); +begin + // we do an optimization here as this is likely to slow down + // much of the code otherwise: + if n.sons[0].kind = nkStringToCString then + gen(p, n.sons[0].sons[0], r) + else begin + gen(p, n.sons[0], r); + if r.res = nil then InternalError(n.info, 'convCStrToStr'); + useMagic(p, 'cstrToNimstr'); + r.res := ropef('cstrToNimstr($1)', [r.res]); + end; +end; + +procedure genReturnStmt(var p: TProc; n: PNode; var r: TCompRes); +var + a: TCompRes; +begin + if p.procDef = nil then InternalError(n.info, 'genReturnStmt'); + p.BeforeRetNeeded := true; + if (n.sons[0] <> nil) then begin + genStmt(p, n.sons[0], a); + if a.com <> nil then appf(r.com, '$1;$n', mergeStmt(a)); + end + else genLineDir(p, n, r); + finishTryStmt(p, r, p.nestedTryStmts); + app(r.com, 'break BeforeRet;' + tnl); +end; + +function genProcBody(var p: TProc; prc: PSym; const r: TCompRes): PRope; +begin + if optStackTrace in prc.options then begin + result := ropef( + 'var F = {procname: $1, prev: framePtr, filename: $2, line: 0};$n' + + 'framePtr = F;$n', + [makeCString(prc.owner.name.s +{&} '.' +{&} prc.name.s), + makeCString(toFilename(prc.info))]); + end + else + result := nil; + if p.beforeRetNeeded then + appf(result, 'BeforeRet: do {$n$1} while (false); $n', [mergeStmt(r)]) + else + app(result, mergeStmt(r)); + if prc.typ.callConv = ccSysCall then begin + result := ropef('try {$n$1} catch (e) {$n'+ + ' alert("Unhandled exception:\n" + e.message + "\n"$n}', + [result]); + end; + if optStackTrace in prc.options then + app(result, 'framePtr = framePtr.prev;' + tnl); +end; + +procedure genProc(var oldProc: TProc; n: PNode; var r: TCompRes); +var + p: TProc; + prc, resultSym: PSym; + name, returnStmt, resultAsgn, header: PRope; + a: TCompRes; +begin + prc := n.sons[namePos].sym; + initProc(p, oldProc.globals, oldProc.module, n, prc.options); + returnStmt := nil; + resultAsgn := nil; + name := mangleName(prc); + header := generateHeader(p, prc.typ); + if (prc.typ.sons[0] <> nil) and not (sfPure in prc.flags) then begin + resultSym := n.sons[resultPos].sym; + resultAsgn := ropef('var $1 = $2;$n', [mangleName(resultSym), + createVar(p, resultSym.typ, isIndirect(resultSym))]); + gen(p, n.sons[resultPos], a); + if a.com <> nil then appf(returnStmt, '$1;$n', [a.com]); + returnStmt := ropef('return $1;$n', [a.res]); + end; + genStmt(p, n.sons[codePos], r); + r.com := ropef('function $1($2) {$n$3$4$5}$n', + [name, header, resultAsgn, genProcBody(p, prc, r), returnStmt]); + r.res := nil; +end; + +procedure genStmtListExpr(var p: TProc; n: PNode; var r: TCompRes); +var + i: int; + a: TCompRes; +begin + // watch out this trick: ``function () { stmtList; return expr; }()`` + r.res := toRope('function () {'); + for i := 0 to sonsLen(n)-2 do begin + genStmt(p, n.sons[i], a); + app(r.res, mergeStmt(a)); + end; + gen(p, lastSon(n), a); + if a.com <> nil then appf(r.res, '$1;$n', [a.com]); + appf(r.res, 'return $1; }()', [a.res]); +end; + +procedure genStmt(var p: TProc; n: PNode; var r: TCompRes); +var + prc: PSym; + i: int; + a: TCompRes; +begin + r.kind := etyNone; + r.com := nil; + r.res := nil; + case n.kind of + nkNilLit: begin end; + nkStmtList: begin + for i := 0 to sonsLen(n)-1 do begin + genStmt(p, n.sons[i], a); + app(r.com, mergeStmt(a)); + end + end; + nkBlockStmt: genBlock(p, n, r); + nkIfStmt: genIfStmt(p, n, r); + nkWhileStmt: genWhileStmt(p, n, r); + nkVarSection: genVarStmt(p, n, r); + nkConstSection: genConstStmt(p, n, r); + nkForStmt: internalError(n.info, 'for statement not eliminated'); + nkCaseStmt: genCaseStmt(p, n, r); + nkReturnStmt: genReturnStmt(p, n, r); + nkBreakStmt: genBreakStmt(p, n, r); + nkAsgn: genAsgn(p, n, r); + nkDiscardStmt: begin + genLineDir(p, n, r); + gen(p, n.sons[0], r); + app(r.res, ';'+ tnl); + end; + nkAsmStmt: genAsmStmt(p, n, r); + nkTryStmt: genTryStmt(p, n, r); + nkRaiseStmt: genRaiseStmt(p, n, r); + nkTypeSection, nkCommentStmt, nkIteratorDef, + nkIncludeStmt, nkImportStmt, + nkFromStmt, nkTemplateDef, nkMacroDef, nkPragma: begin end; + nkProcDef, nkConverterDef: begin + if (n.sons[genericParamsPos] = nil) then begin + prc := n.sons[namePos].sym; + if (n.sons[codePos] <> nil) and not (lfNoDecl in prc.loc.flags) then + genProc(p, n, r) + else + {@discard} mangleName(prc); + end + end; + else begin + genLineDir(p, n, r); + gen(p, n, r); + app(r.res, ';'+ tnl); + end + end +end; + +procedure gen(var p: TProc; n: PNode; var r: TCompRes); +var + f: BiggestFloat; +begin + r.kind := etyNone; + r.com := nil; + r.res := nil; + case n.kind of + nkSym: genSym(p, n, r); + nkCharLit..nkInt64Lit: begin + r.res := toRope(n.intVal); + end; + nkNilLit: begin + if mapType(n.typ) = etyBaseIndex then begin + r.kind := etyBaseIndex; + r.com := toRope('null'); + r.res := toRope('0'+''); + end + else + r.res := toRope('null'); + end; + nkStrLit..nkTripleStrLit: begin + if skipVarGenericRange(n.typ).kind = tyString then begin + useMagic(p, 'cstrToNimstr'); + r.res := ropef('cstrToNimstr($1)', [makeCString(n.strVal)]) + end + else + r.res := makeCString(n.strVal) + end; + nkFloatLit..nkFloat64Lit: begin + f := n.floatVal; + if f <> f then + r.res := toRope('NaN') + else if f = 0.0 then + r.res := toRopeF(f) + else if f = 0.5 * f then + if f > 0.0 then r.res := toRope('Infinity') + else r.res := toRope('-Infinity') + else + r.res := toRopeF(f); + end; + nkBlockExpr: genBlock(p, n, r); + nkIfExpr: genIfExpr(p, n, r); + nkCall, nkHiddenCallConv: begin + if (n.sons[0].kind = nkSym) and (n.sons[0].sym.magic <> mNone) then + genMagic(p, n, r) + else + genCall(p, n, r) + end; + nkCurly: genSetConstr(p, n, r); + nkBracket: genArrayConstr(p, n, r); + nkPar: genRecordConstr(p, n, r); + nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, n, r); + nkAddr, nkHiddenAddr: genAddr(p, n, r); + nkDerefExpr, nkHiddenDeref: genDeref(p, n, r); + nkBracketExpr: genArrayAccess(p, n, r); + nkDotExpr: genFieldAccess(p, n, r); + nkCheckedFieldExpr: genCheckedFieldAccess(p, n, r); + nkObjDownConv: gen(p, n.sons[0], r); + nkObjUpConv: upConv(p, n, r); + nkChckRangeF: genRangeChck(p, n, r, 'chckRangeF'); + nkChckRange64: genRangeChck(p, n, r, 'chckRange64'); + nkChckRange: genRangeChck(p, n, r, 'chckRange'); + nkStringToCString: convStrToCStr(p, n, r); + nkCStringToString: convCStrToStr(p, n, r); + nkPassAsOpenArray: gen(p, n.sons[0], r); + nkStmtListExpr: genStmtListExpr(p, n, r); + else + InternalError(n.info, 'gen: unknown node type: ' + nodekindToStr[n.kind]) + end +end; + +// ------------------------------------------------------------------------ + +var + globals: PGlobals; + +function newModule(module: PSym; const filename: string): BModule; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit} + result.filename := filename; + result.module := module; + if globals = nil then globals := newGlobals(); +end; + +function genHeader(): PRope; +begin + result := ropef( + '/* Generated by the Nimrod Compiler v$1 */$n' + + '/* (c) 2008 Andreas Rumpf */$n$n' + + '$nvar Globals = this;$n' + + 'var framePtr = null;$n' + + 'var excHandler = null;$n', + [toRope(versionAsString)]) +end; + +procedure genModule(var p: TProc; n: PNode; var r: TCompRes); +begin + genStmt(p, n, r); + if optStackTrace in p.options then begin + r.com := ropef( + 'var F = {procname: $1, prev: framePtr, filename: $2, line: 0};$n' + + 'framePtr = F;$n' + + '$3' + + 'framePtr = framePtr.prev;$n', + [makeCString('module ' + p.module.module.name.s), + makeCString(toFilename(p.module.module.info)), r.com]) + end +end; + +procedure finishModule(b: PBackend; n: PNode); +var + m: BModule; + outfile: string; + p: TProc; + r: TCompRes; + code: PRope; +begin + m := BModule(b); + if m.module = nil then InternalError(n.info, 'finishModule'); + initProc(p, globals, m, nil, m.module.options); + genModule(p, n, r); + app(p.globals.code, p.data); + app(p.globals.code, mergeStmt(r)); + if sfMainModule in m.module.flags then begin + // write the file: + code := con(p.globals.typeInfo, p.globals.code); + outfile := changeFileExt(completeCFilePath(m.filename), 'js'); + {@discard} writeRopeIfNotEqual(con(genHeader(), code), outfile); + end; +end; + +function EcmasBackend(b: PBackend; module: PSym; + const filename: string): PBackend; +var + g: BModule; +begin + g := newModule(module, filename); + g.backendCreator := EcmasBackend; + g.eventMask := {@set}[eAfterModule]; + g.afterModuleEvent := finishModule; + result := g; +end; + +end. diff --git a/nim/eval.pas b/nim/eval.pas index 3f9d60b7a..501667c80 100644 --- a/nim/eval.pas +++ b/nim/eval.pas @@ -13,138 +13,293 @@ // stuff at compile time, performance is not that // important. Later a real interpreter may get out of this... +// We reuse the TTranscon type here:: +// +// TTransCon = record # part of TContext; stackable +// mapping: TIdNodeTable # mapping from symbols to nodes +// owner: PSym # current owner; proc that is evaluated +// forStmt: PNode # unused +// next: PTransCon # for stacking; up the call stack + +const + evalMaxIterations = 10000000; // max iterations of all loops + evalMaxRecDepth = 100000; // max recursion depth for evaluation + type - PBinding = ^TBinding; - TBinding = record - up: PBinding; // call stack - tab: TIdNodeTable; // maps syms to nodes - procname: PIdent; - info: TLineInfo; - end; + PBinding = PContext; + PCallStack = PTransCon; var emptyNode: PNode; + +function evalAux(c: PContext; n: PNode): PNode; forward; -procedure stackTraceAux(x: PBinding); +procedure stackTraceAux(x: PCallStack); begin if x <> nil then begin - stackTraceAux(x.up); - messageOut(format('$1 called at line $2 file $3', - [x.procname.s, toLinenumber(info), ToFilename(info)])); + stackTraceAux(x.next); + messageOut(format('file: $1, line: $2', [toFilename(x.forStmt.info), + toString(toLineNumber(x.forStmt.info))])); end end; procedure stackTrace(c: PBinding; n: PNode; msg: TMsgKind; const arg: string = ''); -var - x: PBinding; begin - x := c; - messageOut('stack trace: (most recent call last)') - stackTraceAux(c); + messageOut('stack trace: (most recent call last)'); + stackTraceAux(c.transCon); liMessage(n.info, msg, arg); end; -function eval(c: PBinding; n: PNode): PNode; forward; -// eval never returns nil! This simplifies the code a lot and -// makes it faster too. - -function evalSym(c: PBinding; sym: PSym): PNode; -// We need to return a node to the actual value, -// which can be modified. -var - x: PBinding; -begin - x := c; - while x <> nil do begin - result := IdNodeTableGet(x.tab, sym); - if result <> nil then exit; - x := x.up - end; - result := emptyNode; -end; - function evalIf(c: PBinding; n: PNode): PNode; var - i: int; - res: PNode; + i, len: int; begin i := 0; len := sonsLen(n); while (i < len) and (sonsLen(n.sons[i]) >= 2) do begin - res := eval(c, n.sons[i].sons[0]); - if (res.kind = nkIntLit) and (res.intVal <> 0) then begin - result := eval(c, n.sons[i].sons[1]); exit + result := evalAux(c, n.sons[i].sons[0]); + if result.kind = nkExceptBranch then exit; + if (result.kind = nkIntLit) and (result.intVal <> 0) then begin + result := evalAux(c, n.sons[i].sons[1]); + exit end; inc(i) end; if (i < len) and (sonsLen(n.sons[i]) < 2) then // eval else-part - result := eval(c, n.sons[0]) + result := evalAux(c, n.sons[0]) else result := emptyNode end; +function evalCase(c: PBinding; n: PNode): PNode; +var + i, j: int; + res: PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + res := result; + result := emptyNode; + for i := 1 to sonsLen(n)-1 do begin + if n.sons[i].kind = nkOfBranch then begin + for j := 0 to sonsLen(n.sons[i])-2 do begin + if overlap(res, n.sons[i].sons[j]) then begin + result := evalAux(c, lastSon(n.sons[i])); + exit + end + end + end + else begin + result := evalAux(c, lastSon(n.sons[i])); + end + end; +end; + var gWhileCounter: int; // Use a counter to prevend endless loops! // We make this counter global, because otherwise // nested loops could make the compiler extremely slow. + gNestedEvals: int; // count the recursive calls to ``evalAux`` to prevent + // endless recursion function evalWhile(c: PBinding; n: PNode): PNode; -var - res: PNode; begin - result := emptyNode; while true do begin - res := eval(c, n.sons[0]); - if getOrdValue(res) = 0 then break; - result := eval(c, n.sons[1]); - inc(gWhileCounter); - if gWhileCounter > 10000000 then begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + if getOrdValue(result) = 0 then break; + result := evalAux(c, n.sons[1]); + case result.kind of + nkBreakStmt: begin + if result.sons[0] = nil then begin + result := emptyNode; // consume ``break`` token + break + end + end; + nkExceptBranch, nkReturnToken: break; + else begin end + end; + dec(gWhileCounter); + if gWhileCounter <= 0 then begin stackTrace(c, n, errTooManyIterations); break; end end end; +function evalBlock(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkBreakStmt then begin + if result.sons[0] <> nil then begin + assert(result.sons[0].kind = nkSym); + if n.sons[0] <> nil then begin + assert(n.sons[0].kind = nkSym); + if result.sons[0].sym.id = n.sons[0].sym.id then + result := emptyNode + end + end + else + result := emptyNode // consume ``break`` token + end +end; + +function evalFinally(c: PBinding; n, exc: PNode): PNode; +var + finallyNode: PNode; +begin + finallyNode := lastSon(n); + if finallyNode.kind = nkFinally then begin + result := evalAux(c, finallyNode); + if result.kind <> nkExceptBranch then + result := exc + end + else + result := exc +end; + +function evalTry(c: PBinding; n: PNode): PNode; +var + exc: PNode; + i, j, len, blen: int; +begin + result := evalAux(c, n.sons[0]); + case result.kind of + nkBreakStmt, nkReturnToken: begin end; + nkExceptBranch: begin + // exception token! + exc := result; + i := 1; + len := sonsLen(n); + while (i < len) and (n.sons[i].kind = nkExceptBranch) do begin + blen := sonsLen(n.sons[i]); + if blen = 1 then begin + // general except section: + result := evalAux(c, n.sons[i].sons[0]); + exc := result; + break + end + else begin + for j := 0 to blen-2 do begin + assert(n.sons[i].sons[j].kind = nkType); + if exc.typ.id = n.sons[i].sons[j].typ.id then begin + result := evalAux(c, n.sons[i].sons[blen-1]); + exc := result; + break + end + end + end; + inc(i); + end; + result := evalFinally(c, n, exc); + end; + else + result := evalFinally(c, n, emptyNode); + end +end; + +function getNullValue(typ: PType; const info: TLineInfo): PNode; +var + i: int; + t: PType; +begin + t := skipGenericRange(typ); + result := emptyNode; + case t.kind of + tyBool, tyChar, tyInt..tyInt64: result := newNodeIT(nkIntLit, info, t); + tyFloat..tyFloat128: result := newNodeIt(nkFloatLit, info, t); + tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString: + result := newNodeIT(nkNilLit, info, t); + tyObject: begin + result := newNodeIT(nkPar, info, t); + internalError(info, 'init to implement'); + end; + tyArray, tyArrayConstr: begin + result := newNodeIT(nkBracket, info, t); + for i := 0 to int(lengthOrd(t))-1 do + addSon(result, getNullValue(elemType(t), info)); + end; + tyTuple: begin + result := newNodeIT(nkPar, info, t); + for i := 0 to sonsLen(t)-1 do + addSon(result, getNullValue(t.sons[i], info)); + end; + else InternalError('getNullValue') + end +end; + +function evalVar(c: PBinding; n: PNode): PNode; +var + i: int; + v: PSym; + a: PNode; +begin + for i := 0 to sonsLen(n)-1 do begin + a := n.sons[i]; + if a.kind = nkCommentStmt then continue; + assert(a.kind = nkIdentDefs); + assert(a.sons[0].kind = nkSym); + v := a.sons[0].sym; + if a.sons[2] <> nil then begin + result := evalAux(c, a.sons[2]); + if result.kind = nkExceptBranch then exit; + end + else + result := getNullValue(a.sons[0].typ, a.sons[0].info); + IdNodeTablePut(c.transCon.mapping, v, result); + end; + result := emptyNode; +end; + function evalCall(c: PBinding; n: PNode): PNode; var - d: PBinding; + d: PCallStack; prc: PNode; - op: PSym + i: int; begin - prc := eval(c, n.sons[0]); - assert(prc.kind = nkSym); - assert(prc.sym.kind in [skIterator, skProc, skConverter]); - op := prc.sym; + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + prc := result; // bind the actual params to the local parameter // of a new binding - d := newBinding(c, n.info); - for i := 0 to sonsLen(op.typ.n)-1 do - addSym(d.tab, op.typ.n.sons[i].sym, n.sons[i+1]); - result := eval(d, op.ast[codePos]); + d := newTransCon(); + d.forStmt := n; + if prc.kind = nkSym then begin + d.owner := prc.sym; + if not (prc.sym.kind in [skProc, skConverter]) then + InternalError(n.info, 'evalCall'); + end; + setLength(d.params, sonsLen(n)); + for i := 1 to sonsLen(n)-1 do begin + result := evalAux(c, n.sons[i]); + if result.kind = nkExceptBranch then exit; + d.params[i] := result; + end; + if n.typ <> nil then d.params[0] := getNullValue(n.typ, n.info); + pushTransCon(c, d); + result := evalAux(c, prc); + if n.typ <> nil then result := d.params[0]; + popTransCon(c); end; -function evalAsgn(c: PBinding; n: PNode): PNode; +function evalVariable(c: PCallStack; sym: PSym): PNode; +// We need to return a node to the actual value, +// which can be modified. var - x, y: PNode; + x: PCallStack; begin - x := eval(c, n.sons[0]); - y := eval(c, n.sons[1]); - if (x.kind <> y.kind) then - stackTrace(c, n, errInvalidAsgn) - else begin - case x.kind of - nkCharLit..nkInt64Lit: x.intVal := y.intVal; - nkFloatLit..nkFloat64Lit: x.floatVal := y.floatVal; - nkStrLit..nkTripleStrLit: x.strVal := y.strVal; - else begin - discardSons(x); - for i := 0 to sonsLen(y)-1 do - addSon(x, y.sons[i]); - end - end + x := c; + while x <> nil do begin + if sfResult in sym.flags then begin + result := x.params[0]; + exit + end; + result := IdNodeTableGet(x.mapping, sym); + if result <> nil then exit; + x := x.next end; - result := y + result := emptyNode; end; function evalArrayAccess(c: PBinding; n: PNode): PNode; @@ -152,140 +307,871 @@ var x: PNode; idx: biggestInt; begin - x := eval(c, n.sons[0]); - idx := getOrdValue(eval(c, n.sons[1])); + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + idx := getOrdValue(result); result := emptyNode; case x.kind of - nkArrayConstr, nkPar: begin + nkBracket, nkPar, nkMetaNode: begin if (idx >= 0) and (idx < sonsLen(x)) then - result := x.sons[indx] + result := x.sons[int(idx)] else - stackTrace(c, n, errInvalidIndex); + stackTrace(c, n, errIndexOutOfBounds); end; nkStrLit..nkTripleStrLit: begin - if (idx >= 0) and (idx < length(x.strLit)) then - result := newCharNode(x.strLit[indx+strStart]) - else if idx = length(x.strLit) then - result := newCharNode(#0) + result := newNodeIT(nkCharLit, x.info, getSysType(tyChar)); + if (idx >= 0) and (idx < length(x.strVal)) then + result.intVal := ord(x.strVal[int(idx)+strStart]) + else if idx = length(x.strVal) then begin end else - stackTrace(c, n, errInvalidIndex); - end + stackTrace(c, n, errIndexOutOfBounds); + end; else - stackTrace(c, n, errInvalidOp); + stackTrace(c, n, errIndexNoIntType); end end; function evalFieldAccess(c: PBinding; n: PNode): PNode; // a real field access; proc calls have already been // transformed +// XXX: field checks! var x: PNode; field: PSym; + i: int; begin - x := eval(c, n.sons[0]); + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + if x.kind <> nkPar then InternalError(n.info, 'evalFieldAccess'); field := n.sons[1].sym; - for i := 0 to sonsLen(n)-1 do + for i := 0 to sonsLen(n)-1 do begin + if x.sons[i].kind <> nkExprColonExpr then + InternalError(n.info, 'evalFieldAccess'); if x.sons[i].sons[0].sym.name.id = field.id then begin result := x.sons[i].sons[1]; exit + end + end; + stackTrace(c, n, errFieldXNotFound, field.name.s); + result := emptyNode; +end; + +function evalAsgn(c: PBinding; n: PNode): PNode; +var + x: PNode; + i: int; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + x.kind := result.kind; + x.typ := result.typ; + case x.kind of + nkCharLit..nkInt64Lit: x.intVal := result.intVal; + nkFloatLit..nkFloat64Lit: x.floatVal := result.floatVal; + nkStrLit..nkTripleStrLit: begin + x.strVal := result.strVal; + end + else begin + if not (x.kind in [nkEmpty..nkNilLit]) then begin + discardSons(x); + for i := 0 to sonsLen(result)-1 do addSon(x, result.sons[i]); + end + end + end; + result := emptyNode +end; + +function evalSwap(c: PBinding; n: PNode): PNode; +var + x: PNode; + i: int; + tmpi: biggestInt; + tmpf: biggestFloat; + tmps: string; + tmpn: PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if (x.kind <> result.kind) then + stackTrace(c, n, errCannotInterpretNodeX, nodeKindToStr[n.kind]) + else begin + case x.kind of + nkCharLit..nkInt64Lit: begin + tmpi := x.intVal; + x.intVal := result.intVal; + result.intVal := tmpi + end; + nkFloatLit..nkFloat64Lit: begin + tmpf := x.floatVal; + x.floatVal := result.floatVal; + result.floatVal := tmpf; + end; + nkStrLit..nkTripleStrLit: begin + tmps := x.strVal; + x.strVal := result.strVal; + result.strVal := tmps; + end + else begin + tmpn := copyTree(x); + discardSons(x); + for i := 0 to sonsLen(result)-1 do + addSon(x, result.sons[i]); + discardSons(result); + for i := 0 to sonsLen(tmpn)-1 do + addSon(result, tmpn.sons[i]); + end + end + end; + result := emptyNode +end; + +function evalSym(c: PBinding; n: PNode): PNode; +begin + case n.sym.kind of + skProc, skConverter, skMacro: result := n.sym.ast.sons[codePos]; + skVar, skForVar, skTemp: result := evalVariable(c.transCon, n.sym); + skParam: result := c.transCon.params[n.sym.position+1]; + skConst: result := n.sym.ast; + else begin + stackTrace(c, n, errCannotInterpretNodeX, symKindToStr[n.sym.kind]); + result := emptyNode + end + end; + if result = nil then InternalError(n.info, 'evalSym: ' + n.sym.name.s); +end; + +function evalIncDec(c: PBinding; n: PNode; sign: biggestInt): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + case a.kind of + nkCharLit..nkInt64Lit: a.intval := a.intVal + sign * getOrdValue(b); + else internalError(n.info, 'evalIncDec'); + end; + result := emptyNode +end; + +function evalExit(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + liMessage(n.info, hintQuitCalled); + halt(int(getOrdValue(result))); +end; + +function evalOr(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkIntLit then InternalError(n.info, 'evalOr'); + if result.intVal = 0 then result := evalAux(c, n.sons[2]) +end; + +function evalAnd(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkIntLit then InternalError(n.info, 'evalAnd'); + if result.intVal <> 0 then result := evalAux(c, n.sons[2]) +end; + +function evalNew(c: PBinding; n: PNode): PNode; +var + t: PType; +begin + t := skipVarGeneric(n.sons[1].typ); + result := newNodeIT(nkRefTy, n.info, t); + addSon(result, getNullValue(t.sons[0], n.info)); +end; + +function evalDeref(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkRefTy then InternalError(n.info, 'evalDeref'); + result := result.sons[0]; +end; + +function evalAddr(c: PBinding; n: PNode): PNode; +var + a: PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkRefTy then InternalError(n.info, 'evalDeref'); + a := result; + result := newNodeIT(nkRefTy, n.info, makePtrType(c, a.typ)); + addSon(result, a); +end; + +function evalConv(c: PBinding; n: PNode): PNode; +begin + // hm, I cannot think of any conversions that need to be handled here... + result := evalAux(c, n.sons[1]); + result.typ := n.typ; +end; + +function evalCheckedFieldAccess(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[0]); +end; + +function evalUpConv(c: PBinding; n: PNode): PNode; +var + dest, src: PType; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + dest := skipPtrsGeneric(n.typ); + src := skipPtrsGeneric(result.typ); + if inheritanceDiff(src, dest) > 0 then + stackTrace(c, n, errInvalidConversionFromTypeX, typeToString(src)); +end; + +function evalRangeChck(c: PBinding; n: PNode): PNode; +var + x, a, b: PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + + if leValueConv(a, x) and leValueConv(x, b) then begin + result := x; // a <= x and x <= b + result.typ := n.typ + end + else + stackTrace(c, n, errGenerated, + format(msgKindToString(errIllegalConvFromXtoY), + [typeToString(n.sons[0].typ), typeToString(n.typ)])); +end; + +function evalConvStrToCStr(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + result.typ := n.typ; +end; + +function evalConvCStrToStr(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + result.typ := n.typ; +end; + +function evalRaise(c: PBinding; n: PNode): PNode; +var + a: PNode; +begin + if n.sons[0] <> nil then begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkExceptBranch, n.info, a.typ); + addSon(result, a); + c.lastException := result; + end + else if c.lastException <> nil then + result := c.lastException + else begin + stackTrace(c, n, errExceptionAlreadyHandled); + result := newNodeIT(nkExceptBranch, n.info, nil); + addSon(result, nil); + end +end; + +function evalReturn(c: PBinding; n: PNode): PNode; +begin + if n.sons[0] <> nil then begin + result := evalAsgn(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + end; + result := newNodeIT(nkReturnToken, n.info, nil); +end; + +function evalProc(c: PBinding; n: PNode): PNode; +var + v: PSym; +begin + if n.sons[genericParamsPos] = nil then begin + if (resultPos < sonsLen(n)) and (n.sons[resultPos] <> nil) then begin + v := n.sons[resultPos].sym; + result := getNullValue(v.typ, n.info); + IdNodeTablePut(c.transCon.mapping, v, result); end; - stackTrace(c, n, errFieldNotFound, field.name.s); + result := evalAux(c, transform(c, n.sons[codePos])); + if result.kind = nkReturnToken then + result := IdNodeTableGet(c.transCon.mapping, v); + end + else + result := emptyNode +end; + +function evalHigh(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + case skipVarGeneric(n.sons[1].typ).kind of + tyOpenArray, tySequence: + result := newIntNodeT(sonsLen(result), n); + tyString: + result := newIntNodeT(length(result.strVal)-1, n); + else InternalError(n.info, 'evalHigh') + end +end; + +function evalSetLengthStr(c: PBinding; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + case a.kind of + nkStrLit..nkTripleStrLit: setLength(a.strVal, int(getOrdValue(b))); + else InternalError(n.info, 'evalSetLengthStr') + end; + result := emptyNode +end; + +function evalSetLengthSeq(c: PBinding; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + if a.kind = nkBracket then setLength(a.sons, int(getOrdValue(b))) + else InternalError(n.info, 'evalSetLengthSeq'); + result := emptyNode +end; + +function evalAssert(c: PBinding; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if getOrdValue(result) <> 0 then + result := emptyNode + else + stackTrace(c, n, errAssertionFailed) +end; + +function evalIncl(c: PBinding; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + if not inSet(a, b) then addSon(a, copyTree(b)); + result := emptyNode; +end; + +function evalExcl(c: PBinding; n: PNode): PNode; +var + a, b, r: PNode; + i: int; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := newNodeIT(nkCurly, n.info, n.sons[1].typ); + addSon(b, result); + r := diffSets(a, b); + discardSons(a); + for i := 0 to sonsLen(r)-1 do addSon(a, r.sons[i]); + result := emptyNode; +end; + +function evalAppendStrCh(c: PBinding; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + case a.kind of + nkStrLit..nkTripleStrLit: addChar(a.strVal, chr(int(getOrdValue(b)))); + else InternalError(n.info, 'evalAppendStrCh'); + end; + result := emptyNode; +end; + +function getStrValue(n: PNode): string; +begin + case n.kind of + nkStrLit..nkTripleStrLit: result := n.strVal; + else begin InternalError(n.info, 'getStrValue'); result := '' end; + end +end; + +function evalAppendStrStr(c: PBinding; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + case a.kind of + nkStrLit..nkTripleStrLit: a.strVal := a.strVal +{&} getStrValue(b); + else InternalError(n.info, 'evalAppendStrStr'); + end; + result := emptyNode; +end; + +function evalAppendSeqElem(c: PBinding; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + if a.kind = nkBracket then addSon(a, copyTree(b)) + else InternalError(n.info, 'evalAppendSeqElem'); result := emptyNode; end; -function eval(c: PBinding; n: PNode): PNode; +function evalAppendSeqSeq(c: PBinding; n: PNode): PNode; +var + a, b: PNode; + i: int; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + if a.kind = nkBracket then + for i := 0 to sonsLen(b)-1 do addSon(a, copyTree(b.sons[i])) + else InternalError(n.info, 'evalAppendSeqSeq'); + result := emptyNode; +end; + +function evalMagicOrCall(c: PBinding; n: PNode): PNode; var m: TMagic; - b: PNode; + a, b: PNode; + k: biggestInt; + i: int; +begin + m := getMagic(n); + case m of + mNone: result := evalCall(c, n); + mSizeOf: internalError(n.info, 'sizeof() should have been evaluated'); + mHigh: result := evalHigh(c, n); + mAssert: result := evalAssert(c, n); + mExit: result := evalExit(c, n); + mNew, mNewFinalize: result := evalNew(c, n); + mSwap: result := evalSwap(c, n); + mInc: result := evalIncDec(c, n, 1); + ast.mDec: result := evalIncDec(c, n, -1); + mSetLengthStr: result := evalSetLengthStr(c, n); + mSetLengthSeq: result := evalSetLengthSeq(c, n); + mIncl: result := evalIncl(c, n); + mExcl: result := evalExcl(c, n); + mAnd: result := evalAnd(c, n); + mOr: result := evalOr(c, n); + + mAppendStrCh: result := evalAppendStrCh(c, n); + mAppendStrStr: result := evalAppendStrStr(c, n); + mAppendSeqElem: result := evalAppendSeqElem(c, n); + mAppendSeqSeq: result := evalAppendSeqSeq(c, n); + + mNLen: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkIntLit, n.info, n.typ); + case a.kind of + nkEmpty..nkNilLit: begin end; + else result.intVal := sonsLen(a); + end + end; + mNChild: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + k := getOrdValue(result); + if (k >= 0) and (k < sonsLen(a)) + and not (a.kind in [nkEmpty..nkNilLit]) then + result := a.sons[int(k)] + else begin + stackTrace(c, n, errIndexOutOfBounds); + result := emptyNode + end; + end; + mNSetChild: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + result := evalAux(c, n.sons[3]); + if result.kind = nkExceptBranch then exit; + k := getOrdValue(b); + if (k >= 0) and (k < sonsLen(a)) + and not (a.kind in [nkEmpty..nkNilLit]) then + a.sons[int(k)] := result + else + stackTrace(c, n, errIndexOutOfBounds); + result := emptyNode; + end; + mNAdd: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + addSon(a, result); + result := emptyNode + end; + mNAddMultiple: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + for i := 0 to sonsLen(result)-1 do addSon(a, result.sons[i]); + result := emptyNode + end; + mNDel: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + result := evalAux(c, n.sons[3]); + if result.kind = nkExceptBranch then exit; + for i := 0 to int(getOrdValue(result))-1 do + delSon(a, int(getOrdValue(b))); + result := emptyNode; + end; + mNKind: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkIntLit, n.info, n.typ); + result.intVal := ord(a.kind); + end; + mNIntVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkIntLit, n.info, n.typ); + case a.kind of + nkCharLit..nkInt64Lit: result.intVal := a.intVal; + else InternalError(n.info, 'no int value') + end + end; + mNFloatVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkFloatLit, n.info, n.typ); + case a.kind of + nkFloatLit..nkFloat64Lit: result.floatVal := a.floatVal; + else InternalError(n.info, 'no float value') + end + end; + mNSymbol: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkSym then InternalError(n.info, 'no symbol') + end; + mNIdent: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkIdent then InternalError(n.info, 'no symbol') + end; + mNGetType: result := evalAux(c, n.sons[1]); + mNStrVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkStrLit, n.info, n.typ); + case a.kind of + nkStrLit..nkTripleStrLit: result.strVal := a.strVal; + else InternalError(n.info, 'no string value') + end + end; + mNSetIntVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.intVal := result.intVal; // XXX: exception handling? + result := emptyNode + end; + mNSetFloatVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.floatVal := result.floatVal; // XXX: exception handling? + result := emptyNode + end; + mNSetSymbol: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.sym := result.sym; // XXX: exception handling? + result := emptyNode + end; + mNSetIdent: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.ident := result.ident; // XXX: exception handling? + result := emptyNode + end; + mNSetType: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.typ := result.typ; // XXX: exception handling? + result := emptyNode + end; + mNSetStrVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.strVal := result.strVal; // XXX: exception handling? + result := emptyNode + end; + mNNewNimNode: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + k := getOrdValue(result); + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a := result; + if (k < 0) or (k > ord(high(TNodeKind))) then + internalError(n.info, 'request to create a NimNode with invalid kind'); + if a.kind = nkNilLit then + result := newNodeI(TNodeKind(int(k)), n.info) + else + result := newNodeI(TNodeKind(int(k)), a.info) + end; + mNCopyNimNode: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + result := copyNode(result); + end; + mNCopyNimTree: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + result := copyTree(result); + end; + mStrToIdent: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if not (result.kind in [nkStrLit..nkTripleStrLit]) then + InternalError(n.info, 'no string node'); + a := result; + result := newNodeIT(nkIdent, n.info, n.typ); + result.ident := getIdent(a.strVal); + end; + mIdentToStr: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkIdent then + InternalError(n.info, 'no ident node'); + a := result; + result := newNodeIT(nkStrLit, n.info, n.typ); + result.strVal := a.ident.s; + end; + mEqIdent: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + result := newNodeIT(nkIntLit, n.info, n.typ); + if (a.kind = nkIdent) and (b.kind = nkIdent) then + if a.ident.id = b.ident.id then result.intVal := 1 + end; + mNHint: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + liMessage(n.info, hintUser, getStrValue(result)); + result := emptyNode + end; + mNWarning: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + liMessage(n.info, warnUser, getStrValue(result)); + result := emptyNode + end; + mNError: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + liMessage(n.info, errUser, getStrValue(result)); + result := emptyNode + end; + else begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + if sonsLen(n) > 2 then begin + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + end + else + result := nil; + result := evalOp(m, n, a, result); + end + end +end; + +function evalAux(c: PContext; n: PNode): PNode; +var i: int; begin + result := emptyNode; + dec(gNestedEvals); + if gNestedEvals <= 0 then stackTrace(c, n, errTooManyIterations); case n.kind of // atoms: - nkEmpty: result := n; // do not produce further error messages! - nkSym: result := evalSym(c, n.sym); + nkEmpty: result := n; + nkSym: result := evalSym(c, n); nkType..pred(nkNilLit): result := copyNode(n); nkNilLit: result := n; // end of atoms - nkCall: begin - m := getMagic(n); - case m of - mNone: result := evalCall(b, n); - mSizeOf: internalError(n.info, 'sizeof() should have been evaluated'); - mHigh: begin end; - mLow: begin end; - else begin - if sonsLen(n) > 2 then b := eval(c, n.sons[2]) - else b := nil; - result := evalOp(m, n, eval(c, n.sons[1]), b); + nkCall, nkHiddenCallConv, nkMacroStmt: result := evalMagicOrCall(c, n); + nkCurly, nkBracket: begin + result := copyNode(n); + for i := 0 to sonsLen(n)-1 do addSon(result, evalAux(c, n.sons[i])); + end; + nkPar: begin + result := copyTree(n); + for i := 0 to sonsLen(n)-1 do + result.sons[i].sons[1] := evalAux(c, n.sons[i].sons[1]); + end; + nkBracketExpr: result := evalArrayAccess(c, n); + nkDotExpr: result := evalFieldAccess(c, n); + nkDerefExpr, nkHiddenDeref: result := evalDeref(c, n); + nkAddr, nkHiddenAddr: result := evalAddr(c, n); + nkHiddenStdConv, nkHiddenSubConv, nkConv: result := evalConv(c, n); + nkAsgn: result := evalAsgn(c, n); + nkWhenStmt, nkIfStmt, nkIfExpr: result := evalIf(c, n); + nkWhileStmt: result := evalWhile(c, n); + nkCaseStmt: result := evalCase(c, n); + nkVarSection: result := evalVar(c, n); + nkTryStmt: result := evalTry(c, n); + nkRaiseStmt: result := evalRaise(c, n); + nkReturnStmt: result := evalReturn(c, n); + nkBreakStmt, nkReturnToken: result := n; + nkBlockExpr, nkBlockStmt: result := evalBlock(c, n); + nkDiscardStmt: result := evalAux(c, n.sons[0]); + nkCheckedFieldExpr: result := evalCheckedFieldAccess(c, n); + nkObjDownConv: result := evalAux(c, n.sons[0]); + nkObjUpConv: result := evalUpConv(c, n); + nkChckRangeF, nkChckRange64, nkChckRange: result := evalRangeChck(c, n); + nkStringToCString: result := evalConvStrToCStr(c, n); + nkCStringToString: result := evalConvCStrToStr(c, n); + nkPassAsOpenArray: result := evalAux(c, n.sons[0]); + + nkStmtListExpr, nkStmtList, nkModule: begin + for i := 0 to sonsLen(n)-1 do begin + result := evalAux(c, n.sons[i]); + case result.kind of + nkExceptBranch, nkReturnToken, nkBreakStmt: break; + else begin end end end end; - nkIdentDefs: begin end; + nkProcDef, nkMacroDef, nkCommentStmt: begin end; + nkIdentDefs, nkCast, nkYieldStmt, nkAsmStmt, nkForStmt, nkPragmaExpr, + nkQualified, nkLambda, nkContinueStmt: + stackTrace(c, n, errCannotInterpretNodeX, nodeKindToStr[n.kind]); + else InternalError(n.info, 'evalAux: ' + nodekindToStr[n.kind]); + end; + if result = nil then + InternalError(n.info, 'evalAux: returned nil ' + nodekindToStr[n.kind]); + inc(gNestedEvals); +end; - nkPar: begin - // tuple constructor, already in the right format - result := copyTree(n) - end; - nkCurly, nkBracket: result := copyTree(n); - nkBracketExpr:begin end; - nkPragmaExpr:begin end; - nkRange:begin end; - nkDotExpr:begin end; - nkDerefExpr:begin end; - nkIfExpr:begin end; - nkElifExpr:begin end; - nkElseExpr:begin end; - nkLambda:begin end; - - nkSetConstr:begin end; - nkConstSetConstr:begin end; - nkArrayConstr:begin end; - nkConstArrayConstr:begin end; - nkRecordConstr:begin end; - nkConstRecordConstr:begin end; - nkTableConstr:begin end; - nkConstTableConstr:begin end; - nkQualified:begin end; - nkImplicitConv, nkConv: result := evalConv(c, n); - nkCast: result := evalCast(c, n); // this is hard! - nkAsgn: result := evalAsgn(c, n); - nkDefaultTypeParam:begin end; - nkGenericParams:begin end; - nkFormalParams:begin end; - nkOfInherit:begin end; - nkOfBranch: begin end; - nkElifBranch: begin end; - nkExceptBranch: begin end; - nkElse: begin end; - nkMacroStmt: begin end; - nkAsmStmt: begin end; - nkPragma: begin end; - nkIfStmt: begin end; - nkWhenStmt: begin end; - nkForStmt: begin end; - nkWhileStmt: begin end; - nkCaseStmt: begin end; - nkVarSection: begin end; - nkConstSection, nkConstDef, nkTypeDef, nkTypeSection, nkProcDef, - nkConverterDef, nkMacroDef, nkTemplateDef, nkIteratorDef: - result := emptyNode; - nkYieldStmt: begin end; - nkTryStmt: begin end; - nkFinally: begin end; - nkRaiseStmt: begin end; - nkReturnStmt: begin end; - nkBreakStmt: begin end; - nkContinueStmt: begin end; - nkBlockStmt: begin end; - nkDiscardStmt: begin end; - nkStmtList, nkModule: begin - for i := 0 to sonsLen(n)-1 do - result := eval(c, n.sons[i]); - end; - //nkImportStmt: begin end; - //nkFromStmt: begin end; - //nkImportAs: begin end; - //nkIncludeStmt: begin end; - nkCommentStmt: result := emptyNode; // do nothing - else - stackTrace(c, n, errCannotInterpretNode); - end +function eval(c: PContext; n: PNode): PNode; +begin + gWhileCounter := evalMaxIterations; + gNestedEvals := evalMaxRecDepth; + result := evalAux(c, transform(c, n)); + if result.kind = nkExceptBranch then + stackTrace(c, n, errUnhandledExceptionX, typeToString(result.typ)); +end; + +function semMacroExpr(c: PContext; n: PNode; sym: PSym): PNode; +var + p: PTransCon; +begin + p := newTransCon(); + p.forStmt := n; + setLength(p.params, 2); + p.params[0] := newNodeIT(nkNilLit, n.info, sym.typ.sons[0]); + p.params[1] := n; + pushTransCon(c, p); + {@discard} eval(c, sym.ast.sons[codePos]); + result := p.params[0]; + popTransCon(c); + if cyclicTree(result) then liMessage(n.info, errCyclicTree); + result := semStmt(c, result); + // now, that was easy ... + // and we get more flexibility than in any other programming language end; diff --git a/nim/extccomp.pas b/nim/extccomp.pas index 0fc24f8d3..a6d8cc147 100644 --- a/nim/extccomp.pas +++ b/nim/extccomp.pas @@ -15,10 +15,12 @@ interface {$include 'config.inc'} uses - nimconf, msgs; // some things are read in from the configuration file + nsystem, nimconf, msgs; + +// some things are read in from the configuration file type - TSystemCC = (ccNone, ccGcc, ccLLVM_Gcc, ccLcc, ccBcc, ccDmc, ccWcc, ccVcc, + TSystemCC = (ccNone, ccGcc, ccLLVM_Gcc, ccLcc, ccBcc, ccDmc, ccWcc, ccVcc, ccTcc, ccPcc, ccUcc, ccIcc, ccGpp); TInfoCCProp = ( // properties of the C compiler: @@ -27,15 +29,17 @@ type hasCpp // CC is/contains a C++ compiler ); TInfoCCProps = set of TInfoCCProp; - TInfoCC = record + TInfoCC = record{@tuple} name: string; // the short name of the compiler objExt: string; // the compiler's object file extenstion optSpeed: string; // the options for optimization for speed optSize: string; // the options for optimization for size - compile: string; // the compile command template + compilerExe: string; // the compiler's executable + compileTmpl: string; // the compile command template buildGui: string; // command to build a GUI application buildDll: string; // command to build a shared library - link: string; // command to link files to produce an executable + linkerExe: string; // the linker's executable + linkTmpl: string; // command to link files to produce an executable includeCmd: string; // command to add an include directory path debug: string; // flags for debug build pic: string; // command for position independent code @@ -50,10 +54,12 @@ const objExt: 'o'+''; optSpeed: ' -O3 -ffast-math '; optSize: ' -Os -ffast-math '; - compile: 'gcc -c $options $include -o $objfile $file'; + compilerExe: 'gcc'; + compileTmpl: '-c $options $include -o $objfile $file'; buildGui: ' -mwindows'; buildDll: ' -mdll'; - link: 'gcc $options $buildgui $builddll -o $exefile $objfiles'; + linkerExe: 'gcc'; + linkTmpl: '$options $buildgui $builddll -o $exefile $objfiles'; includeCmd: ' -I'; debug: ''; pic: '-fPIC'; @@ -65,10 +71,12 @@ const objExt: 'o'+''; optSpeed: ' -O3 -ffast-math '; optSize: ' -Os -ffast-math '; - compile: 'llvm-gcc -c $options $include -o $objfile $file'; + compilerExe: 'llvm-gcc'; + compileTmpl: '-c $options $include -o $objfile $file'; buildGui: ' -mwindows'; buildDll: ' -mdll'; - link: 'llvm-gcc $options $buildgui $builddll -o $exefile $objfiles'; + linkerExe: 'llvm-gcc'; + linkTmpl: '$options $buildgui $builddll -o $exefile $objfiles'; includeCmd: ' -I'; debug: ''; pic: '-fPIC'; @@ -80,10 +88,12 @@ const objExt: 'obj'; optSpeed: ' -O -p6 '; optSize: ' -O -p6 '; - compile: 'lcc -e1 $options $include -Fo$objfile $file'; + compilerExe: 'lcc'; + compileTmpl: '-e1 $options $include -Fo$objfile $file'; buildGui: ' -subsystem windows'; buildDll: ' -dll'; - link: 'lcclnk $options $buildgui $builddll -O $exefile $objfiles'; + linkerExe: 'lcclnk'; + linkTmpl: '$options $buildgui $builddll -O $exefile $objfiles'; includeCmd: ' -I'; debug: ' -g5 '; pic: ''; @@ -95,10 +105,12 @@ const objExt: 'obj'; optSpeed: ' -O2 -6 '; optSize: ' -O1 -6 '; - compile: 'bcc32 -c $options $include -o$objfile $file'; + compilerExe: 'bcc32'; + compileTmpl: '-c $options $include -o$objfile $file'; buildGui: ' -tW'; buildDll: ' -tWD'; - link: 'bcc32 $options $buildgui $builddll -e$exefile $objfiles'; + linkerExe: 'bcc32'; + linkTmpl: '$options $buildgui $builddll -e$exefile $objfiles'; includeCmd: ' -I'; debug: ''; pic: ''; @@ -110,14 +122,16 @@ const objExt: 'obj'; optSpeed: ' -ff -o -6 '; optSize: ' -ff -o -6 '; - compile: 'dmc -c $options $include -o$objfile $file'; + compilerExe: 'dmc'; + compileTmpl: '-c $options $include -o$objfile $file'; buildGui: ' -L/exet:nt/su:windows'; buildDll: ' -WD'; - link: 'dmc $options $buildgui $builddll -o$exefile $objfiles'; + linkerExe: 'dmc'; + linkTmpl: '$options $buildgui $builddll -o$exefile $objfiles'; includeCmd: ' -I'; debug: ' -g '; pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; + asmStmtFrmt: '__asm{$n$1$n}$n'; props: {@set}[hasCpp]; ), ( @@ -125,14 +139,16 @@ const objExt: 'obj'; optSpeed: ' -ox -on -6 -d0 -fp6 -zW '; optSize: ''; - compile: 'wcl386 -c $options $include -fo=$objfile $file'; + compilerExe: 'wcl386'; + compileTmpl: '-c $options $include -fo=$objfile $file'; buildGui: ' -bw'; buildDll: ' -bd'; - link: 'wcl386 $options $buildgui $builddll -fe=$exefile $objfiles '; + linkerExe: 'wcl386'; + linkTmpl: '$options $buildgui $builddll -fe=$exefile $objfiles '; includeCmd: ' -i='; debug: ' -d2 '; pic: ''; - asmStmtFrmt: '__asm{$n$1$n}$n'; + asmStmtFrmt: '__asm{$n$1$n}$n'; props: {@set}[hasCpp]; ), ( @@ -140,10 +156,12 @@ const objExt: 'obj'; optSpeed: ' /Ogityb2 /G7 /arch:SSE2 '; optSize: ' /O1 /G7 '; - compile: 'cl /c $options $include /Fo$objfile $file'; + compilerExe: 'cl'; + compileTmpl: '/c $options $include /Fo$objfile $file'; buildGui: ' /link /SUBSYSTEM:WINDOWS '; buildDll: ' /LD'; - link: 'cl $options $builddll /Fe$exefile $objfiles $buildgui'; + linkerExe: 'cl'; + linkTmpl: '$options $builddll /Fe$exefile $objfiles $buildgui'; includeCmd: ' /I'; debug: ' /GZ /Zi '; pic: ''; @@ -155,10 +173,12 @@ const objExt: 'o'+''; optSpeed: ''; optSize: ''; - compile: 'tcc -c $options $include -o $objfile $file'; + compilerExe: 'tcc'; + compileTmpl: '-c $options $include -o $objfile $file'; buildGui: 'UNAVAILABLE!'; buildDll: ' -shared'; - link: 'tcc -o $exefile $options $buildgui $builddll $objfiles'; + linkerExe: 'tcc'; + linkTmpl: '-o $exefile $options $buildgui $builddll $objfiles'; includeCmd: ' -I'; debug: ' -g '; pic: ''; @@ -170,10 +190,12 @@ const objExt: 'obj'; optSpeed: ' -Ox '; optSize: ' -Os '; - compile: 'cc -c $options $include -Fo$objfile $file'; + compilerExe: 'cc'; + compileTmpl: '-c $options $include -Fo$objfile $file'; buildGui: ' -SUBSYSTEM:WINDOWS'; buildDll: ' -DLL'; - link: 'cc $options $buildgui $builddll -OUT:$exefile $objfiles'; + linkerExe: 'cc'; + linkTmpl: '$options $buildgui $builddll -OUT:$exefile $objfiles'; includeCmd: ' -I'; debug: ' -Zi '; pic: ''; @@ -185,10 +207,12 @@ const objExt: 'o'+''; optSpeed: ' -O3 '; optSize: ' -O1 '; - compile: 'cc -c $options $include -o $objfile $file'; + compilerExe: 'cc'; + compileTmpl: '-c $options $include -o $objfile $file'; buildGui: ''; buildDll: ' -shared '; - link: 'cc -o $exefile $options $buildgui $builddll $objfiles'; + linkerExe: 'cc'; + linkTmpl: '-o $exefile $options $buildgui $builddll $objfiles'; includeCmd: ' -I'; debug: ''; pic: ''; @@ -199,10 +223,12 @@ const objExt: 'o'+''; optSpeed: ' -O3 '; optSize: ' -Os '; - compile: 'icc -c $options $include -o $objfile $file'; + compilerExe: 'icc'; + compileTmpl: '-c $options $include -o $objfile $file'; buildGui: ' -mwindows'; buildDll: ' -mdll'; - link: 'icc $options $buildgui $builddll -o $exefile $objfiles'; + linkerExe: 'icc'; + linkTmpl: '$options $buildgui $builddll -o $exefile $objfiles'; includeCmd: ' -I'; debug: ''; pic: '-fPIC'; @@ -213,10 +239,12 @@ const objExt: 'o'+''; optSpeed: ' -O3 -ffast-math '; optSize: ' -Os -ffast-math '; - compile: 'g++ -c $options $include -o $objfile $file'; + compilerExe: 'g++'; + compileTmpl: '-c $options $include -o $objfile $file'; buildGui: ' -mwindows'; buildDll: ' -mdll'; - link: 'g++ $options $buildgui $builddll -o $exefile $objfiles'; + linkerExe: 'g++'; + linkTmpl: '$options $buildgui $builddll -o $exefile $objfiles'; includeCmd: ' -I'; debug: ' -g '; pic: '-fPIC'; @@ -238,6 +266,9 @@ var function completeCFilePath(const cfile: string; createSubDir: Boolean = true): string; +function getCompileCFileCmd(const cfilename: string; + isExternal: bool = false): string; + procedure addFileToCompile(const filename: string); procedure addExternalFileToCompile(const filename: string); procedure addFileToLink(const filename: string); @@ -260,7 +291,7 @@ procedure setCC(const ccname: string); implementation uses - nsystem, charsets, + charsets, lists, options, ropes, nos, strutils, platform, condsyms; var @@ -389,16 +420,13 @@ begin result := cc[c].optSize // use default settings from this file end; -procedure CompileCFile(const list: TLinkedList; - var script: PRope; isExternal: Boolean); +function getCompileCFileCmd(const cfilename: string; + isExternal: bool = false): string; var - it: PStrEntry; - compileCmd, cfile, objfile, options, includeCmd, compilePattern: string; + cfile, objfile, options, includeCmd, compilePattern: string; c: TSystemCC; // an alias to ccompiler begin c := ccompiler; - it := PStrEntry(list.head); - options := compileOptions; if optCDebug in gGlobalOptions then addStr(options, ' ' + getDebug(c)); if optOptimizeSpeed in gOptions then addStr(options, ' ' + getOptSpeed(c)) @@ -413,31 +441,43 @@ begin includeCmd := cc[c].includeCmd; // this is more complex than needed, but // a workaround of a FPC bug... addStr(includeCmd, libpath); - compilePattern := JoinPath(ccompilerpath, cc[c].compile); + compilePattern := quoteIfSpaceExists( + JoinPath(ccompilerpath, cc[c].compilerExe)); end else begin includeCmd := ''; - compilePattern := cc[c].compile + compilePattern := cc[c].compilerExe end; + if targetOS = hostOS then + cfile := cfilename + else + cfile := extractFileName(cfilename); + + if not isExternal or (targetOS <> hostOS) then + objfile := toObjFile(cfile) + else + objfile := completeCFilePath(toObjFile(cfile)); + + result := compilePattern +{&} ' ' +{&} format(cc[c].compileTmpl, + ['file', AppendFileExt(cfile, cExt), + 'objfile', objfile, + 'options', options, + 'include', includeCmd, + 'nimrod', getPrefixDir(), + 'lib', libpath + ]); +end; +procedure CompileCFile(const list: TLinkedList; + var script: PRope; isExternal: Boolean); +var + it: PStrEntry; + compileCmd: string; +begin + it := PStrEntry(list.head); while it <> nil do begin // call the C compiler for the .c file: - if targetOS = hostOS then - cfile := it.data - else - cfile := extractFileName(it.data); - - if not isExternal or (targetOS <> hostOS) then - objfile := toObjFile(cfile) - else - objfile := completeCFilePath(toObjFile(cfile)); - - compileCmd := format(compilePattern, - ['file', AppendFileExt(cfile, cExt), - 'objfile', objfile, - 'options', options, - 'include', includeCmd - ]); + compileCmd := getCompileCFileCmd(it.data, isExternal); if not (optCompileOnly in gGlobalOptions) then execExternalProgram(compileCmd); if (optGenScript in gGlobalOptions) then begin @@ -469,9 +509,9 @@ begin if not (optNoLinking in gGlobalOptions) then begin // call the linker: if (hostOS <> targetOS) then - linkCmd := cc[c].link + linkCmd := cc[c].linkerExe else - linkCmd := JoinPath(ccompilerpath, cc[c].link); + linkCmd := quoteIfSpaceExists(JoinPath(ccompilerpath, cc[c].linkerExe)); if optGenDynLib in gGlobalOptions then buildDll := cc[c].buildDll @@ -506,12 +546,14 @@ begin it := PStrEntry(it.next); end; - linkCmd := format(linkCmd, [ + linkCmd := linkCmd +{&} ' ' +{&} format(cc[c].linkTmpl, [ 'builddll', builddll, 'buildgui', buildgui, 'options', linkOptions, 'objfiles', objfiles, - 'exefile', exefile + 'exefile', exefile, + 'nimrod', getPrefixDir(), + 'lib', libpath ]); if not (optCompileOnly in gGlobalOptions) then execExternalProgram(linkCmd); diff --git a/nim/genhelp.pas b/nim/genhelp.pas deleted file mode 100644 index 382a0b8bf..000000000 --- a/nim/genhelp.pas +++ /dev/null @@ -1,175 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit genhelp; - -// This module contains some helper routines used by the different -// code generators. - -interface - -{$include 'config.inc'} - -uses - nsystem, - ast, astalgo, trees, msgs, options, platform; - -function hasSideEffect(t: PNode): Boolean; - -function ReturnsNewThing(op: PNode): Boolean; - - -function containsGarbageCollectedRef(typ: PType): Boolean; -// returns true if typ contains a reference, sequence or string (all the things -// that are garbage-collected) - -function containsHiddenPointer(typ: PType): Boolean; -// returns true if typ contains a string, table or sequence (all the things -// that need to be copied deeply) - -function containsObject(typ: PType): Boolean; -// Returns true if typ contains an object type directly; then it has to -// be initialized in a complex way that sets up the typeid field. - -function isGarbageCollected(typ: PType): Boolean; - -function pointerOf(typ: PType): PType; - -implementation - -function pointerOf(typ: PType): PType; -begin - result := newType(unknownLineInfo, tyPtr); - result.baseType := typ; - result.align := platform.PtrSize; - result.size := platform.PtrSize; -end; - -function isGarbageCollected(typ: PType): Boolean; -begin - result := typ.Kind in [tyTable, tyRef, tySequence, tyString] -end; - -function ReturnsNewThing(op: PNode): Boolean; -var - s: PSym; -begin - result := false; - if op.kind = nkCall then begin - if op.sons[0].kind = nkSym then begin - s := op.sons[0].sym; - result := (sfReturnsNew in s.flags) - end - end - else if op.typ.Kind = tyArrayConstr then - result := true // array constructor returns a newly allocated thing -end; - -function containsHiddenPointer(typ: PType): Boolean; -var - t: PType; - i: int; -begin - t := typ; - result := false; - if t = nil then exit; - case t.Kind of - tySequence, tyString, tyTable: result := true; - tyArray, tyArrayConstr, tyOpenArray: - result := containsHiddenPointer(t.baseType); - tySubtype: result := containsHiddenPointer(typ.baseType); - tyRecord, tyObject: begin - if (t.baseType <> nil) and containsHiddenPointer(t.baseType) then - result := true - else - // walk through all fields: - for i := 0 to seqTableLen(t.symList)-1 do - if containsHiddenPointer(seqTableAt(t.symList, i).typ) then begin - result := true; break - end; - end - else result := false - end -end; - -function containsGarbageCollectedRef(typ: PType): Boolean; -var - t: PType; - i: int; -begin - t := typ; - result := false; - if t = nil then exit; - case t.Kind of - tySequence, tyRef, tyString, tyTable: result := true; - tyArray: result := containsGarbageCollectedRef(t.baseType); - tyRecord, tyObject: begin - if (t.baseType <> nil) and containsGarbageCollectedRef(t.baseType) then - result := true - else - // walk through all fields: - for i := 0 to seqTableLen(t.symList)-1 do - if containsGarbageCollectedRef(SeqTableAt(t.symList, i).typ) then - begin - result := true; break - end; - end - else result := false - end -end; - -function containsObject(typ: PType): Boolean; -var - t: PType; - i: int; -begin - t := typ; - result := false; - if t = nil then exit; - case t.Kind of - tyArray, tyArrayConstr: - result := containsObject(t.baseType); - tyObject: result := true; - tySubtype: result := containsObject(typ.baseType); - tyRecord: begin - // walk through all fields: - for i := 0 to seqTableLen(t.symList)-1 do - if containsObject(SeqTableAt(t.symList, i).typ) then begin - result := true; break - end; - end - else result := false - end -end; - -function hasSideEffect(t: PNode): Boolean; -{var - it: PNode; } -begin - result := t.kind in [nkCall, nkArrayConstr, nkRecordConstr, nkSetConstr] - // assume side effect for operations - { - if t.Kind = nkOperation then begin - // this is for function pointers: - if hasSideEffect(t.left) then begin - result := true; exit - end; - it := t.right; - while it <> nil do begin - if hasSideEffect(it) then begin - result := true; exit - end; - it := it.next - end; - result := true - end; - result := false } -end; - -end. diff --git a/nim/hashes.pas b/nim/hashes.pas index 80acc57ca..059a42998 100644 --- a/nim/hashes.pas +++ b/nim/hashes.pas @@ -60,7 +60,9 @@ type function nextPowerOfTwo(x: int): int; begin result := x -{%} 1; - result := result or (result shr 32); + // complicated, to make it a nop if sizeof(int) == 4, + // because shifting more than 31 bits is undefined in C + result := result or (result shr ((sizeof(int)-4)* 32)); result := result or (result shr 16); result := result or (result shr 8); result := result or (result shr 4); @@ -115,7 +117,7 @@ var h: TUnsignedHash; i: int; begin - h := 0; + h := 0; i := 0; while str[i] <> #0 do begin h := h +{%} ord(str[i]); @@ -134,7 +136,7 @@ var h: TUnsignedHash; i: int; begin - h := 0; + h := 0; for i := 1 to Length(s) do begin h := h +{%} ord(s[i]); h := h +{%} h shl 10; @@ -152,7 +154,7 @@ var c: Char; i: int; begin - h := 0; + h := 0; for i := strStart to length(s)+strStart-1 do begin c := s[i]; if c = '_' then continue; // skip _ @@ -173,7 +175,7 @@ var c: Char; i: int; begin - h := 0; + h := 0; for i := strStart to length(s)+strStart-1 do begin c := s[i]; if c in ['A'..'Z'] then c := chr(ord(c) + (ord('a')-ord('A'))); // toLower() @@ -194,7 +196,7 @@ var i: int; begin h := 0; - i := 0; + i := 0; while str[i] <> #0 do begin c := str[i]; if c in ['A'..'Z'] then c := chr(ord(c) + (ord('a')-ord('A'))); // toLower() diff --git a/nim/highlite.pas b/nim/highlite.pas index ee115b815..8547d9904 100644 --- a/nim/highlite.pas +++ b/nim/highlite.pas @@ -17,7 +17,7 @@ interface {$include 'config.inc'} uses - charsets, nsystem, sysutils, hashes, options, msgs, strutils, platform, + charsets, nsystem, sysutils, hashes, options, msgs, strutils, platform, idents, lexbase, wordrecg, scanner; type @@ -42,14 +42,14 @@ type gtLongComment, gtRegularExpression, gtTagStart, - gtTagEnd, + gtTagEnd, gtKey, gtValue, gtRawData, gtAssembler, gtPreprocessor, gtDirective, - gtCommand, + gtCommand, gtRule, gtHyperlink, gtLabel, @@ -65,7 +65,7 @@ type state: TTokenClass; end; TSourceLanguage = ( - langNone, + langNone, langNimrod, langCpp, langCsharp, @@ -97,14 +97,14 @@ const 'LongComment', 'RegularExpression', 'TagStart', - 'TagEnd', + 'TagEnd', 'Key', 'Value', 'RawData', 'Assembler', 'Preprocessor', 'Directive', - 'Command', + 'Command', 'Rule', 'Hyperlink', 'Label', @@ -114,7 +114,7 @@ const function getSourceLanguage(const name: string): TSourceLanguage; -procedure initGeneralTokenizer(var g: TGeneralTokenizer; +procedure initGeneralTokenizer(var g: TGeneralTokenizer; const buf: string); procedure deinitGeneralTokenizer(var g: TGeneralTokenizer); procedure getNextToken(var g: TGeneralTokenizer; lang: TSourceLanguage); @@ -125,18 +125,23 @@ function getSourceLanguage(const name: string): TSourceLanguage; var i: TSourceLanguage; begin - for i := succ(low(TSourceLanguage)) to high(TSourceLanguage) do + for i := succ(low(TSourceLanguage)) to high(TSourceLanguage) do if cmpIgnoreStyle(name, sourceLanguageToStr[i]) = 0 then begin result := i; exit end; result := langNone end; -procedure initGeneralTokenizer(var g: TGeneralTokenizer; +procedure initGeneralTokenizer(var g: TGeneralTokenizer; const buf: string); begin {@ignore} fillChar(g, sizeof(g), 0); {@emit} g.buf := PChar(buf); + g.kind := low(TTokenClass); + g.start := 0; + g.len := 0; + g.pos := 0; + g.state := low(TTokenClass); end; procedure deinitGeneralTokenizer(var g: TGeneralTokenizer); @@ -221,7 +226,7 @@ begin '\': begin g.kind := gtEscapeSequence; inc(pos); - case g.buf[pos] of + case g.buf[pos] of 'x', 'X': begin inc(pos); if g.buf[pos] in hexChars then inc(pos); @@ -243,8 +248,8 @@ begin end end end - else begin - case g.buf[pos] of + else begin + case g.buf[pos] of ' ', #9..#13: begin g.kind := gtWhitespace; while g.buf[pos] in [' ', #9..#13] do inc(pos); @@ -284,10 +289,10 @@ begin end; 'o', 'O': begin inc(pos); - while g.buf[pos] in octChars do inc(pos); + while g.buf[pos] in octChars do inc(pos); pos := nimNumberPostfix(g, pos); end; - else + else pos := nimNumber(g, pos); end end; @@ -315,7 +320,7 @@ begin case g.buf[pos] of #0: break; '"': begin - inc(pos); + inc(pos); if (g.buf[pos] = '"') and (g.buf[pos+1] = '"') then begin inc(pos, 2); break @@ -411,7 +416,7 @@ begin end end; else if g.buf[pos] = c then begin - inc(pos); break; + inc(pos); break; end else inc(pos); @@ -468,7 +473,7 @@ type TTokenizerFlag = (hasPreprocessor, hasNestedComments); TTokenizerFlags = set of TTokenizerFlag; -procedure clikeNextToken(var g: TGeneralTokenizer; +procedure clikeNextToken(var g: TGeneralTokenizer; const keywords: array of string; flags: TTokenizerFlags); const @@ -489,7 +494,7 @@ begin '\': begin g.kind := gtEscapeSequence; inc(pos); - case g.buf[pos] of + case g.buf[pos] of 'x', 'X': begin inc(pos); if g.buf[pos] in hexChars then inc(pos); @@ -511,8 +516,8 @@ begin end end end - else begin - case g.buf[pos] of + else begin + case g.buf[pos] of ' ', #9..#13: begin g.kind := gtWhitespace; while g.buf[pos] in [' ', #9..#13] do inc(pos); @@ -583,7 +588,7 @@ begin end; '0'..'7': begin inc(pos); - while g.buf[pos] in octChars do inc(pos); + while g.buf[pos] in octChars do inc(pos); if g.buf[pos] in ['A'..'Z', 'a'..'z'] then inc(pos); end; else begin @@ -635,13 +640,13 @@ end; // -------------------------------------------------------------------------- procedure cNextToken(var g: TGeneralTokenizer); -const +const keywords: array [0..36] of string = ( '_Bool', '_Complex', '_Imaginary', - 'auto', 'break', 'case', 'char', 'const', 'continue', 'default', 'do', - 'double', 'else', 'enum', 'extern', 'float', 'for', 'goto', 'if', - 'inline', 'int', 'long', 'register', 'restrict', 'return', 'short', - 'signed', 'sizeof', 'static', 'struct', 'switch', 'typedef', 'union', + 'auto', 'break', 'case', 'char', 'const', 'continue', 'default', 'do', + 'double', 'else', 'enum', 'extern', 'float', 'for', 'goto', 'if', + 'inline', 'int', 'long', 'register', 'restrict', 'return', 'short', + 'signed', 'sizeof', 'static', 'struct', 'switch', 'typedef', 'union', 'unsigned', 'void', 'volatile', 'while' ); begin @@ -649,12 +654,12 @@ begin end; procedure cppNextToken(var g: TGeneralTokenizer); -const +const keywords: array [0..47] of string = ( 'asm', 'auto', 'break', 'case', 'catch', 'char', 'class', 'const', 'continue', 'default', 'delete', 'do', 'double', 'else', 'enum', 'extern', 'float', 'for', 'friend', 'goto', 'if', 'inline', 'int', 'long', 'new', - 'operator', 'private', 'protected', 'public', 'register', 'return', + 'operator', 'private', 'protected', 'public', 'register', 'return', 'short', 'signed', 'sizeof', 'static', 'struct', 'switch', 'template', 'this', 'throw', 'try', 'typedef', 'union', 'unsigned', 'virtual', 'void', 'volatile', 'while' @@ -664,33 +669,33 @@ begin end; procedure csharpNextToken(var g: TGeneralTokenizer); -const +const keywords: array [0..76] of string = ( - 'abstract', 'as', 'base', 'bool', 'break', 'byte', 'case', 'catch', - 'char', 'checked', 'class', 'const', 'continue', 'decimal', 'default', - 'delegate', 'do', 'double', 'else', 'enum', 'event', 'explicit', 'extern', - 'false', 'finally', 'fixed', 'float', 'for', 'foreach', 'goto', 'if', - 'implicit', 'in', 'int', 'interface', 'internal', 'is', 'lock', 'long', - 'namespace', 'new', 'null', 'object', 'operator', 'out', 'override', - 'params', 'private', 'protected', 'public', 'readonly', 'ref', 'return', - 'sbyte', 'sealed', 'short', 'sizeof', 'stackalloc', 'static', 'string', - 'struct', 'switch', 'this', 'throw', 'true', 'try', 'typeof', 'uint', - 'ulong', 'unchecked', 'unsafe', 'ushort', 'using', 'virtual', 'void', - 'volatile', 'while' + 'abstract', 'as', 'base', 'bool', 'break', 'byte', 'case', 'catch', + 'char', 'checked', 'class', 'const', 'continue', 'decimal', 'default', + 'delegate', 'do', 'double', 'else', 'enum', 'event', 'explicit', 'extern', + 'false', 'finally', 'fixed', 'float', 'for', 'foreach', 'goto', 'if', + 'implicit', 'in', 'int', 'interface', 'internal', 'is', 'lock', 'long', + 'namespace', 'new', 'null', 'object', 'operator', 'out', 'override', + 'params', 'private', 'protected', 'public', 'readonly', 'ref', 'return', + 'sbyte', 'sealed', 'short', 'sizeof', 'stackalloc', 'static', 'string', + 'struct', 'switch', 'this', 'throw', 'true', 'try', 'typeof', 'uint', + 'ulong', 'unchecked', 'unsafe', 'ushort', 'using', 'virtual', 'void', + 'volatile', 'while' ); begin clikeNextToken(g, keywords, {@set}[hasPreprocessor]); end; procedure javaNextToken(var g: TGeneralTokenizer); -const +const keywords: array [0..52] of string = ( - 'abstract', 'assert', 'boolean', 'break', 'byte', 'case', 'catch', - 'char', 'class', 'const', 'continue', 'default', 'do', 'double', 'else', - 'enum', 'extends', 'false', 'final', 'finally', 'float', 'for', 'goto', - 'if', 'implements', 'import', 'instanceof', 'int', 'interface', 'long', - 'native', 'new', 'null', 'package', 'private', 'protected', 'public', - 'return', 'short', 'static', 'strictfp', 'super', 'switch', + 'abstract', 'assert', 'boolean', 'break', 'byte', 'case', 'catch', + 'char', 'class', 'const', 'continue', 'default', 'do', 'double', 'else', + 'enum', 'extends', 'false', 'final', 'finally', 'float', 'for', 'goto', + 'if', 'implements', 'import', 'instanceof', 'int', 'interface', 'long', + 'native', 'new', 'null', 'package', 'private', 'protected', 'public', + 'return', 'short', 'static', 'strictfp', 'super', 'switch', 'synchronized', 'this', 'throw', 'throws', 'transient', 'true', 'try', 'void', 'volatile', 'while' ); @@ -700,7 +705,7 @@ end; procedure getNextToken(var g: TGeneralTokenizer; lang: TSourceLanguage); begin - case lang of + case lang of langNimrod: nimNextToken(g); langCpp: cppNextToken(g); langCsharp: csharpNextToken(g); diff --git a/nim/importer.pas b/nim/importer.pas index 5377434fe..0658783a3 100644 --- a/nim/importer.pas +++ b/nim/importer.pas @@ -40,10 +40,11 @@ procedure rawImportSymbol(c: PContext; s: PSym); var check, copy, e: PSym; j: int; - etyp: PType; // enumeration type + etyp: PType; // enumeration type begin - copy := copySym(s, s.owner); - copy.ast := s.ast; // BUGFIX + //copy := copySym(s, true); + //copy.ast := s.ast; + copy := s; // do not copy symbols when importing! // check if we have already a symbol of the same name: check := StrTableGet(c.tab.stack[importTablePos], s.name); if check <> nil then begin @@ -55,17 +56,17 @@ begin end; StrTableAdd(c.tab.stack[importTablePos], copy); if s.kind = skType then begin - // types are special: we need to copy types but need to - // consider private fields etyp := s.typ; if etyp.kind = tyEnum then begin for j := 0 to sonsLen(etyp.n)-1 do begin e := etyp.n.sons[j].sym; - assert(e.Kind = skEnumField); - rawImportSymbol(c, e) + if (e.Kind = skEnumField) then rawImportSymbol(c, e) + else InternalError(s.info, 'rawImportSymbol'); end end - end; + end + else if s.kind = skConverter then + addConverter(c, s); end; procedure importSymbol(c: PContext; ident: PNode; fromMod: PSym); @@ -73,18 +74,20 @@ var s, e: PSym; it: TIdentIter; begin - assert(ident.kind = nkIdent); + if (ident.kind <> nkIdent) then InternalError(ident.info, 'importSymbol'); s := StrTableGet(fromMod.tab, ident.ident); if s = nil then liMessage(ident.info, errUndeclaredIdentifier, ident.ident.s); - assert(s.Kind in ExportableSymKinds); + if not (s.Kind in ExportableSymKinds) then + InternalError(ident.info, 'importSymbol: 2'); // for an enumeration we have to add all identifiers case s.Kind of - skProc, skIterator, skMacro, skTemplate: begin - // for a overloadable syms add all overloaded routines + skProc, skIterator, skMacro, skTemplate, skConverter: begin + // for a overloadable syms add all overloaded routines e := InitIdentIter(it, fromMod.tab, s.name); while e <> nil do begin - assert(e.name.id = s.Name.id); + if (e.name.id <> s.Name.id) then + InternalError(ident.info, 'importSymbol: 3'); rawImportSymbol(c, e); e := NextIdentIter(it, fromMod.tab); end @@ -101,8 +104,11 @@ begin s := InitTabIter(i, fromMod.tab); while s <> nil do begin if s.kind <> skModule then begin - assert(s.Kind in ExportableSymKinds); - rawImportSymbol(c, s); // this is correct! + if s.kind <> skEnumField then begin + if not (s.Kind in ExportableSymKinds) then + InternalError(s.info, 'importAllSymbols'); + rawImportSymbol(c, s); // this is correct! + end end; s := NextIter(i, fromMod.tab) end @@ -129,6 +135,7 @@ var i: int; begin result := n; + checkMinSonsLen(n, 2); m := c.ImportModule(getModuleFile(n.sons[0]), c.b); n.sons[0] := newSymNode(m); addDecl(c, m); // add symbol to symbol table of module @@ -140,7 +147,7 @@ var i: int; x: PNode; begin - result := newNode(nkStmtList); + result := newNodeI(nkStmtList, n.info); for i := 0 to sonsLen(n)-1 do begin x := c.includeFile(getModuleFile(n.sons[i])); x := semStmt(c, x); diff --git a/nim/instgen.pas b/nim/instgen.pas index 2d5abc8b2..e64034f9e 100644 --- a/nim/instgen.pas +++ b/nim/instgen.pas @@ -21,11 +21,12 @@ type newOwner: PSym; instantiator: TLineInfo; end; - PInstClosure = ^TInstantiateClosure; + PInstantiateClosure = ^TInstantiateClosure; + PInstClosure = PInstantiateClosure; -function instantiateTree(var c: TInstantiateClosure; t: PNode): PNode; forward; - -function instantiateSym(var c: TInstantiateClosure; sym: PSym): PSym; forward; +function instantiateTree(c: PInstantiateClosure; t: PNode): PNode; forward; +function instantiateSym(c: PInstantiateClosure; sym: PSym): PSym; forward; +function instantiateType(c: PInstantiateClosure; typ: PType): PType; forward; function containsGenericTypeIter(t: PType; closure: PObject): bool; begin @@ -37,35 +38,58 @@ begin result := iterOverType(t, containsGenericTypeIter, nil); end; +function instTypeNode(c: PInstantiateClosure; n: PNode): PNode; +var + i: int; +begin + result := nil; + if n <> nil then begin + result := copyNode(n); + result.typ := instantiateType(c, n.typ); + case n.kind of + nkNone..nkNilLit: begin // a leaf + end; + else begin + for i := 0 to sonsLen(n)-1 do + addSon(result, instTypeNode(c, n.sons[i])); + end + end + end +end; -function instantiateTypeMutator(typ: PType; c: PObject): PType; +function instantiateType(c: PInstantiateClosure; typ: PType): PType; +var + i: int; begin - result := PType(idTableGet(PInstClosure(c).mapping, typ)); + result := PType(idTableGet(c.mapping, typ)); if result <> nil then exit; if containsGenericType(typ) then begin - result := copyType(typ, PInstClosure(c).newOwner); - idTablePut(PInstClosure(c).mapping, typ, result) + result := copyType(typ, c.newOwner); + idTablePut(c.mapping, typ, result); // to avoid cycles + for i := 0 to sonsLen(result)-1 do + result.sons[i] := instantiateType(c, result.sons[i]); + if result.n <> nil then + result.n := instTypeNode(c, result.n); end else result := typ; if result.Kind in GenericTypes then begin - liMessage(PInstClosure(c).instantiator, errCannotInstantiateX, + liMessage(c.instantiator, errCannotInstantiateX, TypeToString(typ, preferName)); + end + else if result.kind = tyVar then begin + if result.sons[0].kind = tyVar then + liMessage(c.instantiator, errVarVarTypeNotAllowed); end; end; -function instantiateType(var c: TInstantiateClosure; typ: PType): PType; -begin - result := mutateType(typ, instantiateTypeMutator, {@cast}PObject(addr(c))); -end; - -function instantiateSym(var c: TInstantiateClosure; sym: PSym): PSym; +function instantiateSym(c: PInstantiateClosure; sym: PSym): PSym; begin if sym = nil then begin result := nil; exit end; // BUGFIX result := PSym(idTableGet(c.mapping, sym)); if (result = nil) then begin if (sym.owner.id = c.fn.id) or (sym.id = c.fn.id) then begin - result := copySym(sym, nil); + result := copySym(sym); if sym.id = c.fn.id then c.newOwner := result; include(result.flags, sfIsCopy); idTablePut(c.mapping, sym, result); // BUGFIX @@ -83,7 +107,7 @@ begin end end; -function instantiateTree(var c: TInstantiateClosure; t: PNode): PNode; +function instantiateTree(c: PInstantiateClosure; t: PNode): PNode; var len, i: int; begin @@ -124,7 +148,8 @@ begin q := n.sons[i].sym; s := newSym(skType, q.name, getCurrOwner(c)); t := PType(IdTableGet(pt, q.typ)); - if t = nil then liMessage(n.sons[i].info, errCannotInstantiateX, s.name.s); + if t = nil then + liMessage(n.sons[i].info, errCannotInstantiateX, s.name.s); assert(t.kind <> tyGenericParam); s.typ := t; addDecl(c, s); @@ -138,7 +163,8 @@ var begin result := nil; for i := 0 to sonsLen(c.generics)-1 do begin - assert(c.generics.sons[i].kind = nkExprEqExpr); + 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; @@ -173,8 +199,8 @@ var n: PNode; begin oldP := c.p; // restore later - result := copySym(fn, getCurrOwner(c)); - result.id := getId(); + result := copySym(fn); + result.owner := getCurrOwner(c); n := copyTree(fn.ast); result.ast := n; pushOwner(c, result); @@ -202,7 +228,7 @@ begin addDecl(c, result); if n.sons[codePos] <> nil then begin c.p := newProcCon(result); - if result.kind = skProc then begin + if result.kind in [skProc, skConverter] then begin addResult(c, result.typ.sons[0], n.info); addResultNode(c, n); end; @@ -221,8 +247,12 @@ end; function generateTypeInstance(p: PContext; const pt: TIdTable; const instantiator: TLineInfo; t: PType): PType; var - c: TInstantiateClosure; + c: PInstantiateClosure; begin + new(c); +{@ignore} + fillChar(c^, sizeof(c^), 0); +{@emit} c.mapping := pt; // making a copy is not necessary c.fn := nil; c.instantiator := instantiator; diff --git a/nim/lexbase.pas b/nim/lexbase.pas index f02c375ff..c840dc6d2 100644 --- a/nim/lexbase.pas +++ b/nim/lexbase.pas @@ -227,7 +227,7 @@ begin L.linenumber := 1; // lines start at 1 L.fileOpened := false; if L.bufLen > 0 then begin - copyMem(L.buf, addr(buffer[strStart]), L.bufLen); + copyMem(L.buf, {@cast}pointer(buffer), L.bufLen); L.buf[L.bufLen-1] := EndOfFile; end else diff --git a/nim/lookup.pas b/nim/lookup.pas index 143967f3e..192dba7ca 100644 --- a/nim/lookup.pas +++ b/nim/lookup.pas @@ -12,8 +12,7 @@ function getSymRepr(s: PSym): string; begin case s.kind of - skProc, skConverter, skIterator: - result := getProcHeader(s); + skProc, skConverter, skIterator: result := getProcHeader(s); else result := s.name.s end end; @@ -24,7 +23,7 @@ var s: PSym; begin // check if all symbols have been used and defined: - assert(tab.tos <= length(tab.stack)); + if (tab.tos > length(tab.stack)) then InternalError('CloseScope'); s := InitTabIter(it, tab.stack[tab.tos-1]); while s <> nil do begin if sfForward in s.flags then @@ -59,7 +58,8 @@ procedure addOverloadableSymAt(c: PContext; fn: PSym; at: Natural); var check: PSym; begin - assert(fn.kind in OverloadableSyms); + if not (fn.kind in OverloadableSyms) then + InternalError(fn.info, 'addOverloadableSymAt'); check := StrTableGet(c.tab.stack[at], fn.name); if (check <> nil) and (check.Kind <> fn.kind) then liMessage(fn.info, errAttemptToRedefine, fn.Name.s); @@ -70,7 +70,7 @@ procedure AddInterfaceDeclAux(c: PContext; sym: PSym); begin if (sfInInterface in sym.flags) then begin // add to interface: - assert(c.module <> nil); + if c.module = nil then InternalError(sym.info, 'AddInterfaceDeclAux'); StrTableAdd(c.module.tab, sym); end; if getCurrOwner(c).kind = skModule then @@ -92,12 +92,21 @@ end; function lookUp(c: PContext; n: PNode): PSym; // Looks up a symbol. Generates an error in case of nil. begin - if n.kind = nkAccQuoted then result := lookup(c, n.sons[0]) - else begin - assert(n.kind = nkIdent); - result := SymtabGet(c.Tab, n.ident); - if result = nil then liMessage(n.info, errUndeclaredIdentifier, n.ident.s); - include(result.flags, sfUsed); + case n.kind of + nkAccQuoted: result := lookup(c, n.sons[0]); + nkSym: begin + result := SymtabGet(c.Tab, n.sym.name); + if result = nil then + liMessage(n.info, errUndeclaredIdentifier, n.sym.name.s); + include(result.flags, sfUsed); + end; + nkIdent: begin + result := SymtabGet(c.Tab, n.ident); + if result = nil then + liMessage(n.info, errUndeclaredIdentifier, n.ident.s); + include(result.flags, sfUsed); + end + else InternalError(n.info, 'lookUp'); end end; @@ -115,6 +124,14 @@ begin and StrTableContains(c.AmbigiousSymbols, result) then liMessage(n.info, errUseQualifier, n.ident.s) end; + nkSym: begin + result := SymtabGet(c.Tab, n.sym.name); + if result = nil then + liMessage(n.info, errUndeclaredIdentifier, n.sym.name.s) + else if ambigiousCheck + and StrTableContains(c.AmbigiousSymbols, result) then + liMessage(n.info, errUseQualifier, n.sym.name.s) + end; nkDotExpr, nkQualified: begin result := nil; m := qualifiedLookUp(c, n.sons[0], false); @@ -165,6 +182,15 @@ begin result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], n.ident); end; end; + nkSym: begin + o.stackPtr := c.tab.tos; + o.mode := oimNoQualifier; + while (result = nil) do begin + dec(o.stackPtr); + if o.stackPtr < 0 then break; + result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], n.sym.name); + end; + end; nkDotExpr, nkQualified: begin o.mode := oimOtherModule; o.m := qualifiedLookUp(c, n.sons[0], false); @@ -199,7 +225,8 @@ begin while (result = nil) do begin dec(o.stackPtr); if o.stackPtr < 0 then break; - result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], n.ident); + result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], o.it.name); + // BUGFIX: o.it.name <-> n.ident end end else result := nil; diff --git a/nim/main.pas b/nim/main.pas index 8ea82ced3..6e0afda98 100644 --- a/nim/main.pas +++ b/nim/main.pas @@ -17,7 +17,8 @@ interface uses nsystem, strutils, ast, astalgo, scanner, pnimsyn, rnimsyn, options, msgs, nos, lists, condsyms, paslex, pasparse, rodgen, ropes, trees, - wordrecg, sem, idents, magicsys, backends, docgen, extccomp, cgen; + wordrecg, sem, idents, magicsys, backends, docgen, extccomp, cgen, + platform, ecmasgen; procedure MainCommand(const cmd, filename: string); @@ -109,7 +110,9 @@ begin // compile the module // XXX: here caching could be implemented result := compileModule(filename, backend, false, false); - end; + end + else if sfSystemModule in result.flags then + liMessage(result.info, errAttemptToRedefine, result.Name.s); end; function CompileModule(const filename: string; backend: PBackend; @@ -131,8 +134,8 @@ begin openScope(c.tab); // scope for imported symbols SymTabAdd(c.tab, result); if not isSystemFile then begin - importAllSymbols(c, magicsys.SystemModule); SymTabAdd(c.tab, magicsys.SystemModule); // import the "System" identifier + importAllSymbols(c, magicsys.SystemModule); SymTabAdd(c.tab, newIsMainModuleSym(result, isMainFile)); end else begin @@ -142,7 +145,6 @@ begin end; {@discard} semModule(c, ast); rawCloseScope(c.tab); // imported symbols; don't check for unused ones! - // XXX: compile the generated generic procs! msgCompiled(result.name.s); end; @@ -161,8 +163,8 @@ var procedure addDependencyAux(importing, imported: PSym); begin - appRopeFormat(gDotGraph, '$1 -> $2;$n', [toRope(importing.name.s), - toRope(imported.name.s)]); + appf(gDotGraph, '$1 -> $2;$n', [toRope(importing.name.s), + toRope(imported.name.s)]); // s1 -> s2_4 [label="[0-9]"]; end; @@ -193,7 +195,7 @@ end; procedure generateDot(const project: string); begin writeRope( - ropeFormat('digraph $1 {$n$2}$n', [ + ropef('digraph $1 {$n$2}$n', [ toRope(changeFileExt(extractFileName(project), '')), gDotGraph]), changeFileExt(project, 'dot') ); end; @@ -257,13 +259,21 @@ begin extccomp.CallCCompiler(changeFileExt(filename, '')); end; +procedure CommandCompileToEcmaScript(const filename: string); +begin + include(gGlobalOptions, optSafeCode); + setTarget(osEcmaScript, cpuEcmaScript); + initDefines(); + compileProject(filename, EcmasBackend(nil, nil, filename)); +end; + // -------------------------------------------------------------------------- procedure exSymbols(n: PNode); var i: int; begin - case n.kind of + case n.kind of nkEmpty..nkNilLit: begin end; // atoms nkProcDef..nkIteratorDef: begin exSymbol(n.sons[namePos]); @@ -279,7 +289,7 @@ begin for i := 0 to sonsLen(n)-1 do begin exSymbol(n.sons[i].sons[0]); if (n.sons[i].sons[2] <> nil) and - (n.sons[i].sons[2].kind in [nkRecordTy, nkObjectTy]) then + (n.sons[i].sons[2].kind = nkObjectTy) then fixRecordDef(n.sons[i].sons[2]) end end; @@ -406,6 +416,11 @@ begin wantFile(filename); CommandCompileToC(filename); end; + wCompileToEcmaScript: begin + gCmd := cmdCompileToEcmaScript; + wantFile(filename); + CommandCompileToEcmaScript(filename); + end; wPretty: begin // compile means compileToC currently gCmd := cmdPretty; diff --git a/nim/msgs.pas b/nim/msgs.pas index 6f4f8225e..8112b8df7 100644 --- a/nim/msgs.pas +++ b/nim/msgs.pas @@ -74,10 +74,6 @@ type errTokenExpected, errStringAfterIncludeExpected, errRecursiveInclude, - errAtIfExpected, - errAtIfExpectedBeforeElse, - errAtIfExpectedBeforeElif, - errAtEndExpected, errOnOrOffExpected, errNoneSpeedOrSizeExpected, errInvalidPragma, @@ -186,7 +182,7 @@ type errSizeTooBig, errSetTooBig, errBaseTypeMustBeOrdinal, - errInheritanceOnlyWithObjects, + errInheritanceOnlyWithNonFinalObjects, errInheritanceOnlyWithEnums, errIllegalRecursionInTypeX, errCannotInstantiateX, @@ -267,6 +263,20 @@ type errWhitespaceExpected, errXisNoValidIndexFile, errCannotRenderX, + errVarVarTypeNotAllowed, + errIsExpectsTwoArguments, + errIsExpectsObjectTypes, + errXcanNeverBeOfThisSubtype, + errTooManyIterations, + errCannotInterpretNodeX, + errFieldXNotFound, + errInvalidConversionFromTypeX, + errAssertionFailed, + errCannotGenerateCodeForX, + errXNeedsReturnType, + errXRequiresOneArgument, + errUnhandledExceptionX, + errCyclicTree, errUser, warnCannotOpenFile, warnOctalEscape, @@ -291,6 +301,8 @@ type hintMo2FileInvalid, hintModuleHasChanged, hintCannotOpenMo2File, + hintQuitCalled, + hintProcessing, hintUser); const @@ -310,7 +322,7 @@ const 'invalid token: $1', 'line too long', '$1 is not a valid number', - '$1 is too large or too small', + 'number $1 out of valid range', '\n not allowed in character literal', 'closing '']'' expected, but end of file reached', 'missing final ''', @@ -319,10 +331,6 @@ const '''$1'' expected', 'string after ''include'' expected', 'recursive include file: ''$1''', - '''@if'' expected', - '''@if'' expected before ''@else''', - '''@if'' expected before ''@elif''', - '''@end'' expected', '''on'' or ''off'' expected', '''none'', ''speed'' or ''size'' expected', 'invalid pragma', @@ -431,12 +439,12 @@ const 'computing the type''s size produced an overflow', 'set is too large', 'base type of a set must be an ordinal', - 'inheritance only works with an object', + 'inheritance only works non-final objects', 'inheritance only works with an enum', 'illegal recursion in type ''$1''', 'cannot instantiate: ''$1''', 'expression has no address', - 'to an out parameter a variable needs to be passed', + 'for a ''var'' type a variable needs to be passed', 'type mismatch', 'type mismatch: got (', 'but expected one of: ', @@ -512,6 +520,20 @@ const 'whitespace expected, got ''$1''', '''$1'' is no valid index file', 'cannot render reStructuredText element ''$1''', + 'type ''var var'' is not allowed', + '''is'' expects two arguments', + '''is'' expects object types', + '''$1'' can never be of this subtype', + 'interpretation requires too many iterations', + 'cannot interpret node kind ''$1''', + 'field ''$1'' cannot be found', + 'invalid conversion from type ''$1''', + 'assertion failed', + 'cannot generate code for ''$1''', + 'converter needs return type', + 'converter requires one parameter', + 'unhandled exception: $1', + 'macro returned a cyclic abstract syntax tree', '$1', 'cannot open ''$1'' [CannotOpenFile]', 'octal escape sequences do not exist; leading zero is ignored [OctalEscape]', @@ -536,6 +558,8 @@ const 'mo2 file ''$1'' is invalid [Mo2FileInvalid]', 'module ''$1'' has been changed [ModuleHasChanged]', 'mo2 file ''$1'' does not exist [CannotOpenMo2File]', + 'quit() called [QuitCalled]', + 'processing [Processing]', '$1 [User]' ); const @@ -556,7 +580,7 @@ const 'User' ); const - HintsToStr: array [0..9] of string = ( + HintsToStr: array [0..11] of string = ( 'Success', 'LineTooLong', 'XDeclaredButNotUsed', @@ -566,6 +590,8 @@ const 'Mo2FileInvalid', 'ModuleHasChanged', 'CannotOpenMo2File', + 'QuitCalled', + 'Processing', 'User' ); //[[[end]]] @@ -593,12 +619,7 @@ type fileIndex: int32; end; -const - UnknownLineInfo: TLineInfo = ( - line: -1; - col: -1; - fileIndex: -1; - ); +function UnknownLineInfo(): TLineInfo; var gNotes: TNoteKinds = [low(TNoteKind)..high(TNoteKind)]; @@ -649,6 +670,13 @@ procedure popInfoContext; implementation +function UnknownLineInfo(): TLineInfo; +begin + result.line := -1; + result.col := -1; + result.fileIndex := -1; +end; + {@ignore} var filenames: array of string; @@ -781,13 +809,14 @@ end; procedure handleError(const msg: TMsgKind); begin - if (msg >= fatalMin) and (msg <= fatalMax) then begin - assert(false); halt(1) + if (msg >= fatalMin) and (msg <= fatalMax) then begin + if optVerbose in gGlobalOptions then assert(false); + halt(1) end; if (msg >= errMin) and (msg <= errMax) then begin inc(gErrorCounter); if gErrorCounter >= gErrorMax then begin - assert(false); // stack trace for debugging + if optVerbose in gGlobalOptions then assert(false); halt(1) // one error stops the compiler end end @@ -797,7 +826,7 @@ procedure writeContext; var i: int; begin - for i := length(msgContext)-1 downto 0 do begin + for i := 0 to length(msgContext)-1 do begin MessageOut(Format(posErrorFormat, [toFilename(msgContext[i]), coordToStr(msgContext[i].line), coordToStr(msgContext[i].col), diff --git a/nim/nimconf.pas b/nim/nimconf.pas index dd29684f6..5a4a13702 100644 --- a/nim/nimconf.pas +++ b/nim/nimconf.pas @@ -101,7 +101,7 @@ var procedure doEnd(var L: TLexer; tok: PToken); begin - if high(condStack) < 0 then lexMessage(L, errAtIfExpected); + if high(condStack) < 0 then lexMessage(L, errTokenExpected, '@if'); ppGetTok(L, tok); // skip 'end' setLength(condStack, high(condStack)) end; @@ -114,7 +114,7 @@ procedure jumpToDirective(var L: TLexer; tok: PToken; dest: TJumpDest); forward; procedure doElse(var L: TLexer; tok: PToken); begin if high(condStack) < 0 then - lexMessage(L, errAtIfExpectedBeforeElse); + lexMessage(L, errTokenExpected, '@if'); ppGetTok(L, tok); if tok.tokType = tkColon then ppGetTok(L, tok); if condStack[high(condStack)] then @@ -126,7 +126,7 @@ var res: bool; begin if high(condStack) < 0 then - lexMessage(L, errAtIfExpectedBeforeElif); + lexMessage(L, errTokenExpected, '@if'); res := EvalppIf(L, tok); if condStack[high(condStack)] or not res then jumpToDirective(L, tok, jdElseEndif) @@ -168,7 +168,7 @@ begin ppGetTok(L, tok) end else if tok.tokType = tkEof then - lexMessage(L, errAtEndExpected) + lexMessage(L, errTokenExpected, '@end') else ppGetTok(L, tok) end @@ -303,7 +303,7 @@ begin while tok.tokType <> tkEof do parseAssignment(L, tok); if length(condStack) > 0 then - lexMessage(L, errAtEndExpected); + lexMessage(L, errTokenExpected, '@end'); closeLexer(L) end end; diff --git a/nim/nimrod.pas b/nim/nimrod.pas index 7f8512984..5d3785af4 100644 --- a/nim/nimrod.pas +++ b/nim/nimrod.pas @@ -6,7 +6,7 @@ // See the file "copying.txt", included in this // distribution, for details about the copyright. // -program nim; +program nimrod; {$include 'config.inc'} {@ignore} @@ -18,39 +18,37 @@ program nim; uses nsystem, charsets, sysutils, commands, scanner, condsyms, options, msgs, nversion, - nimconf, ropes, extccomp, strutils, nos, platform, main; + nimconf, ropes, extccomp, strutils, nos, platform, main, parseopt; var arguments: string = ''; // the arguments to be passed to the program that // should be run + cmdLineInfo: TLineInfo; -function ProcessCmdLine(pass: TCmdLinePass): string; +procedure ProcessCmdLine(pass: TCmdLinePass; var command, filename: string); var - i, paramCounter: int; - param: string; + p: TOptParser; begin - i := 1; - result := ''; - paramCounter := paramCount(); - while i <= paramCounter do begin - param := ParamStr(i); - if param[strStart] = '-' then begin - commands.ProcessCommand(param, pass); + p := parseopt.init(); + while true do begin + parseopt.next(p); + case p.kind of + cmdEnd: break; + cmdLongOption, cmdShortOption: + ProcessSwitch(p.key, p.val, pass, cmdLineInfo); + cmdArgument: begin + if command = '' then command := p.key + else if filename = '' then begin + filename := unixToNativePath(p.key); + // BUGFIX for portable build scripts + break + end + end end - else if i > 1 then begin - result := unixToNativePath(param); // BUGFIX for portable build scripts - options.compilerArgs := i; - break // do not process the arguments - end; - Inc(i) end; - inc(i); // skip program file // collect the arguments: if pass = passCmd2 then begin - while i <= paramCounter do begin - arguments := arguments + ' ' +{&} paramStr(i); - inc(i) - end; + arguments := getRestOfCommandLine(p); if not (optRun in gGlobalOptions) and (arguments <> '') then rawMessage(errArgsNeedRunOption); end @@ -58,42 +56,36 @@ end; procedure HandleCmdLine; var - inp: string; + command, filename: string; begin if paramCount() = 0 then writeCommandLineUsage() else begin // Process command line arguments: - inp := ProcessCmdLine(passCmd1); - if inp <> '' then begin + command := ''; + filename := ''; + ProcessCmdLine(passCmd1, command, filename); + if filename <> '' then begin if gCmd = cmdInterpret then DefineSymbol('interpreting'); - nimconf.LoadConfig(inp); // load the right config file + nimconf.LoadConfig(filename); // load the right config file // now process command line arguments again, because some options in the // command line can overwite the config file's settings extccomp.initVars(); - inp := ProcessCmdLine(passCmd2); + command := ''; + filename := ''; + ProcessCmdLine(passCmd2, command, filename); end; - MainCommand(paramStr(1), inp); + MainCommand(command, filename); if (gCmd <> cmdInterpret) and (msgs.gErrorCounter = 0) then rawMessage(hintSuccess); if optRun in gGlobalOptions then - execExternalProgram(changeFileExt(inp, '') +{&} arguments) + execExternalProgram(changeFileExt(filename, '') +{&} ' ' +{&} arguments) end end; -{@ignore} -var - Saved8087CW: Word; -{@emit} begin -{@ignore} - Saved8087CW := Default8087CW; - Set8087CW($133f); // Disable all fpu exceptions -{@emit} + cmdLineInfo := newLineInfo('command line', -1, -1); condsyms.InitDefines(); HandleCmdLine(); -{@ignore} - Set8087CW(Saved8087CW); -{@emit} halt(options.gExitcode); end. diff --git a/nim/nimsets.pas b/nim/nimsets.pas index 2b8dff20a..04ec943e7 100644 --- a/nim/nimsets.pas +++ b/nim/nimsets.pas @@ -49,7 +49,7 @@ function inSet(s: PNode; const elem: PNode): Boolean; var i: int; begin - assert(s.kind in [nkSetConstr, nkConstSetConstr]); + if s.kind <> nkCurly then InternalError(s.info, 'inSet'); for i := 0 to sonsLen(s)-1 do if s.sons[i].kind = nkRange then begin if leValue(s.sons[i].sons[0], elem) @@ -95,7 +95,7 @@ function SomeInSet(s: PNode; const a, b: PNode): Boolean; var i: int; begin - assert(s.kind in [nkSetConstr, nkConstSetConstr]); + if s.kind <> nkCurly then InternalError(s.info, 'SomeInSet'); for i := 0 to sonsLen(s)-1 do if s.sons[i].kind = nkRange then begin if leValue(s.sons[i].sons[0], b) @@ -142,7 +142,7 @@ var begin elemType := settype.sons[0]; first := firstOrd(elemType); - result := newNode(nkConstSetConstr); + result := newNode(nkCurly); result.typ := settype; result.info := info; @@ -244,7 +244,7 @@ function SetHasRange(s: PNode): Boolean; var i: int; begin - assert(s.kind in [nkSetConstr, nkConstSetConstr]); + if s.kind <> nkCurly then InternalError(s.info, 'SetHasRange'); for i := 0 to sonsLen(s)-1 do if s.sons[i].kind = nkRange then begin result := true; exit diff --git a/nim/nos.pas b/nim/nos.pas index bafa28d43..b4c77681b 100644 --- a/nim/nos.pas +++ b/nim/nos.pas @@ -22,8 +22,8 @@ uses {$ifdef mswindows} windows, {$else} - unix, dos, + unix, {$endif} strutils, nsystem; @@ -83,23 +83,23 @@ function sameFile(const path1, path2: string): boolean; implementation -function expandFilename(filename: string): string; +function UnixToNativePath(const path: string): string; begin - result := sysutils.expandFilename(filename) + if dirSep <> '/' then + result := replaceStr(path, '/', dirSep) + else + result := path; end; -function sameFile(const path1, path2: string): boolean; +function expandFilename(filename: string): string; begin - result := cmpIgnoreCase(expandFilename(path1), - expandFilename(path2)) = 0; + result := sysutils.expandFilename(filename) end; -function UnixToNativePath(const path: string): string; +function sameFile(const path1, path2: string): boolean; begin - if dirSep <> '/' then - result := replaceStr(path, '/', dirSep) - else - result := path; + result := cmpIgnoreCase(expandFilename(UnixToNativePath(path1)), + expandFilename(UnixToNativePath(path2))) = 0; end; procedure createDir(dir: string); @@ -417,8 +417,9 @@ begin SI.hStdError := GetStdHandle(STD_ERROR_HANDLE); SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE); SI.hStdOutput := GetStdHandle(STD_OUTPUT_HANDLE); - if not Windows.CreateProcess(nil, PChar(cmd), nil, nil, true, - NORMAL_PRIORITY_CLASS, Windows.GetEnvironmentStrings(), nil, SI, ProcInfo) + if not Windows.CreateProcess(nil, PChar(cmd), nil, nil, false, + NORMAL_PRIORITY_CLASS, nil {Windows.GetEnvironmentStrings()}, + nil, SI, ProcInfo) then result := getLastError() else begin @@ -435,11 +436,19 @@ begin end; {$else} + {$ifdef windows} +function executeProcess(const cmd: string): int; +begin + result := dos.Exec(cmd, '') +end; +//C:\Eigenes\compiler\MinGW\bin; + {$else} // fpc has a portable function for this function executeProcess(const cmd: string): int; begin result := shell(cmd); end; + {$endif} {$endif} {$ifdef windows} diff --git a/nim/nsystem.pas b/nim/nsystem.pas index 0b8b897c2..9f3adfc7d 100644 --- a/nim/nsystem.pas +++ b/nim/nsystem.pas @@ -90,10 +90,11 @@ type TAddress = longint; {$endif} +var + NaN: float; + inf: float; + NegInf: float; {$ifdef fpc} -const - inf = math.Infinity; - NegInf = -inf; {$else} {$ifopt Q+} {$define Q_on} @@ -150,6 +151,10 @@ function shlU(a, b: biggestInt): biggestInt; function shrU(a, b: biggestInt): biggestInt; function ltU(a, b: biggestInt): bool; function leU(a, b: biggestInt): bool; + +function toU8(a: biggestInt): byte; +function toU32(a: biggestInt): int32; +function ze64(a: byte): biggestInt; {@emit} function alloc(size: int): Pointer; @@ -257,6 +262,23 @@ function leU(a, b: biggestInt): bool; begin result := biggestUInt(a) < biggestUInt(b); end; + +function toU8(a: biggestInt): byte; +begin + assert(a >= 0); + assert(a <= 255); + result := a; +end; + +function toU32(a: biggestInt): int32; +begin + result := int32(a and $ffffffff); +end; + +function ze64(a: byte): biggestInt; +begin + result := a +end; {@emit} procedure addChar(var s: string; c: Char); @@ -486,4 +508,21 @@ end; {$ifdef I_on} {$undef I_on} {$I+} {$endif} +{$ifopt R+} {$R-,Q-} {$define R_on} {$endif} +var + zero: float; + Saved8087CW: Word; +initialization + Saved8087CW := Default8087CW; + Set8087CW($133f); // Disable all fpu exceptions + + zero := 0.0; + NaN := 0.0 / zero; + inf := 1.0 / zero; + NegInf := -inf; +finalization + Set8087CW(Saved8087CW); +{$ifdef R_on} + {$R+,Q+} +{$endif} end. diff --git a/nim/nversion.pas b/nim/nversion.pas index 6b6ee6169..4958353f8 100644 --- a/nim/nversion.pas +++ b/nim/nversion.pas @@ -1,41 +1,51 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -unit nversion; - -// this unit implements the version handling - -interface - -{$include 'config.inc'} - -uses - strutils; - -const - MaxSetElements = 1 shl 16; // (2^16) to support unicode character sets? - defaultAsmMarkerSymbol = '!'; - - //[[[cog - //from koch import NIMROD_VERSION - //cog.outl("VersionAsString = '%s';" % NIMROD_VERSION) - //ver = NIMROD_VERSION.split('.') - //cog.outl('VersionMajor = %s;' % ver[0]) - //cog.outl('VersionMinor = %s;' % ver[1]) - //cog.outl('VersionPatch = %s;' % ver[2]) - //]]] - VersionAsString = '0.5.1'; - VersionMajor = 0; - VersionMinor = 5; - VersionPatch = 1; - //[[[[end]]]] - -implementation - -end. +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// + +unit nversion; + +// this unit implements the version handling + +interface + +{$include 'config.inc'} + +uses + strutils; + +// the Pascal version number gets a little star ('*'), the Nimrod version +// does not! This helps distinguishing the different builds. +{@ignore} +const + VersionStar = '*'+''; +{@emit +const + VersionStar = ''; +} + +const + MaxSetElements = 1 shl 16; // (2^16) to support unicode character sets? + defaultAsmMarkerSymbol = '!'; + + //[[[cog + //from koch import NIMROD_VERSION + //cog.outl("VersionAsString = '%s'+VersionStar;" % NIMROD_VERSION) + //ver = NIMROD_VERSION.split('.') + //cog.outl('VersionMajor = %s;' % ver[0]) + //cog.outl('VersionMinor = %s;' % ver[1]) + //cog.outl('VersionPatch = %s;' % ver[2]) + //]]] + VersionAsString = '0.6.0'+VersionStar; + VersionMajor = 0; + VersionMinor = 6; + VersionPatch = 0; + //[[[[end]]]] + +implementation + +end. diff --git a/nim/optast.pas b/nim/optast.pas new file mode 100644 index 000000000..9f66a53db --- /dev/null +++ b/nim/optast.pas @@ -0,0 +1,34 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// + +unit optast; + +// Optimizations that can be done by AST transformations. The code generators +// should work without the optimizer. The optimizer does the following: + +// - cross-module constant merging +// - cross-module generic merging +// - lowers set operations to bit operations +// - inlining of procs +// - ``s == ""`` --> ``len(s) == 0`` +// - optimization of ``&`` string operator + +interface + +{$include 'config.inc'} + +uses + nsystem, ast, astalgo, strutils, hashes, trees, treetab, platform, magicsys, + options, msgs, crc, idents, lists, types, ropes, nmath, wordrecg, rnimsyn; + +implementation + + +end. + diff --git a/nim/options.pas b/nim/options.pas index e7ec0a1ce..93b56c330 100644 --- a/nim/options.pas +++ b/nim/options.pas @@ -13,12 +13,14 @@ interface {$include 'config.inc'} uses - nsystem, nos, lists, strutils; + nsystem, nos, lists, strutils, strtabs; type // please make sure we have under 32 options // (improves code efficiency a lot!) - TOption = (optNone, optRangeCheck, + TOption = (optNone, + optObjCheck, + optFieldCheck, optRangeCheck, optBoundsCheck, optOverflowCheck, optNilCheck, optAssert, optLineDir, optWarns, optHints, optOptimizeSpeed, @@ -56,6 +58,7 @@ type cmdNone, cmdCompileToC, cmdCompileToCpp, + cmdCompileToEcmaScript, cmdInterpret, cmdPretty, cmdDoc, @@ -69,32 +72,27 @@ type cmdDebugTrans, // debug a transformation pass cmdRst2html // convert a reStructuredText file to HTML ); - - TNumericalBase = (base10, // base10 is listed as the first element, - // so that it is the correct default value - base2, - base8, - base16); - + TStringSeq = array of string; const - ChecksOptions = {@set}[optRangeCheck, optNilCheck, optOverflowCheck, - optBoundsCheck, optAssert]; + ChecksOptions = {@set}[optObjCheck, optFieldCheck, optRangeCheck, + optNilCheck, optOverflowCheck, optBoundsCheck, + optAssert]; optionToStr: array [TOption] of string = ( - 'optNone', 'optRangeCheck', + 'optNone', 'optObjCheck', 'optFieldCheck', 'optRangeCheck', 'optBoundsCheck', 'optOverflowCheck', 'optNilCheck', 'optAssert', 'optLineDir', 'optWarns', 'optHints', 'optOptimizeSpeed', 'optOptimizeSize', 'optStackTrace', 'optLineTrace', 'optEmdb', 'optByRef', 'optCheckpoints' ); var - gOptions: TOptions = {@set}[optRangeCheck, optBoundsCheck, optOverflowCheck, + gOptions: TOptions = {@set}[optObjCheck, optFieldCheck, optRangeCheck, + optBoundsCheck, optOverflowCheck, optAssert, optWarns, optHints, optLineDir, optStackTrace, optLineTrace]; gGlobalOptions: TGlobalOptions = {@set}[optRefcGC]; - compilerArgs: int; gExitcode: Byte; searchPaths: TLinkedList; outFile: string = ''; @@ -124,22 +122,15 @@ function getPrefixDir: string; // gets the application directory // additional configuration variables: -type - TPair = record - key, val: string; - end; - TPairs = array of TPair; - - TStringSeq = array of string; var - gConfigVars: TPairs = {@ignore} nil {@emit []}; + gConfigVars: PStringTable; libpath: string = ''; gKeepComments: boolean = true; // whether the parser needs to keep comments gImplicitMods: TStringSeq = {@ignore} nil {@emit []}; // modules that are to be implicitly imported -procedure setConfigVar(const key, val: string); function getConfigVar(const key: string): string; +procedure setConfigVar(const key, val: string); procedure addImplicitMod(const filename: string); @@ -149,6 +140,16 @@ function binaryStrSearch(const x: array of string; const y: string): int; implementation +function getConfigVar(const key: string): string; +begin + result := strtabs.get(gConfigVars, key); +end; + +procedure setConfigVar(const key, val: string); +begin + strtabs.put(gConfigVars, key, val); +end; + function getOutFile(const filename, ext: string): string; begin if options.outFile <> '' then result := options.outFile @@ -172,38 +173,6 @@ begin SplitPath(appdir, result, bin); end; -function getConfigIdx(const key: string): int; -var - i: int; -begin - for i := 0 to high(gConfigVars) do - if cmpIgnoreStyle(gConfigVars[i].key, key) = 0 then begin - result := i; exit end; - result := -1 -end; - -function getConfigVar(const key: string): string; -var - i: int; -begin - i := getConfigIdx(key); - if i >= 0 then result := gConfigVars[i].val - else result := '' -end; - -procedure setConfigVar(const key, val: string); -var - i: int; -begin - i := getConfigIdx(key); - if i < 0 then begin - i := length(gConfigVars); - setLength(gConfigVars, i+1); - gConfigVars[i].key := key - end; - gConfigVars[i].val := val -end; - function toGeneratedFile(const path, ext: string): string; var head, tail: string; @@ -261,4 +230,6 @@ begin result := -1 end; +initialization + gConfigVars := newStringTable([], modeStyleInsensitive); end. diff --git a/nim/parsecfg.pas b/nim/parsecfg.pas new file mode 100644 index 000000000..1f049536d --- /dev/null +++ b/nim/parsecfg.pas @@ -0,0 +1,414 @@ +// +// +// Nimrod's Runtime Library +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit parsecfg; + +// A HIGH-PERFORMANCE configuration file parser; +// the Nimrod version of this file will become part +// of the standard library. + +interface + +{$include 'config.inc'} + +uses + charsets, nsystem, sysutils, hashes, strutils, lexbase; + +type + TCfgEventKind = ( + cfgEof, // end of file reached + cfgSectionStart, // a ``[section]`` has been parsed + cfgKeyValuePair, // a ``key=value`` pair has been detected + cfgOption, // a ``--key=value`` command line option + cfgError // an error ocurred during parsing; msg contains the + // error message + ); + TCfgEvent = {@ignore} record + kind: TCfgEventKind; + section: string; + key, value: string; + msg: string; + end; + {@emit object(NObject) + case kind: TCfgEventKind of + cfgSection: (section: string); + cfgKeyValuePair, cfgOption: (key, value: string); + cfgError: (msg: string); + end;} + TTokKind = (tkInvalid, tkEof, // order is important here! + tkSymbol, tkEquals, tkColon, + tkBracketLe, tkBracketRi, tkDashDash + ); + TToken = record // a token + kind: TTokKind; // the type of the token + literal: string; // the parsed (string) literal + end; + TParserState = (startState, commaState); + TCfgParser = object(TBaseLexer) + tok: TToken; + state: TParserState; + filename: string; + end; + +function Open(var c: TCfgParser; const filename: string): bool; +procedure OpenFromBuffer(var c: TCfgParser; const buf: string); +procedure Close(var c: TCfgParser); + +function next(var c: TCfgParser): TCfgEvent; + +function getColumn(const c: TCfgParser): int; +function getLine(const c: TCfgParser): int; +function getFilename(const c: TCfgParser): string; + +implementation + +const + SymChars: TCharSet = ['a'..'z', 'A'..'Z', '0'..'9', '_', #128..#255]; + +// ---------------------------------------------------------------------------- +procedure rawGetTok(var c: TCfgParser; var tok: TToken); forward; + +function open(var c: TCfgParser; const filename: string): bool; +begin +{@ignore} + FillChar(c, sizeof(c), 0); // work around Delphi/fpc bug +{@emit} + result := initBaseLexer(c, filename); + c.filename := filename; + c.state := startState; + c.tok.kind := tkInvalid; + c.tok.literal := ''; + if result then rawGetTok(c, c.tok); +end; + +procedure openFromBuffer(var c: TCfgParser; const buf: string); +begin +{@ignore} + FillChar(c, sizeof(c), 0); // work around Delphi/fpc bug +{@emit} + initBaseLexerFromBuffer(c, buf); + c.filename := 'buffer'; + c.state := startState; + c.tok.kind := tkInvalid; + c.tok.literal := ''; + rawGetTok(c, c.tok); +end; + +procedure close(var c: TCfgParser); +begin + deinitBaseLexer(c); +end; + +function getColumn(const c: TCfgParser): int; +begin + result := getColNumber(c, c.bufPos) +end; + +function getLine(const c: TCfgParser): int; +begin + result := c.linenumber +end; + +function getFilename(const c: TCfgParser): string; +begin + result := c.filename +end; + +// ---------------------------------------------------------------------------- + +procedure handleHexChar(var c: TCfgParser; var xi: int); +begin + case c.buf[c.bufpos] of + '0'..'9': begin + xi := (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('0')); + inc(c.bufpos); + end; + 'a'..'f': begin + xi := (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('a') + 10); + inc(c.bufpos); + end; + 'A'..'F': begin + xi := (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('A') + 10); + inc(c.bufpos); + end; + else begin end // do nothing + end +end; + +procedure handleDecChars(var c: TCfgParser; var xi: int); +begin + while c.buf[c.bufpos] in ['0'..'9'] do begin + xi := (xi * 10) + (ord(c.buf[c.bufpos]) - ord('0')); + inc(c.bufpos); + end; +end; + +procedure getEscapedChar(var c: TCfgParser; var tok: TToken); +var + xi: int; +begin + inc(c.bufpos); // skip '\' + case c.buf[c.bufpos] of + 'n', 'N': begin + tok.literal := tok.literal +{&} nl; + Inc(c.bufpos); + end; + 'r', 'R', 'c', 'C': begin addChar(tok.literal, CR); Inc(c.bufpos); end; + 'l', 'L': begin addChar(tok.literal, LF); Inc(c.bufpos); end; + 'f', 'F': begin addChar(tok.literal, FF); inc(c.bufpos); end; + 'e', 'E': begin addChar(tok.literal, ESC); Inc(c.bufpos); end; + 'a', 'A': begin addChar(tok.literal, BEL); Inc(c.bufpos); end; + 'b', 'B': begin addChar(tok.literal, BACKSPACE); Inc(c.bufpos); end; + 'v', 'V': begin addChar(tok.literal, VT); Inc(c.bufpos); end; + 't', 'T': begin addChar(tok.literal, Tabulator); Inc(c.bufpos); end; + '''', '"': begin addChar(tok.literal, c.buf[c.bufpos]); Inc(c.bufpos); end; + '\': begin addChar(tok.literal, '\'); Inc(c.bufpos) end; + 'x', 'X': begin + inc(c.bufpos); + xi := 0; + handleHexChar(c, xi); + handleHexChar(c, xi); + addChar(tok.literal, Chr(xi)); + end; + '0'..'9': begin + xi := 0; + handleDecChars(c, xi); + if (xi <= 255) then + addChar(tok.literal, Chr(xi)) + else + tok.kind := tkInvalid + end + else tok.kind := tkInvalid + end +end; + +function HandleCRLF(var c: TCfgParser; pos: int): int; +begin + case c.buf[pos] of + CR: result := lexbase.HandleCR(c, pos); + LF: result := lexbase.HandleLF(c, pos); + else result := pos + end +end; + +procedure getString(var c: TCfgParser; var tok: TToken; rawMode: Boolean); +var + pos: int; + ch: Char; + buf: PChar; +begin + pos := c.bufPos + 1; // skip " + buf := c.buf; // put `buf` in a register + tok.kind := tkSymbol; + if (buf[pos] = '"') and (buf[pos+1] = '"') then begin + // long string literal: + inc(pos, 2); // skip "" + // skip leading newline: + pos := HandleCRLF(c, pos); + repeat + case buf[pos] of + '"': begin + if (buf[pos+1] = '"') and (buf[pos+2] = '"') then + break; + addChar(tok.literal, '"'); + Inc(pos) + end; + CR, LF: begin + pos := HandleCRLF(c, pos); + tok.literal := tok.literal +{&} nl; + end; + lexbase.EndOfFile: begin + tok.kind := tkInvalid; + break + end + else begin + addChar(tok.literal, buf[pos]); + Inc(pos) + end + end + until false; + c.bufpos := pos + 3 // skip the three """ + end + else begin // ordinary string literal + repeat + ch := buf[pos]; + if ch = '"' then begin + inc(pos); // skip '"' + break + end; + if ch in [CR, LF, lexbase.EndOfFile] then begin + tok.kind := tkInvalid; + break + end; + if (ch = '\') and not rawMode then begin + c.bufPos := pos; + getEscapedChar(c, tok); + pos := c.bufPos; + end + else begin + addChar(tok.literal, ch); + Inc(pos) + end + until false; + c.bufpos := pos; + end +end; + +procedure getSymbol(var c: TCfgParser; var tok: TToken); +var + pos: int; + buf: pchar; +begin + pos := c.bufpos; + buf := c.buf; + while true do begin + addChar(tok.literal, buf[pos]); + Inc(pos); + if not (buf[pos] in SymChars) then break; + end; + c.bufpos := pos; + tok.kind := tkSymbol +end; + +procedure skip(var c: TCfgParser); +var + buf: PChar; + pos: int; +begin + pos := c.bufpos; + buf := c.buf; + repeat + case buf[pos] of + ' ': Inc(pos); + Tabulator: inc(pos); + '#', ';': while not (buf[pos] in [CR, LF, lexbase.EndOfFile]) do inc(pos); + CR, LF: pos := HandleCRLF(c, pos); + else break // EndOfFile also leaves the loop + end + until false; + c.bufpos := pos; +end; + +procedure rawGetTok(var c: TCfgParser; var tok: TToken); +begin + tok.kind := tkInvalid; + setLength(tok.literal, 0); + skip(c); + case c.buf[c.bufpos] of + '=': begin + tok.kind := tkEquals; + inc(c.bufpos); + tok.literal := '='+''; + end; + '-': begin + inc(c.bufPos); + if c.buf[c.bufPos] = '-' then inc(c.bufPos); + tok.kind := tkDashDash; + tok.literal := '--'; + end; + ':': begin + tok.kind := tkColon; + inc(c.bufpos); + tok.literal := ':'+''; + end; + 'r', 'R': begin + if c.buf[c.bufPos+1] = '"' then begin + Inc(c.bufPos); + getString(c, tok, true); + end + else + getSymbol(c, tok); + end; + '[': begin + tok.kind := tkBracketLe; + inc(c.bufpos); + tok.literal := '['+''; + end; + ']': begin + tok.kind := tkBracketRi; + Inc(c.bufpos); + tok.literal := ']'+''; + end; + '"': getString(c, tok, false); + lexbase.EndOfFile: tok.kind := tkEof; + else getSymbol(c, tok); + end +end; + +function errorStr(const c: TCfgParser; const msg: string): string; +begin + result := format('$1($2, $3) Error: $4', [ + c.filename, toString(getLine(c)), toString(getColumn(c)), + msg + ]); +end; + +function getKeyValPair(var c: TCfgParser; kind: TCfgEventKind): TCfgEvent; +begin + if c.tok.kind = tkSymbol then begin + result.kind := kind; + result.key := c.tok.literal; + result.value := ''; + rawGetTok(c, c.tok); + if c.tok.kind in [tkEquals, tkColon] then begin + rawGetTok(c, c.tok); + if c.tok.kind = tkSymbol then begin + result.value := c.tok.literal; + end + else begin + result.kind := cfgError; + result.msg := errorStr(c, 'symbol expected, but found: ' + + c.tok.literal); + end; + rawGetTok(c, c.tok); + end + end + else begin + result.kind := cfgError; + result.msg := errorStr(c, 'symbol expected, but found: ' + c.tok.literal); + rawGetTok(c, c.tok); + end; +end; + +function next(var c: TCfgParser): TCfgEvent; +begin + case c.tok.kind of + tkEof: result.kind := cfgEof; + tkDashDash: begin + rawGetTok(c, c.tok); + result := getKeyValPair(c, cfgOption); + end; + tkSymbol: begin + result := getKeyValPair(c, cfgKeyValuePair); + end; + tkBracketLe: begin + rawGetTok(c, c.tok); + if c.tok.kind = tkSymbol then begin + result.kind := cfgSectionStart; + result.section := c.tok.literal; + end + else begin + result.kind := cfgError; + result.msg := errorStr(c, 'symbol expected, but found: ' + c.tok.literal); + end; + rawGetTok(c, c.tok); + if c.tok.kind = tkBracketRi then rawGetTok(c, c.tok) + else begin + result.kind := cfgError; + result.msg := errorStr(c, ''']'' expected, but found: ' + c.tok.literal); + end + end; + tkInvalid, tkEquals, tkColon: begin + result.kind := cfgError; + result.msg := errorStr(c, 'invalid token: ' + c.tok.literal); + rawGetTok(c, c.tok); + end + end +end; + +end. diff --git a/nim/parseopt.pas b/nim/parseopt.pas new file mode 100644 index 000000000..d543b998e --- /dev/null +++ b/nim/parseopt.pas @@ -0,0 +1,153 @@ +// +// +// Nimrod's Runtime Library +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit parseopt; + +// A command line parser; the Nimrod version of this file +// will become part of the standard library. + +interface + +{$include 'config.inc'} + +uses + nsystem, charsets, nos, strutils; + +type + TCmdLineKind = ( + cmdEnd, // end of command line reached + cmdArgument, // argument detected + cmdLongoption, // a long option ``--option`` detected + cmdShortOption // a short option ``-c`` detected + ); + TOptParser = object(NObject) + cmd: string; + pos: int; + inShortState: bool; + kind: TCmdLineKind; + key, val: string; + end; + +function init(const cmdline: string = ''): TOptParser; +procedure next(var p: TOptParser); + +function getRestOfCommandLine(const p: TOptParser): string; + +implementation + +function init(const cmdline: string = ''): TOptParser; +var + i: int; +begin + result.pos := strStart; + result.inShortState := false; + if cmdline <> '' then + result.cmd := cmdline + else begin + result.cmd := ''; + for i := 1 to ParamCount() do + result.cmd := result.cmd +{&} quoteIfSpaceExists(paramStr(i)) +{&} ' '; + {@ignore} + result.cmd := result.cmd + #0; + {@emit} + end; + result.kind := cmdEnd; + result.key := ''; + result.val := ''; +end; + +function parseWord(const s: string; const i: int; var w: string; + const delim: TCharSet = {@set}[#9, ' ', #0]): int; +begin + result := i; + if s[result] = '"' then begin + inc(result); + while not (s[result] in [#0, '"']) do begin + addChar(w, s[result]); + inc(result); + end; + if s[result] = '"' then inc(result) + end + else begin + while not (s[result] in delim) do begin + addChar(w, s[result]); + inc(result); + end + end +end; + +procedure handleShortOption(var p: TOptParser); +var + i: int; +begin + i := p.pos; + p.kind := cmdShortOption; + addChar(p.key, p.cmd[i]); + inc(i); + p.inShortState := true; + while p.cmd[i] in [#9, ' '] do begin + inc(i); + p.inShortState := false; + end; + if p.cmd[i] in [':', '='] then begin + inc(i); p.inShortState := false; + while p.cmd[i] in [#9, ' '] do inc(i); + i := parseWord(p.cmd, i, p.val); + end; + if p.cmd[i] = #0 then p.inShortState := false; + p.pos := i; +end; + +procedure next(var p: TOptParser); +var + i: int; +begin + i := p.pos; + while p.cmd[i] in [#9, ' '] do inc(i); + p.pos := i; + setLength(p.key, 0); + setLength(p.val, 0); + if p.inShortState then begin + handleShortOption(p); exit + end; + case p.cmd[i] of + #0: p.kind := cmdEnd; + '-': begin + inc(i); + if p.cmd[i] = '-' then begin + p.kind := cmdLongOption; + inc(i); + i := parseWord(p.cmd, i, p.key, {@set}[#0, ' ', #9, ':', '=']); + while p.cmd[i] in [#9, ' '] do inc(i); + if p.cmd[i] in [':', '='] then begin + inc(i); + while p.cmd[i] in [#9, ' '] do inc(i); + p.pos := parseWord(p.cmd, i, p.val); + end + else + p.pos := i; + end + else begin + p.pos := i; + handleShortOption(p) + end + end; + else begin + p.kind := cmdArgument; + p.pos := parseWord(p.cmd, i, p.key); + end + end +end; + +function getRestOfCommandLine(const p: TOptParser): string; +begin + result := strip(ncopy(p.cmd, p.pos+strStart, length(p.cmd)-1)) + // always -1, because Pascal version uses a trailing zero here +end; + +end. diff --git a/nim/paslex.pas b/nim/paslex.pas index 5b90a6138..c7aa6e19a 100644 --- a/nim/paslex.pas +++ b/nim/paslex.pas @@ -70,6 +70,7 @@ type pxSymbol, // a symbol pxIntLit, + pxInt64Lit, // long constant like 0x00000070fffffff or out of int range pxFloatLit, pxParLe, pxParRi, pxBracketLe, pxBracketRi, @@ -110,7 +111,8 @@ const 'with', 'xor', //[[[end]]] 'pxComment', 'pxCommand', - '{&}', '{%}', 'pxStrLit', '[IDENTIFIER]', 'pxIntLit', 'pxFloatLit', + '{&}', '{%}', 'pxStrLit', '[IDENTIFIER]', 'pxIntLit', 'pxInt64Lit', + 'pxFloatLit', '('+'', ')'+'', '['+'', ']'+'', ','+'', ';'+'', ':'+'', ':=', '='+'', '.'+'', '..', '^'+'', '+'+'', '-'+'', '*'+'', '/'+'', @@ -135,7 +137,7 @@ implementation function pastokToStr(const tok: TPasTok): string; begin case tok.xkind of - pxIntLit: + pxIntLit, pxInt64Lit: result := toString(tok.iNumber); pxFloatLit: result := toStringF(tok.fNumber); @@ -271,7 +273,7 @@ end; procedure getNumber2(var L: TPasLex; var tok: TPasTok); var - pos: int; + pos, bits: int; xi: biggestInt; begin pos := L.bufpos+1; // skip % @@ -284,6 +286,7 @@ begin tok.base := base2; xi := 0; + bits := 0; while true do begin case L.buf[pos] of 'A'..'Z', 'a'..'z', '2'..'9', '.': begin @@ -294,23 +297,28 @@ begin '0', '1': begin xi := (xi shl 1) or (ord(L.buf[pos]) - ord('0')); inc(pos); + inc(bits); end; else break; end end; tok.iNumber := xi; - tok.xkind := pxIntLit; + if (bits > 32) then //or (xi < low(int32)) or (xi > high(int32)) then + tok.xkind := pxInt64Lit + else + tok.xkind := pxIntLit; L.bufpos := pos; end; procedure getNumber16(var L: TPasLex; var tok: TPasTok); var - pos: int; + pos, bits: int; xi: biggestInt; begin pos := L.bufpos+1; // skip $ tok.base := base16; xi := 0; + bits := 0; while true do begin case L.buf[pos] of 'G'..'Z', 'g'..'z', '.': begin @@ -321,20 +329,26 @@ begin '0'..'9': begin xi := (xi shl 4) or (ord(L.buf[pos]) - ord('0')); inc(pos); + inc(bits, 4); end; 'a'..'f': begin xi := (xi shl 4) or (ord(L.buf[pos]) - ord('a') + 10); inc(pos); + inc(bits, 4); end; 'A'..'F': begin xi := (xi shl 4) or (ord(L.buf[pos]) - ord('A') + 10); inc(pos); + inc(bits, 4); end; else break; end end; tok.iNumber := xi; - tok.xkind := pxIntLit; + if (bits > 32) then // (xi < low(int32)) or (xi > high(int32)) then + tok.xkind := pxInt64Lit + else + tok.xkind := pxIntLit; L.bufpos := pos; end; @@ -354,7 +368,10 @@ begin end else begin tok.iNumber := ParseInt(tok.literal); - tok.xkind := pxIntLit; + if (tok.iNumber < low(int32)) or (tok.iNumber > high(int32)) then + tok.xkind := pxInt64Lit + else + tok.xkind := pxIntLit; end; except on EInvalidValue do diff --git a/nim/pasparse.pas b/nim/pasparse.pas index 2d581d81a..357918029 100644 --- a/nim/pasparse.pas +++ b/nim/pasparse.pas @@ -322,6 +322,10 @@ begin result := newNodeP(nkPtrTy, p); getTok(p); eat(p, pxCurlyDirRi); end + else if p.tok.ident.id = getIdent('tuple').id then begin + result := newNodeP(nkTupleTy, p); + getTok(p); eat(p, pxCurlyDirRi); + end else begin parMessage(p, errUnknownDirective, pasTokToStr(p.tok)); while true do begin @@ -481,6 +485,16 @@ begin exprListAux(p, elemKind, endTok, sepTok, result); end; +procedure setBaseFlags(n: PNode; base: TNumericalBase); +begin + case base of + base10: begin end; + base2: include(n.flags, nfBase2); + base8: include(n.flags, nfBase8); + base16: include(n.flags, nfBase16); + end +end; + function identOrLiteral(var p: TPasParser): PNode; var a: PNode; @@ -493,12 +507,17 @@ begin // literals pxIntLit: begin result := newIntNodeP(nkIntLit, p.tok.iNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); + getTok(p); + end; + pxInt64Lit: begin + result := newIntNodeP(nkInt64Lit, p.tok.iNumber, p); + setBaseFlags(result, p.tok.base); getTok(p); end; pxFloatLit: begin result := newFloatNodeP(nkFloatLit, p.tok.fNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; pxStrLit: begin @@ -683,8 +702,9 @@ begin end else begin end end; - for i := 0 to sonsLen(n)-1 do - result.sons[i] := fixExpr(n.sons[i]) + if not (n.kind in [nkEmpty..nkNilLit]) then + for i := 0 to sonsLen(n)-1 do + result.sons[i] := fixExpr(n.sons[i]) end; function parseExpr(var p: TPasParser): PNode; @@ -948,6 +968,7 @@ begin if p.tok.xkind <> pxIf then begin // ordinary else part: branch := newNodeP(nkElse, p); + skipCom(p, result); // BUGFIX addSon(branch, parseStmt(p)); addSon(result, branch); break @@ -1235,6 +1256,14 @@ begin noBody := true; getTok(p); opt(p, pxSemicolon); end; + wNoConv: begin + // This is a fake for platform module. There is no ``noconv`` + // directive in Pascal. + if result = nil then result := newNodeP(nkPragma, p); + addSon(result, newIdentNodeP(getIdent('noconv'), p)); + noBody := true; + getTok(p); opt(p, pxSemicolon); + end; wVarargs: begin if result = nil then result := newNodeP(nkPragma, p); addSon(result, newIdentNodeP(getIdent('varargs'), p)); @@ -1464,7 +1493,7 @@ begin nkIdent, nkAccQuoted: begin a := newNode(nkPostFix); a.info := n.info; - addSon(a, newIdentNode(getIdent('*'+''))); + addSon(a, newIdentNode(getIdent('*'+''), n.info)); addSon(a, n); n := a end; @@ -1486,7 +1515,7 @@ begin end end; nkRecList, nkRecWhen, nkElse, nkOfBranch, nkElifBranch, - nkRecordTy, nkObjectTy: begin + nkObjectTy: begin for i := 0 to sonsLen(n)-1 do fixRecordDef(n.sons[i]) end; nkIdentDefs: begin @@ -1497,6 +1526,19 @@ begin end end; +procedure parseRecordBody(var p: TPasParser; result: PNode); +var + a: PNode; +begin + skipCom(p, result); + a := parseRecordPart(p); + if result.kind <> nkTupleTy then fixRecordDef(a); + addSon(result, a); + eat(p, pxEnd); + opt(p, pxSemicolon); + skipCom(p, result); +end; + function parseRecordOrObject(var p: TPasParser; kind: TNodeKind): PNode; var a: PNode; @@ -1512,19 +1554,14 @@ begin eat(p, pxParRi); end else addSon(result, nil); - skipCom(p, result); - a := parseRecordPart(p); - fixRecordDef(a); - addSon(result, a); - eat(p, pxEnd); - opt(p, pxSemicolon); - skipCom(p, result); + parseRecordBody(p, result); end; function parseTypeDesc(var p: TPasParser): PNode; var oldcontext: TPasContext; a, r: PNode; + i: int; begin oldcontext := p.context; p.context := conTypeDesc; @@ -1532,7 +1569,28 @@ begin case p.tok.xkind of pxCommand: result := parseCommand(p); pxProcedure, pxFunction: result := parseRoutineType(p); - pxRecord: result := parseRecordOrObject(p, nkRecordTy); + pxRecord: begin + getTok(p); + if p.tok.xkind = pxCommand then begin + result := parseCommand(p); + if result.kind <> nkTupleTy then + InternalError(result.info, 'parseTypeDesc'); + parseRecordBody(p, result); + a := lastSon(result); + // embed nkRecList directly into nkTupleTy + for i := 0 to sonsLen(a)-1 do + if i = 0 then result.sons[sonsLen(result)-1] := a.sons[0] + else addSon(result, a.sons[i]); + end + else begin + result := newNodeP(nkReturnToken, p); + // we use nkReturnToken to signal that this object should be marked as + // final + addSon(result, nil); + addSon(result, nil); + parseRecordBody(p, result); + end; + end; pxObject: result := parseRecordOrObject(p, nkObjectTy); pxParLe: result := parseEnum(p); pxArray: begin @@ -1591,13 +1649,29 @@ begin end; function parseTypeDef(var p: TPasParser): PNode; +var + a, e, pragmasNode: PNode; begin result := newNodeP(nkTypeDef, p); addSon(result, identVis(p)); addSon(result, nil); // generic params if p.tok.xkind = pxEquals then begin getTok(p); skipCom(p, result); - addSon(result, parseTypeDesc(p)); + a := parseTypeDesc(p); + addSon(result, a); + if a.kind = nkReturnToken then begin // a `final` object? + a.kind := nkObjectTy; + if result.sons[0].kind <> nkPragmaExpr then begin + e := newNodeP(nkPragmaExpr, p); + pragmasNode := newNodeP(nkPragma, p); + addSon(e, result.sons[0]); + addSon(e, pragmasNode); + result.sons[0] := e; + end + else + pragmasNode := result.sons[1]; + addSon(pragmasNode, newIdentNodeP(getIdent('final'), p)); + end end else addSon(result, nil); diff --git a/nim/platform.pas b/nim/platform.pas index 3bb109943..896d7b4a2 100644 --- a/nim/platform.pas +++ b/nim/platform.pas @@ -13,7 +13,7 @@ unit platform; // Note: Unfortunately if an OS or CPU is listed here this does not mean that // Nimrod has been tested on this platform or that the RTL has been ported. // Feel free to test for your exentric platform! (Windows on I386 and Linux -// on AMD64 have been tested, though.) +// on I386 have been tested, though.) interface @@ -45,7 +45,8 @@ type osAtari, osNetware, osMacos, - osMacosx + osMacosx, + osEcmaScript ); type TInfoOSProp = ( @@ -55,7 +56,7 @@ type ); TInfoOSProps = set of TInfoOSProp; - TInfoOS = record + TInfoOS = record{@tuple} name: string; parDir: string; dllExt: string; @@ -73,7 +74,7 @@ type end; const OS: array [succ(low(TSystemOS))..high(TSystemOS)] of TInfoOS = ( - ( + ( name: 'DOS'; parDir: '..'; dllExt: '.dll'; @@ -89,7 +90,7 @@ const extSep: '.'+''; props: {@set}[ospCaseInsensitive]; ), - ( + ( name: 'Windows'; parDir: '..'; dllExt: '.dll'; @@ -105,7 +106,7 @@ const extSep: '.'+''; props: {@set}[ospCaseInsensitive]; ), - ( + ( name: 'OS2'; parDir: '..'; dllExt: '.dll'; @@ -121,7 +122,7 @@ const extSep: '.'+''; props: {@set}[ospCaseInsensitive]; ), - ( + ( name: 'Linux'; parDir: '..'; dllExt: '.so'; @@ -137,7 +138,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'MorphOS'; parDir: '..'; dllExt: '.so'; @@ -153,7 +154,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'SkyOS'; parDir: '..'; dllExt: '.so'; @@ -169,7 +170,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'Solaris'; parDir: '..'; dllExt: '.so'; @@ -185,7 +186,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'Irix'; parDir: '..'; dllExt: '.so'; @@ -201,7 +202,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'NetBSD'; parDir: '..'; dllExt: '.so'; @@ -217,7 +218,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'FreeBSD'; parDir: '..'; dllExt: '.so'; @@ -233,7 +234,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'OpenBSD'; parDir: '..'; dllExt: '.so'; @@ -249,7 +250,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'PalmOS'; parDir: '..'; dllExt: '.so'; @@ -265,7 +266,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC]; ), - ( + ( name: 'QNX'; parDir: '..'; dllExt: '.so'; @@ -281,7 +282,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; ), - ( + ( name: 'Amiga'; parDir: '..'; dllExt: '.library'; @@ -297,7 +298,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC]; ), - ( + ( name: 'Atari'; parDir: '..'; dllExt: '.dll'; @@ -313,7 +314,7 @@ const extSep: '.'+''; props: {@set}[ospNeedsPIC]; ), - ( + ( name: 'Netware'; parDir: '..'; dllExt: '.nlm'; @@ -329,7 +330,7 @@ const extSep: '.'+''; props: {@set}[ospCaseInsensitive]; ), - ( + ( name: 'MacOS'; parDir: '::'; dllExt: 'Lib'; @@ -345,7 +346,7 @@ const extSep: '.'+''; props: {@set}[ospCaseInsensitive]; ), - ( + ( name: 'MacOSX'; parDir: '..'; dllExt: '.dylib'; @@ -353,13 +354,29 @@ const dllPrefix: 'lib'; objExt: '.o'; newLine: #10+''; - pathSep: ':'+''; + pathSep: ':'+''; dirSep: '/'+''; scriptExt: '.sh'; curDir: '.'+''; exeExt: ''; extSep: '.'+''; props: {@set}[ospNeedsPIC, ospPosix]; + ), + ( + name: 'EcmaScript'; + parDir: '..'; + dllExt: '.so'; + altDirSep: '/'+''; + dllPrefix: 'lib'; + objExt: '.o'; + newLine: #10+''; + pathSep: ':'+''; + dirSep: '/'+''; + scriptExt: '.sh'; + curDir: '.'+''; + exeExt: ''; + extSep: '.'+''; + props: {@set}[]; ) ); type @@ -377,11 +394,12 @@ type cpuIa64, cpuAmd64, cpuMips, - cpuArm + cpuArm, + cpuEcmaScript ); type TEndian = (littleEndian, bigEndian); - TInfoCPU = record + TInfoCPU = record{@tuple} name: string; intSize: int; endian: TEndian; @@ -460,6 +478,13 @@ const endian: littleEndian; floatSize: 64; bit: 32; + ), + ( + name: 'ecmascript'; + intSize: 32; + endian: bigEndian; + floatSize: 64; + bit: 32; ) ); @@ -517,9 +542,9 @@ end; // this is Ok for the Pascal version, but the Nimrod version needs a different // mechanism {@emit -procedure nimCPU(): cstring; importc;} +procedure nimCPU(): cstring; importc; noconv;} {@emit -procedure nimOS(): cstring; importc;} +procedure nimOS(): cstring; importc; noconv;} {@ignore} initialization diff --git a/nim/pnimsyn.pas b/nim/pnimsyn.pas index 8407804e7..27841229e 100644 --- a/nim/pnimsyn.pas +++ b/nim/pnimsyn.pas @@ -240,6 +240,9 @@ begin end; function parseSymbol(var p: TParser): PNode; +var + s: string; + id: PIdent; begin case p.tok.tokType of tkSymbol: begin @@ -251,9 +254,31 @@ begin getTok(p); case p.tok.tokType of tkBracketLe: begin - addSon(result, newIdentNodeP(getIdent('[]'), p)); + s := '['+''; getTok(p); + if (p.tok.tokType = tkOpr) and (p.tok.ident.s = '$'+'') then begin + s := s + '$..'; + getTok(p); + eat(p, tkDotDot); + if (p.tok.tokType = tkOpr) and (p.tok.ident.s = '$'+'') then begin + s := s + '$'+''; + getTok(p); + end; + end + else if p.tok.tokType = tkDotDot then begin + s := s + '..'; + getTok(p); + if (p.tok.tokType = tkOpr) and (p.tok.ident.s = '$'+'') then begin + s := s + '$'+''; + getTok(p); + end; + end; eat(p, tkBracketRi); + s := s + ']'+''; + if p.tok.tokType = tkEquals then begin + s := s + '='; getTok(p); + end; + addSon(result, newIdentNodeP(getIdent(s), p)); end; tkParLe: begin addSon(result, newIdentNodeP(getIdent('()'), p)); @@ -261,8 +286,14 @@ begin eat(p, tkParRi); end; tokKeywordLow..tokKeywordHigh, tkSymbol, tkOpr: begin - addSon(result, newIdentNodeP(p.tok.ident, p)); + id := p.tok.ident; getTok(p); + if p.tok.tokType = tkEquals then begin + addSon(result, newIdentNodeP(getIdent(id.s + '='), p)); + getTok(p); + end + else + addSon(result, newIdentNodeP(id, p)); end; else begin parMessage(p, errIdentifierExpected, tokToStr(p.tok)); @@ -350,7 +381,7 @@ var begin case p.tok.tokType of tkDotDot: result := dotdotExpr(p); - tkVar, tkRef, tkPtr, tkProc, tkType: result := parseTypeDescK(p); + tkVar, tkRef, tkPtr, tkProc, tkTuple, tkType: result := parseTypeDescK(p); else begin a := parseExpr(p); case p.tok.tokType of @@ -519,6 +550,16 @@ begin eat(p, tkParRi); end; +procedure setBaseFlags(n: PNode; base: TNumericalBase); +begin + case base of + base10: begin end; + base2: include(n.flags, nfBase2); + base8: include(n.flags, nfBase8); + base16: include(n.flags, nfBase16); + end +end; + function identOrLiteral(var p: TParser): PNode; begin case p.tok.tokType of @@ -530,42 +571,42 @@ begin // literals tkIntLit: begin result := newIntNodeP(nkIntLit, p.tok.iNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; tkInt8Lit: begin result := newIntNodeP(nkInt8Lit, p.tok.iNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; tkInt16Lit: begin result := newIntNodeP(nkInt16Lit, p.tok.iNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; tkInt32Lit: begin result := newIntNodeP(nkInt32Lit, p.tok.iNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; tkInt64Lit: begin result := newIntNodeP(nkInt64Lit, p.tok.iNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; tkFloatLit: begin result := newFloatNodeP(nkFloatLit, p.tok.fNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; tkFloat32Lit: begin result := newFloatNodeP(nkFloat32Lit, p.tok.fNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; tkFloat64Lit: begin result := newFloatNodeP(nkFloat64Lit, p.tok.fNumber, p); - result.base := p.tok.base; + setBaseFlags(result, p.tok.base); getTok(p); end; tkStrLit: begin @@ -584,10 +625,6 @@ begin result := newIntNodeP(nkCharLit, ord(p.tok.literal[strStart]), p); getTok(p); end; - tkRCharLit: begin - result := newIntNodeP(nkRCharLit, ord(p.tok.literal[strStart]), p); - getTok(p); - end; tkNil: begin result := newNodeP(nkNilLit, p); getTok(p); @@ -598,8 +635,7 @@ begin tkColon); end; tkCurlyLe: begin // {} constructor - result := exprColonEqExprList(p, nkCurly, nkRange, tkCurlyRi, - tkDotDot); + result := exprColonEqExprList(p, nkCurly, nkRange, tkCurlyRi, tkDotDot); end; tkBracketLe: begin // [] constructor result := exprColonEqExprList(p, nkBracket, nkExprColonExpr, tkBracketRi, @@ -1278,6 +1314,8 @@ begin end; function parseTypeDescK(var p: TParser): PNode; +var + a: PNode; begin case p.tok.tokType of tkVar: result := parseTypeDescKAux(p, nkVarTy); @@ -1298,7 +1336,25 @@ begin addSon(result, parsePragma(p)) else addSon(result, nil); - end + end; + tkTuple: begin + result := newNodeP(nkTupleTy, p); + getTok(p); + eat(p, tkBracketLe); + optInd(p, result); + while true do begin + case p.tok.tokType of + tkSymbol, tkAccent: a := parseIdentColonEquals(p, false); + tkBracketRi: begin getTok(p); break end; + else begin parMessage(p, errTokenExpected, ']'+''); break; end; + end; + optInd(p, a); + if p.tok.tokType = tkComma then begin + getTok(p); optInd(p, a) + end; + addSon(result, a); + end; + end; else begin InternalError(parLineInfo(p), 'pnimsyn.parseTypeDescK'); result := nil @@ -1309,7 +1365,7 @@ end; function parseTypeDesc(var p: TParser): PNode; begin case p.tok.tokType of - tkVar, tkRef, tkPtr, tkProc, tkType: + tkVar, tkRef, tkPtr, tkProc, tkType, tkTuple: result := parseTypeDescK(p); else result := primary(p) end @@ -1599,7 +1655,7 @@ begin if kind = nkObjectTy then addSon(result, a) else - parMessage(p, errInheritanceOnlyWithObjects); + parMessage(p, errInheritanceOnlyWithNonFinalObjects); end else addSon(result, nil); skipComment(p, result); @@ -1617,7 +1673,6 @@ begin if p.tok.tokType = tkEquals then begin getTok(p); optInd(p, result); case p.tok.tokType of - tkRecord: a := parseRecordOrObject(p, nkRecordTy); tkObject: a := parseRecordOrObject(p, nkObjectTy); tkEnum: a := parseEnum(p); else a := parseTypeDesc(p); @@ -1660,22 +1715,23 @@ end; function complexOrSimpleStmt(var p: TParser): PNode; begin case p.tok.tokType of - tkIf: result := parseIfOrWhen(p, nkIfStmt); - tkWhile: result := parseWhile(p); - tkCase: result := parseCase(p); - tkTry: result := parseTry(p); - tkFor: result := parseFor(p); - tkBlock: result := parseBlock(p); - tkAsm: result := parseAsm(p); - tkProc: result := parseRoutine(p, nkProcDef); - tkIterator: result := parseRoutine(p, nkIteratorDef); - tkMacro: result := parseRoutine(p, nkMacroDef); - tkTemplate: result := parseRoutine(p, nkTemplateDef); - tkType: result := parseSection(p, nkTypeSection, parseTypeDef); - tkConst: result := parseSection(p, nkConstSection, parseConstant); - tkWhen: result := parseIfOrWhen(p, nkWhenStmt); - tkVar: result := parseSection(p, nkVarSection, parseVariable); - else result := simpleStmt(p); + tkIf: result := parseIfOrWhen(p, nkIfStmt); + tkWhile: result := parseWhile(p); + tkCase: result := parseCase(p); + tkTry: result := parseTry(p); + tkFor: result := parseFor(p); + tkBlock: result := parseBlock(p); + tkAsm: result := parseAsm(p); + tkProc: result := parseRoutine(p, nkProcDef); + tkIterator: result := parseRoutine(p, nkIteratorDef); + tkMacro: result := parseRoutine(p, nkMacroDef); + tkTemplate: result := parseRoutine(p, nkTemplateDef); + tkConverter: result := parseRoutine(p, nkConverterDef); + tkType: result := parseSection(p, nkTypeSection, parseTypeDef); + tkConst: result := parseSection(p, nkConstSection, parseConstant); + tkWhen: result := parseIfOrWhen(p, nkWhenStmt); + tkVar: result := parseSection(p, nkVarSection, parseVariable); + else result := simpleStmt(p); end end; diff --git a/nim/pragmas.pas b/nim/pragmas.pas index f257be390..c3a6c42d2 100644 --- a/nim/pragmas.pas +++ b/nim/pragmas.pas @@ -26,10 +26,9 @@ begin if (it.kind = nkExprColonExpr) and (it.sons[0].kind = nkIdent) then begin case whichKeyword(it.sons[0].ident) of wAsmQuote: begin - case it.sons[1].kind of - nkCharLit, nkRCharLit: result := chr(int(it.sons[1].intVal)); - else invalidPragma(it) - end + if it.sons[1].kind = nkCharLit then + result := chr(int(it.sons[1].intVal)) + else invalidPragma(it) end else invalidPragma(it) @@ -246,6 +245,8 @@ begin sw := whichKeyword(n.sons[0].ident); case sw of wChecks: OnOff(c, n, checksOptions); + wObjChecks: OnOff(c, n, {@set}[optObjCheck]); + wFieldchecks: OnOff(c, n, {@set}[optFieldCheck]); wRangechecks: OnOff(c, n, {@set}[optRangeCheck]); wBoundchecks: OnOff(c, n, {@set}[optBoundsCheck]); wOverflowchecks: OnOff(c, n, {@set}[optOverflowCheck]); @@ -373,12 +374,12 @@ begin end end; -procedure Breakpoint(c: PContext; n: PNode); +procedure PragmaBreakpoint(c: PContext; n: PNode); begin {@discard} getOptionalStr(c, n, ''); end; -procedure Checkpoint(c: PContext; n: PNode); +procedure PragmaCheckpoint(c: PContext; n: PNode); // checkpoints can be used to debug the compiler; they are not documented var info: TLineInfo; @@ -427,7 +428,10 @@ begin liMessage(it.info, errPowerOfTwoExpected); end; wNodecl: begin noVal(it); Include(sym.loc.Flags, lfNoDecl); end; - wPure: begin noVal(it); include(sym.flags, sfPure); end; + wPure: begin + noVal(it); + if sym <> nil then include(sym.flags, sfPure); + end; wVolatile: begin noVal(it); Include(sym.flags, sfVolatile); end; wRegister: begin noVal(it); include(sym.flags, sfRegister); end; wMagic: processMagic(c, it, sym); @@ -444,7 +448,6 @@ begin wNosideeffect: begin noVal(it); Include(sym.flags, sfNoSideEffect); end; wNoReturn: begin noVal(it); Include(sym.flags, sfNoReturn); end; wDynLib: processDynLib(c, it, sym); - wReturnsNew: begin noVal(it); Include(sym.flags, sfReturnsNew); end; wCompilerProc: begin noVal(it); // compilerproc may not get a string! makeExternExport(sym, sym.name.s); @@ -464,6 +467,14 @@ begin noVal(it); include(sym.typ.flags, tfVarargs); end; + wFinal: begin + noVal(it); + include(sym.typ.flags, tfFinal); + end; + wTypeCheck: begin + noVal(it); + include(sym.flags, sfTypeCheck); + end; // statement pragmas: wHint: liMessage(it.info, hintUser, expectStrLit(c, it)); @@ -478,6 +489,9 @@ begin wCompile: processCompile(c, it); wLink: processCommonLink(c, it, linkNormal); wLinkSys: processCommonLink(c, it, linkSys); + wPassL: extccomp.addLinkOption(expectStrLit(c, it)); + wPassC: extccomp.addCompileOption(expectStrLit(c, it)); + // fixupSystem not even documented: wFixupSystem: begin if c.module = magicSys.SystemModule then @@ -485,12 +499,13 @@ begin else invalidPragma(it) end; - wBreakpoint: Breakpoint(c, it); - wCheckpoint: Checkpoint(c, it); + wBreakpoint: PragmaBreakpoint(c, it); + wCheckpoint: PragmaCheckpoint(c, it); wPush: begin processPush(c, n, i+1); break end; wPop: processPop(c, it); - wChecks, wRangechecks, wBoundchecks, wOverflowchecks, wNilchecks, + wChecks, wObjChecks, wFieldChecks, + wRangechecks, wBoundchecks, wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, wLinedir, wStacktrace, wLinetrace, wOptimization, wByRef, wCallConv, wDebugger: processOption(c, it); @@ -528,20 +543,28 @@ begin wCppMethod, wDeprecated, wVarargs]); end; +procedure pragmaMacro(c: PContext; s: PSym; n: PNode); +begin + pragma(c, s, n, {@set}[FirstCallConv..LastCallConv, + wImportc, wExportc, wNostatic, wNodecl, wMagic, wNosideEffect, + wCompilerProc, wDeprecated, wTypeCheck]); +end; + procedure pragmaIterator(c: PContext; s: PSym; n: PNode); begin pragma(c, s, n, {@set}[FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, wMagic, wDeprecated]); end; -procedure pragmaStmt(c: PContext; n: PNode); +procedure pragmaStmt(c: PContext; s: PSym; n: PNode); begin - pragma(c, nil, n, {@set}[wChecks, wRangechecks, wBoundchecks, - wOverflowchecks, wNilchecks, wAssertions, wWarnings, + pragma(c, s, n, {@set}[wChecks, wObjChecks, wFieldChecks, wRangechecks, + wBoundchecks, wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, wLinedir, wStacktrace, wLinetrace, wOptimization, wHint, wWarning, wError, wFatal, wDefine, wUndef, - wCompile, wLink, wLinkSys, - wPush, wPop, wFixupSystem, wBreakpoint, wCheckpoint]); + wCompile, wLink, wLinkSys, wPure, + wPush, wPop, wFixupSystem, wBreakpoint, wCheckpoint, + wPassL, wPassC]); end; procedure pragmaLambda(c: PContext; s: PSym; n: PNode); @@ -554,7 +577,7 @@ end; procedure pragmaType(c: PContext; s: PSym; n: PNode); begin pragma(c, s, n, {@set}[wImportc, wExportc, wDeprecated, wMagic, - wNodecl, wPure, wHeader, wCompilerProc]); + wNodecl, wPure, wHeader, wCompilerProc, wFinal]); end; procedure pragmaField(c: PContext; s: PSym; n: PNode); diff --git a/nim/rnimsyn.pas b/nim/rnimsyn.pas index b4f97e82c..b4ba928fb 100644 --- a/nim/rnimsyn.pas +++ b/nim/rnimsyn.pas @@ -16,20 +16,20 @@ unit rnimsyn; interface uses - nsystem, charsets, lexbase, scanner, options, idents, strutils, ast, msgs, + nsystem, charsets, lexbase, scanner, options, idents, strutils, ast, msgs, lists; type TRenderFlag = (renderNone, renderNoBody, renderNoComments, renderNoPragmas, renderIds); TRenderFlags = set of TRenderFlag; - + TRenderTok = record kind: TTokType; len: int16; end; TRenderTokSeq = array of TRenderTok; - + TSrcGen = record indent: int; lineLen: int; @@ -390,16 +390,10 @@ function lsub(n: PNode): int; forward; function litAux(n: PNode; x: biggestInt; size: int): string; begin - case n.base of - base10: result := toString(x); - base2: result := '0b' + toBin(x, size*8); - base8: result := '0o' + toOct(x, size*3); - base16: result := '0x' + toHex(x, size*2); - else begin - assert(false); - result := toString(x); - end - end + if nfBase2 in n.flags then result := '0b' + toBin(x, size*8) + else if nfBase8 in n.flags then result := '0o' + toOct(x, size*3) + else if nfBase16 in n.flags then result := '0x' + toHex(x, size*2) + else result := toString(x) end; function atom(n: PNode): string; @@ -414,18 +408,19 @@ begin nkRStrLit: result := 'r"' + n.strVal + '"'; nkTripleStrLit: result := '"""' + n.strVal + '"""'; nkCharLit: result := '''' + toNimChar(chr(int(n.intVal))) + ''''; - nkRCharLit: result := 'r''' + chr(int(n.intVal)) + ''''; nkIntLit: result := litAux(n, n.intVal, 4); nkInt8Lit: result := litAux(n, n.intVal, 1) + '''i8'; nkInt16Lit: result := litAux(n, n.intVal, 2) + '''i16'; nkInt32Lit: result := litAux(n, n.intVal, 4) + '''i32'; nkInt64Lit: result := litAux(n, n.intVal, 8) + '''i64'; nkFloatLit: begin - if n.base = base10 then result := toStringF(n.floatVal) - else result := litAux(n, ({@cast}PInt64(addr(n.floatVal)))^, 8); + if n.flags * [nfBase2, nfBase8, nfBase16] = [] then + result := toStringF(n.floatVal) + else + result := litAux(n, ({@cast}PInt64(addr(n.floatVal)))^, 8); end; nkFloat32Lit: begin - if n.base = base10 then + if n.flags * [nfBase2, nfBase8, nfBase16] = [] then result := toStringF(n.floatVal) + '''f32' else begin f := n.floatVal; @@ -433,7 +428,7 @@ begin end; end; nkFloat64Lit: begin - if n.base = base10 then + if n.flags * [nfBase2, nfBase8, nfBase16] = [] then result := toStringF(n.floatVal) + '''f64' else result := litAux(n, ({@cast}PInt64(addr(n.floatVal)))^, 8) + '''f64'; @@ -474,43 +469,49 @@ end; function lsub(n: PNode): int; // computes the length of a tree var - len: int; + L: int; begin if n = nil then begin result := 0; exit end; if n.comment <> snil then begin result := maxLineLen+1; exit end; - len := sonsLen(n); case n.kind of nkTripleStrLit: begin if containsNL(n.strVal) then result := maxLineLen+1 else result := length(atom(n)); end; - nkEmpty..pred(nkTripleStrLit), succ(nkTripleStrLit)..nkNilLit: + nkEmpty..pred(nkTripleStrLit), succ(nkTripleStrLit)..nkNilLit: result := length(atom(n)); nkCall, nkBracketExpr, nkConv: result := lsub(n.sons[0])+lcomma(n, 1)+2; nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: begin - result := lsub(n.sons[0]); - end; - nkCast: begin - if sonsLen(n) = 2 then - result := lsub(n.sons[0])+lsub(n.sons[1])+length('cast[]()') - else - result := lsub(n.sons[0]) + length('cast()'); + result := lsub(n.sons[1]); end; + nkCast: result := lsub(n.sons[0])+lsub(n.sons[1])+length('cast[]()'); nkAddr: result := lsub(n.sons[0])+length('addr()'); + nkHiddenAddr, nkHiddenDeref: result := lsub(n.sons[0]); nkCommand: result := lsub(n.sons[0])+lcomma(n, 1)+1; - nkExprEqExpr, nkDefaultTypeParam, nkAsgn: - result := lsons(n)+3; - nkPar, nkRecordConstr, nkConstRecordConstr, - nkCurly, nkSetConstr, nkConstSetConstr, - nkBracket, nkArrayConstr, nkConstArrayConstr: result := lcomma(n)+2; + nkExprEqExpr, nkDefaultTypeParam, nkAsgn: result := lsons(n)+3; + nkPar, nkCurly, nkBracket: result := lcomma(n)+2; + nkTupleTy: result := lcomma(n)+length('tuple[]'); nkQualified, nkDotExpr: result := lsons(n)+1; + nkCheckedFieldExpr: result := lsub(n.sons[0]); nkLambda: result := lsons(n)+length('lambda__=_'); nkConstDef, nkIdentDefs: begin result := lcomma(n, 0, -3); - if n.sons[len-2] <> nil then - result := result + lsub(n.sons[len-2]) + 2; - if n.sons[len-1] <> nil then - result := result + lsub(n.sons[len-1]) + 3; + L := sonsLen(n); + if n.sons[L-2] <> nil then + result := result + lsub(n.sons[L-2]) + 2; + if n.sons[L-1] <> nil then + result := result + lsub(n.sons[L-1]) + 3; + end; + nkChckRangeF: result := length('chckRangeF') + 2 + lcomma(n); + nkChckRange64: result := length('chckRange64') + 2 + lcomma(n); + nkChckRange: result := length('chckRange') + 2 + lcomma(n); + + nkObjDownConv, nkObjUpConv, + nkStringToCString, nkCStringToString, nkPassAsOpenArray: begin + result := 2; + if sonsLen(n) >= 1 then + result := result + lsub(n.sons[0]); + result := result + lcomma(n, 1); end; nkExprColonExpr: result := lsons(n) + 2; nkInfix: result := lsons(n) + 2; @@ -539,7 +540,7 @@ begin nkEnumTy: result := lsub(n.sons[0])+lcomma(n,1)+length('enum_'); nkEnumFieldDef: result := lsons(n)+3; - nkVarSection: if len > 1 then result := maxLineLen+1 + nkVarSection: if sonsLen(n) > 1 then result := maxLineLen+1 else result := lsons(n) + length('var_'); nkReturnStmt: result := lsub(n.sons[0])+length('return_'); nkRaiseStmt: result := lsub(n.sons[0])+length('raise_'); @@ -550,7 +551,7 @@ begin nkPragma: result := lcomma(n) + 4; nkCommentStmt: result := length(n.comment); - nkOfBranch: result := lcomma(n, 0, -2) + lsub(n.sons[len-1]) + nkOfBranch: result := lcomma(n, 0, -2) + lsub(lastSon(n)) + length('of_:_'); nkElifBranch: result := lsons(n)+length('elif_:_'); nkElse: result := lsub(n.sons[0]) + length('else:_'); @@ -560,7 +561,7 @@ begin result := lcomma(n, 1) + 2; if n.sons[0] <> nil then result := result + lsub(n.sons[0]) + 2 end; - nkExceptBranch: result := lcomma(n, 0, -2) + lsub(n.sons[len-1]) + nkExceptBranch: result := lcomma(n, 0, -2) + lsub(lastSon(n)) + length('except_:_'); else result := maxLineLen+1 end @@ -576,7 +577,7 @@ end; type TSubFlag = (rfLongMode, rfNoIndent, rfInConstExpr); TSubFlags = set of TSubFlag; - TContext = record + TContext = record{@tuple} spacing: int; flags: TSubFlags; end; @@ -895,7 +896,7 @@ procedure gident(var g: TSrcGen; n: PNode); var s: string; t: TTokType; -begin +begin s := atom(n); if (s[strStart] in scanner.SymChars) then begin if (n.kind = nkIdent) then begin @@ -917,12 +918,11 @@ end; procedure gsub(var g: TSrcGen; n: PNode; const c: TContext); var - len, i: int; + L, i: int; a: TContext; begin if n = nil then exit; if n.comment <> snil then pushCom(g, n); - len := sonsLen(n); case n.kind of // atoms: nkTripleStrLit: putRawStr(g, tkTripleStrLit, n.strVal); @@ -939,11 +939,10 @@ begin nkStrLit: put(g, tkStrLit, atom(n)); nkRStrLit: put(g, tkRStrLit, atom(n)); nkCharLit: put(g, tkCharLit, atom(n)); - nkRCharLit: put(g, tkRCharLit, atom(n)); nkNilLit: put(g, tkNil, atom(n)); // complex expressions nkCall, nkConv, nkDotCall: begin - if sonsLen(n) >= 1 then + if sonsLen(n) >= 1 then gsub(g, n.sons[0]); put(g, tkParLe, '('+''); gcomma(g, n, 1); @@ -955,14 +954,10 @@ begin nkCast: begin put(g, tkCast, 'cast'); put(g, tkBracketLe, '['+''); - if sonsLen(n) = 2 then begin - gsub(g, n.sons[0]); - put(g, tkBracketRi, ']'+''); - put(g, tkParLe, '('+''); - gsub(g, n.sons[1]); - end - else - gsub(g, n.sons[0]); + gsub(g, n.sons[0]); + put(g, tkBracketRi, ']'+''); + put(g, tkParLe, '('+''); + gsub(g, n.sons[1]); put(g, tkParRi, ')'+''); end; nkAddr: begin @@ -992,17 +987,43 @@ begin putWithSpace(g, tkEquals, '='+''); gsub(g, n.sons[1]); end; - nkPar, nkRecordConstr, nkConstRecordConstr: begin + nkChckRangeF: begin + put(g, tkSymbol, 'chckRangeF'); + put(g, tkParLe, '('+''); + gcomma(g, n); + put(g, tkParRi, ')'+''); + end; + nkChckRange64: begin + put(g, tkSymbol, 'chckRange64'); + put(g, tkParLe, '('+''); + gcomma(g, n); + put(g, tkParRi, ')'+''); + end; + nkChckRange: begin + put(g, tkSymbol, 'chckRange'); + put(g, tkParLe, '('+''); + gcomma(g, n); + put(g, tkParRi, ')'+''); + end; + nkObjDownConv, nkObjUpConv, + nkStringToCString, nkCStringToString, nkPassAsOpenArray: begin + if sonsLen(n) >= 1 then + gsub(g, n.sons[0]); + put(g, tkParLe, '('+''); + gcomma(g, n, 1); + put(g, tkParRi, ')'+''); + end; + nkPar: begin put(g, tkParLe, '('+''); gcomma(g, n, c); put(g, tkParRi, ')'+''); end; - nkCurly, nkSetConstr, nkConstSetConstr: begin + nkCurly: begin put(g, tkCurlyLe, '{'+''); gcomma(g, n, c); put(g, tkCurlyRi, '}'+''); end; - nkBracket, nkArrayConstr, nkConstArrayConstr: begin + nkBracket: begin put(g, tkBracketLe, '['+''); gcomma(g, n, c); put(g, tkBracketRi, ']'+''); @@ -1012,6 +1033,7 @@ begin put(g, tkDot, '.'+''); gsub(g, n.sons[1]); end; + nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref: gsub(g, n.sons[0]); nkLambda: begin assert(n.sons[genericParamsPos] = nil); putWithSpace(g, tkLambda, 'lambda'); @@ -1023,14 +1045,15 @@ begin end; nkConstDef, nkIdentDefs: begin gcomma(g, n, 0, -3); - if n.sons[len-2] <> nil then begin + L := sonsLen(n); + if n.sons[L-2] <> nil then begin putWithSpace(g, tkColon, ':'+''); - gsub(g, n.sons[len-2]) + gsub(g, n.sons[L-2]) end; - if n.sons[len-1] <> nil then begin + if n.sons[L-1] <> nil then begin put(g, tkSpaces, Space); putWithSpace(g, tkEquals, '='+''); - gsub(g, n.sons[len-1], c) + gsub(g, n.sons[L-1], c) end; end; nkExprColonExpr: begin @@ -1063,7 +1086,7 @@ begin end; nkDerefExpr: begin gsub(g, n.sons[0]); - putWithSpace(g, tkHat, '^'+''); + putWithSpace(g, tkHat, '^'+''); // unfortunately this requires a space, because ^. would be // only one operator end; @@ -1128,13 +1151,6 @@ begin gsub(g, n.sons[2]); end end; - nkRecordTy: begin - putWithSpace(g, tkRecord, 'record'); - gsub(g, n.sons[0]); - gsub(g, n.sons[1]); - gcoms(g); - gsub(g, n.sons[2]); - end; nkObjectTy: begin putWithSpace(g, tkObject, 'object'); gsub(g, n.sons[0]); @@ -1144,7 +1160,7 @@ begin end; nkRecList: begin indentNL(g); - for i := 0 to len-1 do begin + for i := 0 to sonsLen(n)-1 do begin optNL(g); gsub(g, n.sons[i], c); gcoms(g); @@ -1214,12 +1230,13 @@ begin gsection(g, n, a, tkConst, 'const') end; nkVarSection: begin - if len = 0 then exit; + L := sonsLen(n); + if L = 0 then exit; putWithSpace(g, tkVar, 'var'); - if len > 1 then begin + if L > 1 then begin gcoms(g); indentNL(g); - for i := 0 to len-1 do begin + for i := 0 to L-1 do begin optNL(g); gsub(g, n.sons[i]); gcoms(g); @@ -1294,7 +1311,7 @@ begin gcomma(g, n, c, 0, -2); putWithSpace(g, tkColon, ':'+''); gcoms(g); - gstmts(g, n.sons[len-1], c); + gstmts(g, lastSon(n), c); end; nkElifBranch: begin optNL(g); @@ -1324,7 +1341,7 @@ begin gcomma(g, n, 0, -2); putWithSpace(g, tkColon, ':'+''); gcoms(g); - gstmts(g, n.sons[len-1], c) + gstmts(g, lastSon(n), c) end; nkGenericParams: begin put(g, tkBracketLe, '['+''); @@ -1341,6 +1358,13 @@ begin end; // XXX: gcomma(g, n, 1, -2); end; + nkTupleTy: begin + put(g, tkTuple, 'tuple'); + put(g, tkBracketLe, '['+''); + assert(n.sons[0].kind = nkIdentDefs); + gcomma(g, n); + put(g, tkBracketRi, ']'+''); + end; else begin InternalError(n.info, 'rnimsyn.gsub(' +{&} nodeKindToStr[n.kind] +{&} ')') end diff --git a/nim/rodgen.pas b/nim/rodgen.pas index a9bb17b49..8ef71dcb3 100644 --- a/nim/rodgen.pas +++ b/nim/rodgen.pas @@ -40,7 +40,7 @@ type TRodReaderFlags = set of TRodReaderFlag; const - FileVersion = '02'; // modify this if the MO2-format changes! + FileVersion = '04'; // modify this if the rod-format changes! procedure generateRod(module: PNode; const filename: string); function readRod(const filename: string; const flags: TRodReaderFlags): PNode; @@ -191,7 +191,7 @@ begin if n.comment <> snil then begin com := encode(n.comment); if ropeLen(com) >= 128 then - appRopeFormat(result, '@$1$2', [toBase62(ropeLen(com)), com]) + appf(result, '@$1$2', [toBase62(ropeLen(com)), com]) else result := com // do not emit comments to the string table as this would only increase @@ -200,33 +200,31 @@ begin // Line information takes easily 50% or more of the filesize! Therefore we // omit line information if it is the same as the father's line information: if (finfo.line <> int(n.info.line)) then - appRopeFormat(result, '?$1,$2', [toBase62(n.info.col), + appf(result, '?$1,$2', [toBase62(n.info.col), toBase62(n.info.line)]) else if (finfo.col <> int(n.info.col)) then - appRopeFormat(result, '?$1', [toBase62(n.info.col)]); + appf(result, '?$1', [toBase62(n.info.col)]); // No need to output the file index, as this is the serialization of one // file. - if n.base <> base10 then - appRopeFormat(result, '$$$1', [toBase62(ord(n.base))]); + if n.flags <> {@set}[] then + appf(result, '$$$1', [toBase62({@cast}int(n.flags))]); case n.kind of nkCharLit..nkInt64Lit: - appRopeFormat(result, '!$1', [toBase62(n.intVal)]); + appf(result, '!$1', [toBase62(n.intVal)]); nkFloatLit..nkFloat64Lit: - appRopeFormat(result, '!$1', [toRopeF(n.floatVal)]); + appf(result, '!$1', [toRopeF(n.floatVal)]); nkStrLit..nkTripleStrLit: - appRopeFormat(result, '!$1', [encode(n.strVal)]); + appf(result, '!$1', [encode(n.strVal)]); nkSym: assert(false); nkIdent: - appRopeFormat(result, '!$1', [encodeIdent(g, n.ident)]); + appf(result, '!$1', [encodeIdent(g, n.ident)]); else begin for i := 0 to sonsLen(n)-1 do app(result, encodeNode(g, n.info, n.sons[i])); end end; len := ropeLen(result); - result := ropeFormat('$1$2$3', [toRope(chr(ord(n.kind)+128)+''), - toBase62(len), result]); - assert(ord(n.kind)+128 < 256); + result := ropef('$1$2$3', [toBase62(ord(n.kind)), toBase62(len), result]); end; procedure generateRod(module: PNode; const filename: string); @@ -235,16 +233,15 @@ var ast: PRope; info: TLineInfo; begin - assert(ord(high(TNodeKind))+1 < 127); initTable(g.identTab); g.idents := nil; info := newLineInfo(changeFileExt(filename, '.nim'), -1, -1); ast := encodeNode(g, info, module); - writeRope(ropeFormat('AA02 $1 $2,$3 $4 $5', - [toRope(FileVersion), - toBase62(ropeLen(g.idents)), toBase62(ropeLen(ast)), - g.idents, ast]), filename); + writeRope(ropef('AA02 $1 $2,$3 $4 $5', + [toRope(FileVersion), + toBase62(ropeLen(g.idents)), toBase62(ropeLen(ast)), + g.idents, ast]), filename); end; // ----------------------- reader --------------------------------------------- @@ -344,8 +341,8 @@ begin if r.s[i] = #255 then begin inc(r.pos); exit // nil node end; - assert(r.s[i] >= #128); - kind := TNodeKind(ord(r.s[i])-int(128)); + i := fromBase62i(r.s, i, x); + kind := TNodeKind(x); assert((kind >= low(TNodeKind)) and (kind <= high(TNodeKind))); inc(i); // skip kind i := fromBase62i(r.s, i, len); @@ -386,7 +383,7 @@ begin if r.s[i] = '$' then begin inc(i); i := fromBase62i(r.s, i, x); - result.base := TNumericalBase(x); + result.flags := {@cast}TNodeFlags(x); end; // atom: if r.s[i] = '!' then begin @@ -413,7 +410,7 @@ begin end else if r.s[i] >= #128 then begin case kind of - nkCharLit..nkInt64Lit, nkFloatLit..nkFloat64Lit, + nkCharLit..nkInt64Lit, nkFloatLit..nkFloat64Lit, nkStrLit..nkTripleStrLit, nkSym, nkIdent: assert(false); else begin end; end; diff --git a/nim/ropes.pas b/nim/ropes.pas index 48a38d7b4..0e4b4981b 100644 --- a/nim/ropes.pas +++ b/nim/ropes.pas @@ -111,9 +111,9 @@ function writeRopeIfNotEqual(r: PRope; const filename: string): boolean; function ropeToStr(p: PRope): string; -function ropeFormat(const frmt: TFormatStr; const args: array of PRope): PRope; +function ropef(const frmt: TFormatStr; const args: array of PRope): PRope; -procedure appRopeFormat(var c: PRope; const frmt: TFormatStr; +procedure appf(var c: PRope; const frmt: TFormatStr; const args: array of PRope); procedure RopeSeqInsert(var rs: TRopeSeq; r: PRope; at: Natural); @@ -123,6 +123,9 @@ function getCacheStats: string; function RopeEqualsFile(r: PRope; const f: string): Boolean; // returns true if the rope r is the same as the contents of file f +function RopeInvariant(r: PRope): Boolean; +// exported for debugging + implementation function ropeLen(a: PRope): int; @@ -137,8 +140,10 @@ begin {@ignore} fillChar(result^, sizeof(TRope), 0); {@emit} - result.len := length(data); - result.data := data; + if data <> snil then begin + result.len := length(data); + result.data := data; + end end; // -------------- leaf cache: --------------------------------------- @@ -221,6 +226,23 @@ begin end end; +function RopeInvariant(r: PRope): Boolean; +begin + if r = nil then + result := true + else begin + result := true + (* + if r.data <> snil then + result := true + else begin + result := (r.left <> nil) and (r.right <> nil); + if result then result := ropeInvariant(r.left); + if result then result := ropeInvariant(r.right); + end *) + end +end; + function toRope(const s: string): PRope; begin if s = '' then @@ -230,7 +252,8 @@ begin cache := result; end else - result := newRope(s) + result := newRope(s); + assert(RopeInvariant(result)); end; // ------------------------------------------------------------------ @@ -251,14 +274,6 @@ begin rs[at] := r end; -function RopeInvariant(r: PRope): Boolean; -begin - if r = nil then - result := true - else - result := true -end; - function con(a, b: PRope): PRope; overload; begin assert(RopeInvariant(a)); @@ -325,7 +340,8 @@ var i: int; begin result := nil; - for i := 0 to high(a) do result := con(result, a[i]) + for i := 0 to high(a) do result := con(result, a[i]); + assert(RopeInvariant(result)); end; function toRope(i: BiggestInt): PRope; @@ -340,17 +356,45 @@ end; procedure app(var a: PRope; b: PRope); overload; begin - a := con(a, b) + a := con(a, b); + assert(RopeInvariant(a)); end; procedure app(var a: PRope; const b: string); overload; begin a := con(a, b); + assert(RopeInvariant(a)); end; procedure prepend(var a: PRope; b: PRope); begin - a := con(b, a) + a := con(b, a); + assert(RopeInvariant(a)); +end; + +procedure InitStack(var stack: TRopeSeq); +begin + {@ignore} + setLength(stack, 0); + {@emit stack := [];} +end; + +procedure push(var stack: TRopeSeq; r: PRope); +var + len: int; +begin + len := length(stack); + setLength(stack, len+1); + stack[len] := r; +end; + +function pop(var stack: TRopeSeq): PRope; +var + len: int; +begin + len := length(stack); + result := stack[len-1]; + setLength(stack, len-1); end; procedure WriteRopeRec(var f: TTextFile; c: PRope); @@ -367,12 +411,32 @@ begin end end; +procedure newWriteRopeRec(var f: TTextFile; c: PRope); +var + stack: TRopeSeq; + it: PRope; +begin + assert(RopeInvariant(c)); + initStack(stack); + push(stack, c); + while length(stack) > 0 do begin + it := pop(stack); + while it.data = snil do begin + push(stack, it.right); + it := it.left; + assert(it <> nil); + end; + assert(it.data <> snil); + nimWrite(f, it.data); + end +end; + procedure WriteRope(head: PRope; const filename: string); var f: TTextFile; // we use a textfile for automatic buffer handling begin if OpenFile(f, filename, fmWrite) then begin - writeRopeRec(f, head); + if head <> nil then newWriteRopeRec(f, head); nimCloseFile(f); end end; @@ -391,17 +455,42 @@ begin end end; +procedure newRecRopeToStr(var result: string; var resultLen: int; + r: PRope); +var + stack: TRopeSeq; + it: PRope; +begin + initStack(stack); + push(stack, r); + while length(stack) > 0 do begin + it := pop(stack); + while it.data = snil do begin + push(stack, it.right); + it := it.left; + end; + assert(it.data <> snil); + CopyMem(@result[resultLen+StrStart], @it.data[strStart], it.len); + Inc(resultLen, it.len); + assert(resultLen <= length(result)); + end +end; + function ropeToStr(p: PRope): string; var resultLen: int; begin assert(RopeInvariant(p)); - result := newString(p.len); - resultLen := 0; - recRopeToStr(result, resultLen, p); + if p = nil then + result := '' + else begin + result := newString(p.len); + resultLen := 0; + newRecRopeToStr(result, resultLen, p); + end end; -function ropeFormat(const frmt: TFormatStr; const args: array of PRope): PRope; +function ropef(const frmt: TFormatStr; const args: array of PRope): PRope; var i, j, len, start: int; begin @@ -424,7 +513,7 @@ begin app(result, args[j-1]); end; 'N', 'n': begin app(result, tnl); inc(i); end; - else InternalError('ropes: invalid format string$' + frmt[i]); + else InternalError('ropes: invalid format string $' + frmt[i]); end end; start := i; @@ -435,10 +524,10 @@ begin assert(RopeInvariant(result)); end; -procedure appRopeFormat(var c: PRope; const frmt: TFormatStr; +procedure appf(var c: PRope; const frmt: TFormatStr; const args: array of PRope); begin - app(c, ropeformat(frmt, args)) + app(c, ropef(frmt, args)) end; const @@ -495,9 +584,30 @@ begin end end; +function newCrcFromRopeAux(r: PRope; startVal: TCrc32): TCrc32; +var + stack: TRopeSeq; + it: PRope; + i: int; +begin + initStack(stack); + push(stack, r); + result := startVal; + while length(stack) > 0 do begin + it := pop(stack); + while it.data = snil do begin + push(stack, it.right); + it := it.left; + end; + assert(it.data <> snil); + for i := strStart to length(it.data)+strStart-1 do + result := updateCrc32(it.data[i], result); + end +end; + function crcFromRope(r: PRope): TCrc32; begin - result := crcFromRopeAux(r, initCrc32) + result := newCrcFromRopeAux(r, initCrc32) end; function writeRopeIfNotEqual(r: PRope; const filename: string): boolean; diff --git a/nim/rst.pas b/nim/rst.pas index d6452ceae..54958aff2 100644 --- a/nim/rst.pas +++ b/nim/rst.pas @@ -102,17 +102,17 @@ type ); const rstnodekindToStr: array [TRstNodeKind] of string = ( - 'Inner', 'Headline', 'Overline', 'Transition', 'Paragraph', - 'BulletList', 'BulletItem', 'EnumList', 'EnumItem', 'DefList', 'DefItem', - 'DefName', 'DefBody', 'FieldList', 'Field', 'FieldName', 'FieldBody', - 'OptionList', 'OptionListItem', 'OptionGroup', 'Option', 'OptionString', - 'OptionArgument', 'Description', 'LiteralBlock', 'QuotedLiteralBlock', - 'LineBlock', 'LineBlockItem', 'BlockQuote', 'Table', 'GridTable', - 'TableRow', 'TableHeaderCell', 'TableDataCell', 'Label', 'Footnote', - 'Citation', 'StandaloneHyperlink', 'Hyperlink', 'Ref', 'Directive', - 'DirArg', 'Raw', 'Title', 'Contents', 'Image', 'Figure', 'CodeBlock', + 'Inner', 'Headline', 'Overline', 'Transition', 'Paragraph', + 'BulletList', 'BulletItem', 'EnumList', 'EnumItem', 'DefList', 'DefItem', + 'DefName', 'DefBody', 'FieldList', 'Field', 'FieldName', 'FieldBody', + 'OptionList', 'OptionListItem', 'OptionGroup', 'Option', 'OptionString', + 'OptionArgument', 'Description', 'LiteralBlock', 'QuotedLiteralBlock', + 'LineBlock', 'LineBlockItem', 'BlockQuote', 'Table', 'GridTable', + 'TableRow', 'TableHeaderCell', 'TableDataCell', 'Label', 'Footnote', + 'Citation', 'StandaloneHyperlink', 'Hyperlink', 'Ref', 'Directive', + 'DirArg', 'Raw', 'Title', 'Contents', 'Image', 'Figure', 'CodeBlock', 'Index', 'SubstitutionDef', 'GeneralRole', 'Sub', 'Sup', 'Idx', - 'Emphasis', 'StrongEmphasis', 'InterpretedText', 'InlineLiteral', + 'Emphasis', 'StrongEmphasis', 'InterpretedText', 'InlineLiteral', 'SubstitutionReferences', 'Leaf' ); @@ -144,7 +144,7 @@ function rstnodeToRefname(n: PRstNode): string; function getFieldValue(n: PRstNode; const fieldname: string): string; function getArgument(n: PRstNode): string; -// index handling: +// index handling: procedure setIndexPair(index, key, val: PRstNode); procedure sortIndex(a: PRstNode); procedure clearIndex(index: PRstNode; const filename: string); @@ -329,7 +329,7 @@ begin end; if tokens[0].kind = tkWhite then begin // BUGFIX tokens[0].ival := length(tokens[0].symbol); - tokens[0].kind := tkIndent + tokens[0].kind := tkIndent end end; @@ -359,7 +359,9 @@ begin new(result); {@ignore} fillChar(result^, sizeof(result^), 0); -{@emit} +{@emit + result.sons := []; +} result.kind := kind; end; @@ -457,6 +459,10 @@ begin p.indentStack := [0];} {@emit p.tok := [];} + p.idx := 0; + p.filename := ''; + p.hasToc := false; + p.col := 0; p.line := 1; p.s := sharedState; end; @@ -581,7 +587,7 @@ end; procedure sortIndex(a: PRstNode); // we use shellsort here; fast and simple -var +var N, i, j, h: int; v: PRstNode; begin @@ -589,7 +595,7 @@ begin N := rsonsLen(a); h := 1; repeat h := 3*h+1; until h > N; repeat - h := h div 3; + h := h div 3; for i := h to N-1 do begin v := a.sons[i]; j := i; while cmpNodes(a.sons[j-h], v) >= 0 do begin @@ -607,11 +613,11 @@ var begin result := false; if a.kind <> b.kind then exit; - if a.kind = rnLeaf then + if a.kind = rnLeaf then result := a.text = b.text else begin if rsonsLen(a) <> rsonsLen(b) then exit; - for i := 0 to rsonsLen(a)-1 do + for i := 0 to rsonsLen(a)-1 do if not eqRstNodes(a.sons[i], b.sons[i]) then exit; result := true end @@ -627,7 +633,7 @@ begin end else if h.kind = rnHyperlink then begin s := addNodes(h.sons[1]); - if startsWith(s, filename) and (s[length(filename)+strStart] = '#') then + if startsWith(s, filename) and (s[length(filename)+strStart] = '#') then result := true else result := false @@ -650,7 +656,7 @@ begin items := rsonsLen(val); lastItem := -1; // save the last valid item index for j := 0 to rsonsLen(val)-1 do begin - if val.sons[j] = nil then + if val.sons[j] = nil then dec(items) else if matchesHyperlink(val.sons[j].sons[0], filename) then begin val.sons[j] := nil; @@ -663,7 +669,7 @@ begin else if items = 0 then index.sons[i] := nil end - else if matchesHyperlink(val, filename) then + else if matchesHyperlink(val, filename) then index.sons[i] := nil end; // remove nil nodes: @@ -702,14 +708,14 @@ begin b := newRstNode(rnBulletItem); addSon(b, val); addSon(e, b); - + exit // key already exists end end; e := newRstNode(rnDefItem); assert(val.kind <> rnDefBody); b := newRstNode(rnDefBody); - addSon(b, val); + addSon(b, val); addSon(e, a); addSon(e, b); addSon(index, e); @@ -730,7 +736,7 @@ begin while true do begin case p.tok[p.idx].kind of tkWord, tkOther, tkWhite: addSon(res, newLeaf(p)); - tkPunct: + tkPunct: if p.tok[p.idx].symbol = endStr then begin inc(p.idx); break end else addSon(res, newLeaf(p)); else begin @@ -746,13 +752,13 @@ end; function untilEol(var p: TRstParser): PRstNode; begin result := newRstNode(rnInner); - while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin + while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin addSon(result, newLeaf(p)); inc(p.idx); end end; procedure expect(var p: TRstParser; const tok: string); -begin +begin if p.tok[p.idx].symbol = tok then inc(p.idx) else rstMessage(p, errXexpected, tok) end; @@ -953,7 +959,7 @@ begin end else if match(p, p.idx, ':w:') then begin // a role: - if p.tok[p.idx+1].symbol = 'idx' then + if p.tok[p.idx+1].symbol = 'idx' then n.kind := rnIdx else if p.tok[p.idx+1].symbol = 'literal' then n.kind := rnInlineLiteral @@ -1345,14 +1351,14 @@ var j: int; begin j := tokenAfterNewline(p); - result := (p.tok[p.idx].col < p.tok[j].col) + result := (p.tok[p.idx].col < p.tok[j].col) and (p.tok[j].kind in [tkWord, tkOther, tkPunct]) and (p.tok[j-2].symbol <> '::'); end; function whichSection(const p: TRstParser): TRstNodeKind; begin - case p.tok[p.idx].kind of + case p.tok[p.idx].kind of tkAdornment: begin if match(p, p.idx+1, 'ii') then result := rnTransition else if match(p, p.idx+1, ' a') then result := rnTable @@ -1362,21 +1368,21 @@ begin tkPunct: begin if match(p, tokenAfterNewLine(p), 'ai') then result := rnHeadline - else if p.tok[p.idx].symbol = '::' then + else if p.tok[p.idx].symbol = '::' then result := rnLiteralBlock else if predNL(p) and ((p.tok[p.idx].symbol = '+'+'') or (p.tok[p.idx].symbol = '*'+'') or - (p.tok[p.idx].symbol = '-'+'')) - and (p.tok[p.idx+1].kind = tkWhite) then + (p.tok[p.idx].symbol = '-'+'')) + and (p.tok[p.idx+1].kind = tkWhite) then result := rnBulletList else if (p.tok[p.idx].symbol = '|'+'') and isLineBlock(p) then result := rnLineBlock - else if (p.tok[p.idx].symbol = '..') and predNL(p) then + else if (p.tok[p.idx].symbol = '..') and predNL(p) then result := rnDirective - else if (p.tok[p.idx].symbol = ':'+'') and predNL(p) then + else if (p.tok[p.idx].symbol = ':'+'') and predNL(p) then result := rnFieldList - else if match(p, p.idx, '(e) ') then + else if match(p, p.idx, '(e) ') then result := rnEnumList else if match(p, p.idx, '+a+') then begin result := rnGridTable; @@ -1384,14 +1390,14 @@ begin end else if isDefList(p) then result := rnDefList - else if match(p, p.idx, '-w') or match(p, p.idx, '--w') - or match(p, p.idx, '/w') then + else if match(p, p.idx, '-w') or match(p, p.idx, '--w') + or match(p, p.idx, '/w') then result := rnOptionList else result := rnParagraph end; tkWord, tkOther, tkWhite: begin - if match(p, tokenAfterNewLine(p), 'ai') then + if match(p, tokenAfterNewLine(p), 'ai') then result := rnHeadline else if isDefList(p) then result := rnDefList @@ -1440,7 +1446,7 @@ begin else if (p.tok[p.idx].ival = currInd(p)) then begin inc(p.idx); case whichSection(p) of - rnParagraph, rnLeaf, rnHeadline, rnOverline, rnDirective: + rnParagraph, rnLeaf, rnHeadline, rnOverline, rnDirective: addSon(result, newRstNode(rnLeaf, ' '+'')); rnLineBlock: addSonIfNotNil(result, parseLineBlock(p)); else break; @@ -1509,7 +1515,7 @@ begin if p.tok[p.idx].kind <> tkAdornment then break end; if p.tok[p.idx].kind = tkIndent then inc(p.idx); - // last column has no limit: + // last column has no limit: cols[L-1] := 32000; end; @@ -1543,12 +1549,12 @@ begin end; getColumns(p, cols); setLength(row, length(cols)); - if a <> nil then + if a <> nil then for j := 0 to rsonsLen(a)-1 do a.sons[j].kind := rnTableHeaderCell; end; if p.tok[p.idx].kind = tkEof then break; for j := 0 to high(row) do row[j] := ''; - // the following while loop iterates over the lines a single cell may span: + // the following while loop iterates over the lines a single cell may span: line := p.tok[p.idx].line; while true do begin i := 0; @@ -1602,7 +1608,7 @@ begin parseLine(p, result); if p.tok[p.idx].kind = tkIndent then begin inc(p.idx); - if p.tok[p.idx-1].ival > currInd(p) then + if p.tok[p.idx-1].ival > currInd(p) then addSon(result, newRstNode(rnLeaf, ' '+'')) else break @@ -1649,22 +1655,22 @@ var begin result := newRstNode(rnOptionList); while true do begin - if match(p, p.idx, '-w') - or match(p, p.idx, '--w') + if match(p, p.idx, '-w') + or match(p, p.idx, '--w') or match(p, p.idx, '/w') then begin a := newRstNode(rnOptionGroup); b := newRstNode(rnDescription); c := newRstNode(rnOptionListItem); while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin - if (p.tok[p.idx].kind = tkWhite) - and (length(p.tok[p.idx].symbol) > 1) then begin - inc(p.idx); break + if (p.tok[p.idx].kind = tkWhite) + and (length(p.tok[p.idx].symbol) > 1) then begin + inc(p.idx); break end; addSon(a, newLeaf(p)); inc(p.idx); end; j := tokenAfterNewline(p); - if (j > 0) and (p.tok[j-1].kind = tkIndent) + if (j > 0) and (p.tok[j-1].kind = tkIndent) and (p.tok[j-1].ival > currInd(p)) then begin pushInd(p, p.tok[j-1].ival); parseSection(p, b); @@ -1719,8 +1725,8 @@ begin inc(p.idx); j := tokenAfterNewLine(p)-1; if (j >= 1) and (p.tok[j].kind = tkIndent) - and (p.tok[j].ival > col) - and (p.tok[j-1].symbol <> '::') + and (p.tok[j].ival > col) + and (p.tok[j-1].symbol <> '::') and (p.tok[j+1].kind <> tkIndent) then begin end else break end @@ -1784,6 +1790,7 @@ var begin while true do begin leave := false; + assert(p.idx >= 0); while p.tok[p.idx].kind = tkIndent do begin if currInd(p) = p.tok[p.idx].ival then begin inc(p.idx); @@ -1837,12 +1844,12 @@ begin addSonIfNotNil(result, a); end; //if (result.kind in [rnBulletItem]) and - if (sonKind(result, 0) = rnParagraph) - and (sonKind(result, 1) <> rnParagraph) then + if (sonKind(result, 0) = rnParagraph) + and (sonKind(result, 1) <> rnParagraph) then result.sons[0].kind := rnInner; (* if (result.kind <> rnInner) and (rsonsLen(result) = 1) - and (result.sons[0].kind = rnParagraph) then + and (result.sons[0].kind = rnParagraph) then result.sons[0].kind := rnInner; *) end; @@ -1857,7 +1864,7 @@ end; function parseDoc(var p: TRstParser): PRstNode; begin result := parseSectionWrapper(p); - if p.tok[p.idx].kind <> tkEof then + if p.tok[p.idx].kind <> tkEof then rstMessage(p, errGeneralParseError); end; @@ -1865,14 +1872,14 @@ type TDirFlag = (hasArg, hasOptions, argIsFile); TDirFlags = set of TDirFlag; TSectionParser = function (var p: TRstParser): PRstNode; - + {@emit function assigned(contentParser: TSectionParser): bool; begin result := contentParser <> nil; end; } - + function parseDirective(var p: TRstParser; flags: TDirFlags; contentParser: TSectionParser): PRstNode; var @@ -1905,7 +1912,7 @@ begin options := parseFields(p); end; addSon(result, options); - if (assigned(contentParser)) and (p.tok[p.idx].kind = tkIndent) + if (assigned(contentParser)) and (p.tok[p.idx].kind = tkIndent) and (p.tok[p.idx].ival > currInd(p)) then begin pushInd(p, p.tok[p.idx].ival); //while p.tok[p.idx].kind = tkIndent do inc(p.idx); @@ -1985,7 +1992,7 @@ end; function dirFigure(var p: TRstParser): PRstNode; begin - result := parseDirective(p, {@set}[hasOptions, hasArg, argIsFile], + result := parseDirective(p, {@set}[hasOptions, hasArg, argIsFile], parseSectionWrapper); result.kind := rnFigure end; diff --git a/nim/scanner.pas b/nim/scanner.pas index 8e5bc3fc5..b9a61f95d 100644 --- a/nim/scanner.pas +++ b/nim/scanner.pas @@ -62,15 +62,15 @@ type tkMacro, tkMethod, tkMod, tkNil, tkNot, tkNotin, tkObject, tkOf, tkOr, tkOut, tkProc, tkPtr, - tkRaise, tkRecord, tkRef, tkReturn, - tkShl, tkShr, tkTemplate, tkTry, + tkRaise, tkRef, tkReturn, tkShl, + tkShr, tkTemplate, tkTry, tkTuple, tkType, tkVar, tkWhen, tkWhere, tkWhile, tkWith, tkWithout, tkXor, tkYield, //[[[end]]] tkIntLit, tkInt8Lit, tkInt16Lit, tkInt32Lit, tkInt64Lit, tkFloatLit, tkFloat32Lit, tkFloat64Lit, - tkStrLit, tkRStrLit, tkTripleStrLit, tkCharLit, tkRCharLit, + tkStrLit, tkRStrLit, tkTripleStrLit, tkCharLit, tkParLe, tkParRi, tkBracketLe, tkBracketRi, tkCurlyLe, tkCurlyRi, tkBracketDotLe, tkBracketDotRi, // [. and .] tkCurlyDotLe, tkCurlyDotRi, // {. and .} @@ -106,15 +106,15 @@ const 'macro', 'method', 'mod', 'nil', 'not', 'notin', 'object', 'of', 'or', 'out', 'proc', 'ptr', - 'raise', 'record', 'ref', 'return', - 'shl', 'shr', 'template', 'try', + 'raise', 'ref', 'return', 'shl', + 'shr', 'template', 'try', 'tuple', 'type', 'var', 'when', 'where', 'while', 'with', 'without', 'xor', 'yield', //[[[end]]] 'tkIntLit', 'tkInt8Lit', 'tkInt16Lit', 'tkInt32Lit', 'tkInt64Lit', 'tkFloatLit', 'tkFloat32Lit', 'tkFloat64Lit', - 'tkStrLit', 'tkRStrLit', 'tkTripleStrLit', 'tkCharLit', 'tkRCharLit', + 'tkStrLit', 'tkRStrLit', 'tkTripleStrLit', 'tkCharLit', '('+'', ')'+'', '['+'', ']'+'', '{'+'', '}'+'', '[.', '.]', '{.', '.}', '(.', '.)', ','+'', ';'+'', ':'+'', '='+'', '.'+'', '..', '^'+'', 'tkOpr', @@ -124,6 +124,11 @@ const ); type + TNumericalBase = (base10, // base10 is listed as the first element, + // so that it is the correct default value + base2, + base8, + base16); PToken = ^TToken; TToken = object // a Nimrod token tokType: TTokType; // the type of the token @@ -210,7 +215,7 @@ begin result := toString(tok.iNumber); tkFloatLit..tkFloat64Lit: result := toStringF(tok.fNumber); - tkInvalid, tkStrLit..tkRCharLit, tkComment: + tkInvalid, tkStrLit..tkCharLit, tkComment: result := tok.literal; tkParLe..tkColon, tkEof, tkInd, tkSad, tkDed, tkAccent: result := tokTypeToStr[tok.tokType]; @@ -510,7 +515,13 @@ begin if result.tokType = tkIntLit then result.tokType := tkFloatLit; end else begin - result.iNumber := ParseInt(result.literal) + result.iNumber := ParseBiggestInt(result.literal); + if (result.iNumber < low(int32)) or (result.iNumber > high(int32)) then + begin + if result.tokType = tkIntLit then result.tokType := tkInt64Lit + else if result.tokType <> tkInt64Lit then + lexMessage(L, errInvalidNumber, result.literal); + end end; except on EInvalidValue do @@ -682,7 +693,7 @@ begin end end; -procedure getCharacter(var L: TLexer; var tok: TToken; rawMode: Boolean); +procedure getCharacter(var L: TLexer; var tok: TToken); var c: Char; begin @@ -690,13 +701,7 @@ begin c := L.buf[L.bufpos]; case c of #0..Pred(' '), '''': lexMessage(L, errInvalidCharacterConstant); - '\': begin - if not rawMode then - getEscapedChar(L, tok) - else begin - tok.literal := '\'+''; Inc(L.bufpos); - end - end + '\': getEscapedChar(L, tok); else begin tok.literal := c + ''; Inc(L.bufpos); @@ -923,18 +928,11 @@ begin getSymbol(L, tok); end; 'r', 'R': begin - case L.buf[L.bufPos+1] of - '''': begin - Inc(L.bufPos); - getCharacter(L, tok, true); - tok.tokType := tkRCharLit; - end; - '"': begin - Inc(L.bufPos); - getString(L, tok, true); - end; - else getSymbol(L, tok); + if L.buf[L.bufPos+1] = '"' then begin + Inc(L.bufPos); + getString(L, tok, true); end + else getSymbol(L, tok); end; '(': begin Inc(L.bufpos); @@ -1004,7 +1002,7 @@ begin end; '"': getString(L, tok, false); '''': begin - getCharacter(L, tok, false); + getCharacter(L, tok); tok.tokType := tkCharLit; end; lexbase.EndOfFile: tok.toktype := tkEof; diff --git a/nim/sem.pas b/nim/sem.pas index 48a967d35..d57af7be6 100644 --- a/nim/sem.pas +++ b/nim/sem.pas @@ -21,7 +21,7 @@ uses extccomp, nmath, magicsys, nversion, nimsets, pnimsyn, ntime, backends; const - genPrefix = '::'+''; // prefix for generated names + genPrefix = '::'; // prefix for generated names type TOptionEntry = object(lists.TListEntry) @@ -48,6 +48,7 @@ type owner: PSym; // current owner forStmt: PNode; // current for stmt next: PTransCon; + params: TNodeSeq; // parameters passed to the proc end; PContext = ^TContext; @@ -65,6 +66,7 @@ type b: PBackend; p: PProcCon; // procedure context transCon: PTransCon; // top of a TransCon stack + lastException: PNode; // last exception importModule: function (const filename: string; backend: PBackend): PSym; includeFile: function (const filename: string): PNode; end; @@ -87,6 +89,7 @@ begin fillChar(result^, sizeof(result^), 0); {@emit} initIdNodeTable(result.mapping); +{@emit result.params := [];} end; procedure pushTransCon(c: PContext; t: PTransCon); @@ -140,13 +143,26 @@ begin append(result.optionStack, newOptionEntry()); result.module := nil; result.generics := newNode(nkStmtList); +{@emit result.converters := [];} +end; + +procedure addConverter(c: PContext; conv: PSym); +var + i, L: int; +begin + L := length(c.converters); + for i := 0 to L-1 do + if c.converters[i].id = conv.id then exit; + setLength(c.converters, L+1); + c.converters[L] := conv; end; // -------------------- embedded debugger ------------------------------------ procedure embeddedDbg(c: PContext; n: PNode); begin - {@discard} inCheckpoint(n.info) + if optVerbose in gGlobalOptions then liMessage(n.info, hintProcessing); + //{@discard} inCheckpoint(n.info) end; // --------------------------------------------------------------------------- @@ -207,10 +223,13 @@ var begin x := n; if x.kind = nkAccQuoted then x := x.sons[0]; - if x.kind = nkIdent then result := x.ident - else begin - liMessage(n.info, errIdentifierExpected); - result := nil + case x.kind of + nkIdent: result := x.ident; + nkSym: result := x.sym.name; + else begin + liMessage(n.info, errIdentifierExpected, renderTree(n)); + result := nil + end end end; @@ -251,6 +270,13 @@ begin addSon(result, baseType); end; +function makeVarType(c: PContext; baseType: PType): PType; +begin + assert(baseType <> nil); + result := newTypeS(tyVar, c); + addSon(result, baseType); +end; + {$include 'lookup.pas'} function semIdentVis(c: PContext; kind: TSymKind; n: PNode; @@ -261,10 +287,15 @@ function semIdentWithPragma(c: PContext; kind: TSymKind; function semStmt(c: PContext; n: PNode): PNode; forward; function semStmtScope(c: PContext; n: PNode): PNode; forward; + +type + TExprFlag = (efAllowType, efLValue); + TExprFlags = set of TExprFlag; + function semExpr(c: PContext; n: PNode; - typeAllowed: bool = false): PNode; forward; + flags: TExprFlags = {@set}[]): PNode; forward; function semExprWithType(c: PContext; n: PNode; - typeAllowed: bool): PNode; forward; + flags: TExprFlags = {@set}[]): PNode; forward; function semLambda(c: PContext; n: PNode): PNode; forward; function semTypeNode(c: PContext; n: PNode; prev: PType): PType; forward; @@ -275,6 +306,11 @@ function getConstExpr(c: PContext; n: PNode): PNode; forward; // evaluates the constant expression or returns nil if it is no constant // expression +function eval(c: PContext; n: PNode): PNode; forward; +// eval never returns nil! This simplifies the code a lot and +// makes it faster too. + + {$include 'semtempl.pas'} {$include 'instgen.pas'} {$include 'sigmatch.pas'} @@ -303,6 +339,11 @@ begin if (n = nil) or (sonsLen(n) <> len) then illFormedAst(n); end; +procedure checkMinSonsLen(n: PNode; len: int); +begin + if (n = nil) or (sonsLen(n) < len) then illFormedAst(n); +end; + procedure typeMismatch(n: PNode; formal, actual: PType); begin liMessage(n.Info, errGenerated, @@ -315,6 +356,7 @@ end; {$include 'transf.pas'} {$include 'semstmts.pas'} {$include 'semfold.pas'} +{$include 'eval.pas'} function semp(c: PContext; n: PNode): PNode; begin @@ -329,7 +371,7 @@ begin for i := 0 to sonsLen(c.generics)-1 do begin assert(c.generics.sons[i].sons[1].kind = nkSym); prc := c.generics.sons[i].sons[1].sym; - if (prc.kind = skProc) and (prc.magic = mNone) then begin + if (prc.kind in [skProc, skConverter]) and (prc.magic = mNone) then begin addSon(n, prc.ast); end end @@ -350,4 +392,7 @@ begin c.p := nil; end; +initialization + new(emptyNode); + emptyNode.kind := nkEmpty; end. diff --git a/nim/semexprs.pas b/nim/semexprs.pas index 66f9b1e3f..699998a94 100644 --- a/nim/semexprs.pas +++ b/nim/semexprs.pas @@ -10,32 +10,34 @@ // this module does the semantic checking for expressions -function semDotExpr(c: PContext; n: PNode; typeAllowed: bool): PNode; forward; +function semDotExpr(c: PContext; n: PNode; + flags: TExprFlags = {@set}[]): PNode; forward; function semExprWithType(c: PContext; n: PNode; - typeAllowed: bool): PNode; + flags: TExprFlags = {@set}[]): PNode; +var + d: PNode; begin - result := semExpr(c, n, typeAllowed); + result := semExpr(c, n, flags); if result.typ = nil then liMessage(n.info, errExprXHasNoType, renderTree(result, {@set}[renderNoComments])); + if result.typ.kind = tyVar then begin + d := newNodeIT(nkHiddenDeref, result.info, result.typ.sons[0]); + addSon(d, result); + result := d + end end; procedure checkConversionBetweenObjects(const info: TLineInfo; castDest, src: PType); var - d, s: PType; + diff: int; begin - // conversion to superclass? - d := castDest; - while (d <> src) and (d <> nil) do d := base(d); - if d = src then exit; // is ok - // conversion to baseclass? - s := src; - while (castDest <> s) and (s <> nil) do s := base(s); - if (castDest = s) then + diff := inheritanceDiff(castDest, src); + if diff = 0 then liMessage(info, hintConvToBaseNotNeeded) - else + else if diff = high(int) then liMessage(info, errGenerated, format(MsgKindToString(errIllegalConvFromXtoY), [typeToString(src), typeToString(castDest)])); @@ -95,35 +97,29 @@ begin else if ss < 0 then result := false else result := (ds >= ss) or - (castDest.kind in [tyInt..tyFloat128]) and // BUGFIX + (castDest.kind in [tyInt..tyFloat128]) or (src.kind in [tyInt..tyFloat128]) end; function semConv(c: PContext; n: PNode; s: PSym): PNode; begin - if sonsLen(n) = 2 then begin - result := newNode(nkConv); - result.info := n.info; - result.typ := semTypeNode(c, n.sons[0], nil); - addSon(result, semExprWithType(c, n.sons[1], false)); - checkConvertible(result.info, result.typ, result.sons[0].typ); - end - else begin - liMessage(n.info, errConvNeedsOneArg); - result := nil - end + if sonsLen(n) <> 2 then liMessage(n.info, errConvNeedsOneArg); + result := newNodeI(nkConv, n.info); + result.typ := semTypeNode(c, n.sons[0], nil); + addSon(result, copyTree(n.sons[0])); + addSon(result, semExprWithType(c, n.sons[1])); + checkConvertible(result.info, result.typ, result.sons[1].typ); end; function semCast(c: PContext; n: PNode): PNode; begin - if optSafeCode in gGlobalOptions then - liMessage(n.info, errCastNotInSafeMode); - assert(sonsLen(n) = 2); - result := newNode(nkCast); - result.info := n.info; + if optSafeCode in gGlobalOptions then liMessage(n.info, errCastNotInSafeMode); + checkSonsLen(n, 2); + result := newNodeI(nkCast, n.info); result.typ := semTypeNode(c, n.sons[0], nil); - addSon(result, semExprWithType(c, n.sons[1], false)); - if not isCastable(result.typ, result.sons[0].Typ) then + addSon(result, copyTree(n.sons[0])); + addSon(result, semExprWithType(c, n.sons[1])); + if not isCastable(result.typ, result.sons[1].Typ) then liMessage(result.info, errExprCannotBeCastedToX, typeToString(result.Typ)); end; @@ -136,7 +132,7 @@ begin if sonsLen(n) <> 2 then liMessage(n.info, errXExpectsTypeOrValue, opToStr[m]) else begin - n.sons[1] := semExprWithType(c, n.sons[1], true); + n.sons[1] := semExprWithType(c, n.sons[1], {@set}[efAllowType]); typ := skipVarGenericRange(n.sons[1].typ); case typ.Kind of tySequence, tyString, tyOpenArray: begin @@ -160,11 +156,31 @@ begin if sonsLen(n) <> 2 then liMessage(n.info, errXExpectsTypeOrValue, 'sizeof') else - n.sons[1] := semExprWithType(c, n.sons[1], true); + n.sons[1] := semExprWithType(c, n.sons[1], {@set}[efAllowType]); n.typ := getSysType(tyInt); result := n end; +function semIs(c: PContext; n: PNode): PNode; +var + a, b: PType; +begin + if sonsLen(n) = 3 then begin + n.sons[1] := semExprWithType(c, n.sons[1], {@set}[efAllowType]); + n.sons[2] := semExprWithType(c, n.sons[2], {@set}[efAllowType]); + a := n.sons[1].typ; + b := n.sons[2].typ; + if (b.kind <> tyObject) or (a.kind <> tyObject) then + liMessage(n.info, errIsExpectsObjectTypes); + while (b <> nil) and (b.id <> a.id) do b := b.sons[0]; + if b = nil then + liMessage(n.info, errXcanNeverBeOfThisSubtype, typeToString(a)); + end + else + liMessage(n.info, errIsExpectsTwoArguments); + result := n; +end; + procedure semOpAux(c: PContext; n: PNode); var i: int; @@ -174,14 +190,14 @@ begin for i := 1 to sonsLen(n)-1 do begin a := n.sons[i]; if a.kind = nkExprEqExpr then begin + checkSonsLen(a, 2); info := a.sons[0].info; - a.sons[0] := newIdentNode(considerAcc(a.sons[0])); - a.sons[0].info := info; - a.sons[1] := semExprWithType(c, a.sons[1], false); + a.sons[0] := newIdentNode(considerAcc(a.sons[0]), info); + a.sons[1] := semExprWithType(c, a.sons[1]); a.typ := a.sons[1].typ; end else - n.sons[i] := semExprWithType(c, a, false); + n.sons[i] := semExprWithType(c, a); end end; @@ -196,9 +212,8 @@ begin result := nil end else begin - result := newNode(nkCall); - result.info := n.info; - addSon(result, newIdentNode(par)); + result := newNodeI(nkCall, n.info); + addSon(result, newIdentNode(par, n.info)); for i := 0 to sonsLen(n)-1 do addSon(result, n.sons[i]); result := semExpr(c, result) end @@ -208,43 +223,72 @@ procedure changeType(n: PNode; newType: PType); var i: int; f: PSym; - m: PNode; + a, m: PNode; begin case n.kind of - nkSetConstr, nkConstSetConstr, - nkArrayConstr, nkConstArrayConstr: begin - for i := 0 to sonsLen(n)-1 do - changeType(n.sons[i], elemType(newType)); - end; - nkRecordConstr, nkConstRecordConstr: begin - for i := 0 to sonsLen(n)-1 do begin - m := n.sons[i].sons[0]; - if m.kind <> nkSym then - internalError(m.info, 'changeType(): invalid record constr'); - if not (newType.kind in [tyRecord, tyObject]) then - internalError(m.info, 'changeType(): invalid type'); - f := lookupInRecord(newType.n, m.sym.name); - if f = nil then - internalError(m.info, 'changeType(): invalid identifier'); - changeType(n.sons[i].sons[1], f.typ); - end + nkCurly, nkBracket: begin + for i := 0 to sonsLen(n)-1 do changeType(n.sons[i], elemType(newType)); end; nkPar: begin if newType.kind <> tyTuple then - internalError(n.info, 'changeType(): no tuple type'); - for i := 0 to sonsLen(n)-1 do - changeType(n.sons[i], newType.sons[i]); + InternalError(n.info, 'changeType: no tuple type for constructor'); + if newType.n = nil then + InternalError(n.info, 'changeType: no tuple fields'); + if (sonsLen(n) > 0) and (n.sons[0].kind = nkExprColonExpr) then begin + for i := 0 to sonsLen(n)-1 do begin + m := n.sons[i].sons[0]; + if m.kind <> nkSym then + internalError(m.info, 'changeType(): invalid tuple constr'); + f := getSymFromList(newType.n, m.sym.name); + if f = nil then + internalError(m.info, 'changeType(): invalid identifier'); + changeType(n.sons[i].sons[1], f.typ); + end + end + else begin + for i := 0 to sonsLen(n)-1 do begin + m := n.sons[i]; + a := newNodeIT(nkExprColonExpr, m.info, newType.sons[i]); + addSon(a, newSymNode(newType.n.sons[i].sym)); + addSon(a, m); + changeType(m, newType.sons[i]); + n.sons[i] := a; + end; + end end; else begin end end; n.typ := newType; end; +function semArrayConstr(c: PContext; n: PNode): PNode; +var + typ: PType; + i: int; +begin + result := newNode(nkBracket); + result.info := n.info; + result.typ := newTypeS(tyArrayConstr, c); + addSon(result.typ, nil); // index type + if sonsLen(n) = 0 then + // empty array + addSon(result.typ, nil) // needs an empty basetype! + else begin + addSon(result, semExprWithType(c, n.sons[0])); + typ := skipVar(result.sons[0].typ); + for i := 1 to sonsLen(n)-1 do begin + n.sons[i] := semExprWithType(c, n.sons[i]); + addSon(result, fitNode(c, typ, n.sons[i])); + end; + addSon(result.typ, typ) + end; + result.typ.sons[0] := makeRangeType(c, 0, sonsLen(result)-1); +end; + const ConstAbstractTypes = {@set}[tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, - tyArrayConstr, tyRecordConstr, tyTuple, - tyEmptySet, tySet]; + tyArrayConstr, tyTuple, tyEmptySet, tySet]; procedure fixAbstractType(c: PContext; n: PNode); var @@ -254,30 +298,162 @@ var begin for i := 1 to sonsLen(n)-1 do begin it := n.sons[i]; - if it.kind in [nkHiddenStdConv, nkHiddenSubConv] then begin - if skipVarGeneric(it.typ).kind = tyOpenArray then begin - s := skipVarGeneric(it.sons[0].typ); - if (s.kind = tyArrayConstr) and (s.sons[1] = nil) then begin - s := copyType(s, getCurrOwner(c)); - s.id := getID(); - skipVarGeneric(s).sons[1] := elemType(skipVarGeneric(it.typ)); - it.sons[0].typ := s; + case it.kind of + nkHiddenStdConv, nkHiddenSubConv: begin + if it.sons[1].kind = nkBracket then + it.sons[1] := semArrayConstr(c, it.sons[1]); + if skipVarGeneric(it.typ).kind = tyOpenArray then begin + s := skipVarGeneric(it.sons[1].typ); + if (s.kind = tyArrayConstr) and (s.sons[1] = nil) then begin + s := copyType(s, getCurrOwner(c)); + s.id := getID(); + skipVarGeneric(s).sons[1] := elemType(skipVarGeneric(it.typ)); + it.sons[1].typ := s; + end + end + else if skipVarGeneric(it.sons[1].typ).kind in [tyNil, tyArrayConstr, + tyTuple, tyEmptySet, tySet] then begin + s := skipVarGeneric(it.typ); + if s.kind = tyEmptySet then InternalError(it.info, 'fixAbstractType'); + changeType(it.sons[1], s); + n.sons[i] := it.sons[1]; end + end; + nkBracket: begin + // an implicitely constructed array (passed to an open array): + n.sons[i] := semArrayConstr(c, it); + end; + else if (it.typ = nil) or (it.typ.kind = tyEmptySet) then + InternalError(it.info, 'fixAbstractType: ' + renderTree(it)); + end + end +end; + +function skipObjConv(n: PNode): PNode; +begin + case n.kind of + nkHiddenStdConv, nkHiddenSubConv, nkConv: begin + if skipPtrsGeneric(n.sons[1].typ).kind in [tyTuple, tyObject] then + result := n.sons[1] + else + result := n + end; + nkObjUpConv, nkObjDownConv: result := n.sons[0]; + else result := n + end +end; + +function isAssignable(n: PNode): bool; +begin + result := false; + case n.kind of + nkSym: result := n.sym.kind in [skVar, skTemp]; + nkDotExpr, nkQualified, nkBracketExpr: begin + checkMinSonsLen(n, 1); + if skipGeneric(n.sons[0].typ).kind in [tyVar, tyPtr, tyRef] then + result := true + else + result := isAssignable(n.sons[0]); + end; + nkHiddenStdConv, nkHiddenSubConv, nkConv: begin + // Object and tuple conversions are still addressable, so we skip them + if skipPtrsGeneric(n.sons[1].typ).kind in [tyOpenArray, + tyTuple, tyObject] then + result := isAssignable(n.sons[1]) + end; + nkHiddenDeref, nkDerefExpr: result := true; + nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: + result := isAssignable(n.sons[0]); + else begin end + end +end; + +function newHiddenAddrTaken(c: PContext; n: PNode): PNode; +begin + if n.kind = nkHiddenDeref then begin + checkSonsLen(n, 1); + result := n.sons[0] + end + else begin + result := newNodeIT(nkHiddenAddr, n.info, makeVarType(c, n.typ)); + addSon(result, n); + if not isAssignable(n) then liMessage(n.info, errVarForOutParamNeeded); + end +end; + +function analyseIfAddressTaken(c: PContext; n: PNode): PNode; +begin + result := n; + case n.kind of + nkSym: begin + if skipGeneric(n.sym.typ).kind <> tyVar then begin + include(n.sym.flags, sfAddrTaken); + result := newHiddenAddrTaken(c, n); end - else if skipVarGeneric(it.sons[0].typ).kind in [tyNil, tyArrayConstr, - tyRecordConstr, tyTuple, - tyEmptySet, tySet] then begin - s := skipVarGeneric(it.typ); - if s.kind = tyEmptySet then InternalError(it.info, 'fixAbstractType'); - changeType(it.sons[0], s); - n.sons[i] := it.sons[0]; + end; + nkDotExpr, nkQualified: begin + checkSonsLen(n, 2); + if n.sons[1].kind <> nkSym then + internalError(n.info, 'analyseIfAddressTaken'); + if skipGeneric(n.sons[1].sym.typ).kind <> tyVar then begin + include(n.sons[1].sym.flags, sfAddrTaken); + result := newHiddenAddrTaken(c, n); end - end - else if it.typ.kind = tyEmptySet then - InternalError(it.info, 'fixAbstractType: 2'); + end; + nkBracketExpr: begin + checkMinSonsLen(n, 1); + if skipGeneric(n.sons[0].typ).kind <> tyVar then begin + if n.sons[0].kind = nkSym then + include(n.sons[0].sym.flags, sfAddrTaken); + result := newHiddenAddrTaken(c, n); + end + end; + else result := newHiddenAddrTaken(c, n); // BUGFIX! end end; +procedure analyseIfAddressTakenInCall(c: PContext; n: PNode); +const + FakeVarParams = {@set}[mNew, mNewFinalize, mInc, mDec, mIncl, + mExcl, mSetLengthStr, mSetLengthSeq, + mAppendStrCh, mAppendStrStr, mSwap, + mAppendSeqElem, mAppendSeqSeq]; +var + i: int; + t: PType; +begin + checkMinSonsLen(n, 1); + t := n.sons[0].typ; + if (n.sons[0].kind = nkSym) + and (n.sons[0].sym.magic in FakeVarParams) then exit; + for i := 1 to sonsLen(n)-1 do + if (i < sonsLen(t)) and (skipGeneric(t.sons[i]).kind = tyVar) then + n.sons[i] := analyseIfAddressTaken(c, n.sons[i]); +end; +(* +function lastPassOverArg(c: PContext; n: PNode; fakeVar: bool): PNode; +// this pass does various things: +// - it checks whether an address has been taken (needed for the ECMAScript +// code generator) +// - it changes the type of the argument (if it is not a concrete type) +begin + +end; + +procedure lastPassOverCall(c: PContext; n: PNode); +var + i: int; + fakeVar: bool; +begin + checkMinSonsLen(n, 1); + t := n.sons[0].typ; + fakeVar := (n.sons[0].kind = nkSym) + and (n.sons[0].sym.magic in FakeVarParams); + for i := 1 to sonsLen(n)-1 do begin + n.sons[i] := lastPassOverArg(c, n); + end +end;*) + function semIndirectOp(c: PContext; n: PNode): PNode; var m: TCandidate; @@ -285,19 +461,21 @@ var i: int; begin result := nil; + checkMinSonsLen(n, 1); case n.sons[0].kind of nkDotExpr, nkQualified: begin - n.sons[0] := semDotExpr(c, n.sons[0], false); + checkSonsLen(n.sons[0], 2); + n.sons[0] := semDotExpr(c, n.sons[0]); if n.sons[0].kind = nkDotCall then begin // it is a static call! result := n.sons[0]; result.kind := nkCall; for i := 1 to sonsLen(n)-1 do addSon(result, n.sons[i]); - result := semExpr(c, result, false); + result := semExpr(c, result); exit end end; - else n.sons[0] := semExpr(c, n.sons[0], false); + else n.sons[0] := semExpr(c, n.sons[0]); end; if n.sons[0].typ = nil then liMessage(n.sons[0].info, errExprXHasNoType, @@ -325,6 +503,7 @@ begin if result = nil then liMessage(n.info, errExprCannotBeCalled); end; fixAbstractType(c, result); + analyseIfAddressTakenInCall(c, result); end; function semDirectOp(c: PContext; n: PNode): PNode; @@ -337,6 +516,7 @@ begin liMessage(n.Info, errGenerated, getNotFoundError(c, n)) end; fixAbstractType(c, result); + analyseIfAddressTakenInCall(c, result); end; function semIncSucc(c: PContext; n: PNode; const opr: string): PNode; @@ -345,14 +525,14 @@ var a: PNode; typ: PType; begin - n.sons[1] := semExprWithType(c, n.sons[1], false); + checkMinSonsLen(n, 1); + n.sons[1] := semExprWithType(c, n.sons[1]); typ := skipVar(n.sons[1].Typ); if not isOrdinalType(typ) or enumHasWholes(typ) then liMessage(n.sons[1].Info, errOrdinalTypeExpected); if sonsLen(n) = 3 then begin - n.sons[2] := semExprWithType(c, n.sons[2], false); - a := IndexTypesMatch(c, getSysType(tyInt), n.sons[2].typ, - n.sons[2]); + n.sons[2] := semExprWithType(c, n.sons[2]); + a := IndexTypesMatch(c, getSysType(tyInt), n.sons[2].typ, n.sons[2]); if a = nil then typeMismatch(n.sons[2], getSysType(tyInt), n.sons[2].typ); n.sons[2] := a; @@ -370,7 +550,8 @@ end; function semOrd(c: PContext; n: PNode): PNode; begin - n.sons[1] := semExprWithType(c, n.sons[1], false); + checkSonsLen(n, 2); + n.sons[1] := semExprWithType(c, n.sons[1]); if not isOrdinalType(skipVar(n.sons[1].Typ)) then liMessage(n.Info, errOrdinalTypeExpected); n.typ := getSysType(tyInt); @@ -385,6 +566,7 @@ begin case n.kind of nkIdent: result := SymtabGet(c.Tab, n.ident); nkDotExpr, nkQualified: begin + checkSonsLen(n, 2); result := nil; m := LookupForDefined(c, n.sons[0]); if (m <> nil) and (m.kind = skModule) then begin @@ -400,10 +582,12 @@ begin liMessage(n.sons[1].info, errIdentifierExpected, ''); end end; - nkAccQuoted: + nkAccQuoted: begin + checkSonsLen(n, 1); result := lookupForDefined(c, n.sons[0]); + end else begin - liMessage(n.info, errIdentifierExpected, ''); + liMessage(n.info, errIdentifierExpected, renderTree(n)); result := nil; end end @@ -411,6 +595,7 @@ end; function semDefined(c: PContext; n: PNode): PNode; begin + checkSonsLen(n, 2); result := newIntNode(nkIntLit, 0); // we replace this node by a 'true' or 'false' node if LookUpForDefined(c, n.sons[1]) <> nil then @@ -437,6 +622,7 @@ begin mLow: result := semLowHigh(c, setMs(n, s), mLow); mHigh: result := semLowHigh(c, setMs(n, s), mHigh); mSizeOf: result := semSizeof(c, setMs(n, s)); + mIs: result := semIs(c, setMs(n, s)); mSucc: begin result := semIncSucc(c, setMs(n, s), 'succ'); result.typ := n.sons[1].typ; @@ -452,13 +638,13 @@ begin end; end; -function semSym(c: PContext; n: PNode; s: PSym; typeAllowed: bool): PNode; +function semSym(c: PContext; n: PNode; s: PSym; flags: TExprFlags): PNode; begin result := newSymNode(s); result.info := n.info; result.typ := s.typ; include(s.flags, sfUsed); - if (s.kind = skType) and not typeAllowed then + if (s.kind = skType) and not (efAllowType in flags) then liMessage(n.info, errATypeHasNoValue); case s.kind of skProc, skIterator, skConverter: @@ -496,17 +682,115 @@ begin end end; -function semFieldAccess(c: PContext; n: PNode; typeAllowed: bool): PNode; +function lookupInRecordAndBuildCheck(c: PContext; n, r: PNode; + field: PIdent; + var check: PNode): PSym; +// transform in a node that contains the runtime check for the +// field, if it is in a case-part... +var + i, j: int; + s, it, inExpr, notExpr: PNode; +begin + result := nil; + case r.kind of + nkRecList: begin + for i := 0 to sonsLen(r)-1 do begin + result := lookupInRecordAndBuildCheck(c, n, r.sons[i], field, check); + if result <> nil then exit + end + end; + nkRecCase: begin + checkMinSonsLen(r, 2); + if (r.sons[0].kind <> nkSym) then IllFormedAst(r); + result := lookupInRecordAndBuildCheck(c, n, r.sons[0], field, check); + if result <> nil then exit; + s := newNodeI(nkCurly, r.info); + for i := 1 to sonsLen(r)-1 do begin + it := r.sons[i]; + case it.kind of + nkOfBranch: begin + result := lookupInRecordAndBuildCheck(c, n, lastSon(it), + field, check); + if result = nil then begin + for j := 0 to sonsLen(it)-2 do addSon(s, copyTree(it.sons[j])); + end + else begin + if check = nil then begin + check := newNodeI(nkCheckedFieldExpr, n.info); + addSon(check, nil); // make space for access node + end; + s := newNodeI(nkCurly, n.info); + for j := 0 to sonsLen(it)-2 do addSon(s, copyTree(it.sons[j])); + inExpr := newNodeI(nkCall, n.info); + addSon(inExpr, newIdentNode(getIdent('in'), n.info)); + addSon(inExpr, copyTree(r.sons[0])); + addSon(inExpr, s); + //writeln(output, renderTree(inExpr)); + addSon(check, semExpr(c, inExpr)); + exit + end + end; + nkElse: begin + result := lookupInRecordAndBuildCheck(c, n, lastSon(it), + field, check); + if result <> nil then begin + if check = nil then begin + check := newNodeI(nkCheckedFieldExpr, n.info); + addSon(check, nil); // make space for access node + end; + inExpr := newNodeI(nkCall, n.info); + addSon(inExpr, newIdentNode(getIdent('in'), n.info)); + addSon(inExpr, copyTree(r.sons[0])); + addSon(inExpr, s); + notExpr := newNodeI(nkCall, n.info); + addSon(notExpr, newIdentNode(getIdent('not'), n.info)); + addSon(notExpr, inExpr); + addSon(check, semExpr(c, notExpr)); + exit + end + end; + else + illFormedAst(it); + end + end + end; + nkSym: begin + if r.sym.name.id = field.id then result := r.sym; + end; + else illFormedAst(n); + end +end; + +function makeDeref(n: PNode): PNode; +var + t: PType; + a: PNode; +begin + t := n.typ; + result := n; + if t.kind = tyVar then begin + result := newNodeIT(nkHiddenDeref, n.info, t.sons[0]); + addSon(result, n); + t := t.sons[0]; + end; + if t.kind in [tyPtr, tyRef] then begin + a := result; + result := newNodeIT(nkDerefExpr, n.info, t.sons[0]); + addSon(result, a); + end +end; + +function semFieldAccess(c: PContext; n: PNode; flags: TExprFlags): PNode; var f: PSym; ty: PType; i: PIdent; - asgn: bool; + check: PNode; begin - asgn := false; // this is difficult, because the '.' is used in many different contexts // in Nimrod. We first allow types in the semantic checking. - n.sons[0] := semExprWithType(c, n.sons[0], true); + checkSonsLen(n, 2); + n.sons[0] := semExprWithType(c, n.sons[0], [efAllowType]+flags); i := considerAcc(n.sons[1]); ty := n.sons[0].Typ; f := nil; @@ -527,34 +811,47 @@ begin liMessage(n.sons[1].info, errEnumHasNoValueX, i.s); exit; end - else if not typeAllowed and isTypeExpr(n.sons[0]) then begin + else if not (efAllowType in flags) and isTypeExpr(n.sons[0]) then begin liMessage(n.sons[0].info, errATypeHasNoValue); exit end; - while ty.kind = tyVar do begin ty := ty.sons[0]; asgn := true; end; - if ty.Kind in [tyRef, tyPtr] then begin ty := ty.sons[0]; asgn := true; end; - if (ty.kind in [tyRecord, tyObject]) then begin - while ty <> nil do begin - f := lookupInRecord(ty.n, i); + ty := skipPtrsGeneric(ty); + if ty.kind = tyObject then begin + while true do begin + check := nil; + f := lookupInRecordAndBuildCheck(c, n, ty.n, i, check); + //f := lookupInRecord(ty.n, i); if f <> nil then break; - ty := ty.sons[0]; + if ty.sons[0] = nil then break; + ty := skipGeneric(ty.sons[0]); end; if f <> nil then begin if ([sfStar, sfMinus] * f.flags <> []) or (getModule(f).id = c.module.id) then begin // is the access to a public field or in the same module? - if not asgn then begin - if not (sfMinus in f.flags) or (getModule(f).id = c.module.id) then - asgn := tfAssignable in ty.flags; - end; - + n.sons[0] := makeDeref(n.sons[0]); n.sons[1] := newSymNode(f); // we now have the correct field - n.typ := inheritAssignable(f.typ, asgn); - result := n; + n.typ := f.typ; + if check = nil then result := n + else begin + check.sons[0] := n; + check.typ := n.typ; + result := check + end; exit end end + end + else if ty.kind = tyTuple then begin + f := getSymFromList(ty.n, i); + if f <> nil then begin + n.sons[0] := makeDeref(n.sons[0]); + n.sons[1] := newSymNode(f); + n.typ := f.typ; + result := n; + exit + end end; // allow things like "".replace(...) // --> replace("", ...) @@ -563,7 +860,7 @@ begin result := newNode(nkDotCall); // This special node kind is to merge with the call handler in `semExpr`. result.info := n.info; - addSon(result, newIdentNode(i)); + addSon(result, newIdentNode(i, n.info)); addSon(result, copyTree(n.sons[0])); end else begin @@ -571,28 +868,32 @@ begin end end; -function semArrayAccess(c: PContext; n: PNode): PNode; +function whichSliceOpr(n: PNode): string; +begin + if (n.sons[0] = nil) then + if (n.sons[1] = nil) then result := '[..]' + else result := '[..$]' + else if (n.sons[1] = nil) then result := '[$..]' + else result := '[$..$]' +end; + +function semArrayAccess(c: PContext; n: PNode; flags: TExprFlags): PNode; var arr, indexType: PType; i: int; - asgn: bool; arg: PNode; idx: biggestInt; begin - asgn := false; // check if array type: - n.sons[0] := semExprWithType(c, n.sons[0], false); - arr := n.sons[0].typ; - while arr.kind = tyVar do begin arr := arr.sons[0]; asgn := true; end; - if arr.kind in [tyRef, tyPtr] then begin - arr := arr.sons[0]; asgn := true - end; + checkMinSonsLen(n, 2); + n.sons[0] := semExprWithType(c, n.sons[0], flags-[efAllowType]); + arr := skipPtrsGeneric(n.sons[0].typ); case arr.kind of tyArray, tyOpenArray, tyArrayConstr, tySequence, tyString, tyCString: begin - asgn := asgn or (tfAssignable in arr.flags) or (arr.kind = tyCString); + n.sons[0] := makeDeref(n.sons[0]); for i := 1 to sonsLen(n)-1 do - n.sons[i] := semExprWithType(c, n.sons[i], false); + n.sons[i] := semExprWithType(c, n.sons[i], flags-[efAllowType]); if arr.kind = tyArray then indexType := arr.sons[0] else indexType := getSysType(tyInt); arg := IndexTypesMatch(c, indexType, n.sons[1].typ, n.sons[1]); @@ -601,9 +902,10 @@ begin else liMessage(n.info, errIndexTypesDoNotMatch); result := n; - result.typ := inheritAssignable(elemType(arr), asgn); // BUGFIX + result.typ := elemType(arr); end; tyTuple: begin + n.sons[0] := makeDeref(n.sons[0]); // [] operator for tuples requires constant expression n.sons[1] := semConstExpr(c, n.sons[1]); if skipRange(n.sons[1].typ).kind in [tyInt..tyInt64] then begin @@ -618,42 +920,24 @@ begin result := n; end else begin // overloaded [] operator: - result := newNode(nkCall); - if n.sons[1].kind = nkRange then - addSon(result, newIdentNode(getIdent('[..]'))) - else - addSon(result, newIdentNode(getIdent('[]'))); - for i := 0 to sonsLen(n)-1 do - addSon(result, n.sons[i]); + result := newNodeI(nkCall, n.info); + if n.sons[1].kind = nkRange then begin + checkSonsLen(n.sons[1], 2); + addSon(result, newIdentNode(getIdent(whichSliceOpr(n.sons[1])), n.info)); + addSon(result, n.sons[0]); + addSonIfNotNil(result, n.sons[1].sons[0]); + addSonIfNotNil(result, n.sons[1].sons[1]); + end + else begin + addSon(result, newIdentNode(getIdent('[]'), n.info)); + addSon(result, n.sons[0]); + addSon(result, n.sons[1]); + end; result := semExpr(c, result); end end end; -function semArrayConstr(c: PContext; n: PNode): PNode; -var - typ: PType; - i: int; -begin - result := newNode(nkArrayConstr); - result.info := n.info; - result.typ := newTypeS(tyArrayConstr, c); - addSon(result.typ, nil); // index type - if sonsLen(n) = 0 then - // empty array - addSon(result.typ, nil) // needs an empty basetype! - else begin - addSon(result, semExprWithType(c, n.sons[0], false)); - typ := skipVar(result.sons[0].typ); - for i := 1 to sonsLen(n)-1 do begin - n.sons[i] := semExprWithType(c, n.sons[i], false); - addSon(result, fitNode(c, typ, n.sons[i])); - end; - addSon(result.typ, typ) - end; - result.typ.sons[0] := makeRangeType(c, 0, sonsLen(result)-1); -end; - function semIfExpr(c: PContext; n: PNode): PNode; var typ: PType; @@ -661,23 +945,26 @@ var it: PNode; begin result := n; + checkSonsLen(n, 2); typ := nil; for i := 0 to sonsLen(n) - 1 do begin it := n.sons[i]; case it.kind of nkElifExpr: begin - it.sons[0] := semExprWithType(c, it.sons[0], false); + checkSonsLen(it, 2); + it.sons[0] := semExprWithType(c, it.sons[0]); checkBool(it.sons[0]); - it.sons[1] := semExprWithType(c, it.sons[1], false); + it.sons[1] := semExprWithType(c, it.sons[1]); if typ = nil then typ := it.sons[1].typ else it.sons[1] := fitNode(c, typ, it.sons[1]) end; nkElseExpr: begin - it.sons[0] := semExprWithType(c, it.sons[0], false); + checkSonsLen(it, 1); + it.sons[0] := semExprWithType(c, it.sons[0]); assert(typ <> nil); it.sons[0] := fitNode(c, typ, it.sons[0]); end; - else internalError(it.info, 'semIfExpr()'); + else illFormedAst(n); end end; result.typ := typ; @@ -689,7 +976,7 @@ var i: int; m: PNode; begin - result := newNode(nkSetConstr); + result := newNode(nkCurly); result.info := n.info; if sonsLen(n) = 0 then result.typ := newTypeS(tyEmptySet, c) @@ -698,13 +985,14 @@ begin typ := nil; for i := 0 to sonsLen(n)-1 do begin if n.sons[i].kind = nkRange then begin - n.sons[i].sons[0] := semExprWithType(c, n.sons[i].sons[0], false); - n.sons[i].sons[1] := semExprWithType(c, n.sons[i].sons[1], false); + checkSonsLen(n.sons[i], 2); + n.sons[i].sons[0] := semExprWithType(c, n.sons[i].sons[0]); + n.sons[i].sons[1] := semExprWithType(c, n.sons[i].sons[1]); if typ = nil then typ := skipVar(n.sons[i].sons[0].typ); n.sons[i].typ := n.sons[i].sons[1].typ; // range node needs type too end else begin - n.sons[i] := semExprWithType(c, n.sons[i], false); + n.sons[i] := semExprWithType(c, n.sons[i]); if typ = nil then typ := skipVar(n.sons[i].typ) end end; @@ -734,20 +1022,20 @@ begin end; type - TParKind = (paNone, paSingle, paRecord, paTuple); + TParKind = (paNone, paSingle, paTupleFields, paTuplePositions); function checkPar(n: PNode): TParKind; var i, len: int; begin len := sonsLen(n); - if len = 0 then result := paTuple // () + if len = 0 then result := paTuplePositions // () else if len = 1 then result := paSingle // (expr) else begin - if n.sons[0].kind = nkExprColonExpr then result := paRecord - else result := paTuple; + if n.sons[0].kind = nkExprColonExpr then result := paTupleFields + else result := paTuplePositions; for i := 0 to len-1 do begin - if result = paRecord then begin + if result = paTupleFields then begin if (n.sons[i].kind <> nkExprColonExpr) or (n.sons[i].sons[0].kind <> nkIdent) then begin liMessage(n.sons[i].info, errNamedExprExpected); @@ -764,7 +1052,7 @@ begin end end; -function semRecordConstr(c: PContext; n: PNode): PNode; +function semTupleFieldsConstr(c: PContext; n: PNode): PNode; var i: int; typ: PType; @@ -772,9 +1060,9 @@ var id: PIdent; f: PSym; begin - result := newNode(nkRecordConstr); + result := newNode(nkPar); result.info := n.info; - typ := newTypeS(tyRecordConstr, c); + typ := newTypeS(tyTuple, c); typ.n := newNode(nkRecList); // nkIdentDefs IntSetInit(ids); for i := 0 to sonsLen(n)-1 do begin @@ -784,9 +1072,10 @@ begin id := n.sons[i].sons[0].ident; if IntSetContainsOrIncl(ids, id.id) then liMessage(n.sons[i].info, errFieldInitTwice, id.s); - n.sons[i].sons[1] := semExprWithType(c, n.sons[i].sons[1], false); + n.sons[i].sons[1] := semExprWithType(c, n.sons[i].sons[1]); f := newSymS(skField, n.sons[i].sons[0], c); f.typ := n.sons[i].sons[1].typ; + addSon(typ, f.typ); addSon(typ.n, newSymNode(f)); n.sons[i].sons[0] := newSymNode(f); addSon(result, n.sons[i]); @@ -794,15 +1083,16 @@ begin result.typ := typ; end; -function semTupleConstr(c: PContext; n: PNode): PNode; +function semTuplePositionsConstr(c: PContext; n: PNode): PNode; var i: int; typ: PType; begin result := n; // we don't modify n, but compute the type: typ := newTypeS(tyTuple, c); + // leave typ.n nil! for i := 0 to sonsLen(n)-1 do begin - n.sons[i] := semExprWithType(c, n.sons[i], false); + n.sons[i] := semExprWithType(c, n.sons[i]); addSon(typ, n.sons[i].typ); end; result.typ := typ; @@ -813,12 +1103,13 @@ var len, i: int; begin result := n; + 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 - n.sons[len-1] := semExprWithType(c, n.sons[len-1], false); + n.sons[len-1] := semExprWithType(c, n.sons[len-1]); n.typ := n.sons[len-1].typ end end; @@ -827,51 +1118,49 @@ function semBlockExpr(c: PContext; n: PNode): PNode; begin result := n; Inc(c.p.nestedBlockCounter); - if sonsLen(n) = 2 then begin - openScope(c.tab); // BUGFIX: label is in the scope of block! - if n.sons[0] <> nil then begin - addDecl(c, newSymS(skLabel, n.sons[0], c)) - end; - n.sons[1] := semStmtListExpr(c, n.sons[1]); - n.typ := n.sons[1].typ; - closeScope(c.tab); - end - else - illFormedAst(n); + checkSonsLen(n, 2); + openScope(c.tab); // BUGFIX: label is in the scope of block! + if n.sons[0] <> nil then begin + addDecl(c, newSymS(skLabel, n.sons[0], c)) + end; + n.sons[1] := semStmtListExpr(c, n.sons[1]); + n.typ := n.sons[1].typ; + closeScope(c.tab); Dec(c.p.nestedBlockCounter); end; -function semDotExpr(c: PContext; n: PNode; typeAllowed: bool): PNode; +function semDotExpr(c: PContext; n: PNode; flags: TExprFlags): PNode; var s: PSym; begin s := qualifiedLookup(c, n, true); // check for ambiguity if s <> nil then - result := semSym(c, n, s, typeAllowed) + result := semSym(c, n, s, flags) else - // record access: if the field does not exist, check for a proc: - result := semFieldAccess(c, n, typeAllowed); + // test! + result := semFieldAccess(c, n, flags); end; -function semExpr(c: PContext; n: PNode; typeAllowed: bool = false): PNode; +function semMacroExpr(c: PContext; n: PNode; sym: PSym): PNode; forward; + +function semExpr(c: PContext; n: PNode; flags: TExprFlags = {@set}[]): PNode; var s: PSym; begin result := n; if n = nil then exit; - embeddedDbg(c, n); case n.kind of // atoms: nkIdent: begin // lookup the symbol: s := SymtabGet(c.Tab, n.ident); - if s <> nil then result := semSym(c, n, s, typeAllowed) + if s <> nil then result := semSym(c, n, s, flags) else liMessage(n.info, errUndeclaredIdentifier, n.ident.s); end; nkSym: begin s := n.sym; include(s.flags, sfUsed); - if (s.kind = skType) and not typeAllowed then + if (s.kind = skType) and not (efAllowType in flags) then liMessage(n.info, errATypeHasNoValue); if s.magic <> mNone then liMessage(n.info, errInvalidContextForBuiltinX, s.name.s); @@ -879,30 +1168,32 @@ begin nkEmpty, nkNone: begin end; nkNilLit: result.typ := getSysType(tyNil); nkType: begin - if not typeAllowed then liMessage(n.info, errATypeHasNoValue); + if not (efAllowType in flags) then liMessage(n.info, errATypeHasNoValue); n.typ := semTypeNode(c, n, nil); end; - nkIntLit: result.typ := getSysType(tyInt); - nkInt8Lit: result.typ := getSysType(tyInt8); - nkInt16Lit: result.typ := getSysType(tyInt16); - nkInt32Lit: result.typ := getSysType(tyInt32); - nkInt64Lit: result.typ := getSysType(tyInt64); - nkFloatLit: result.typ := getSysType(tyFloat); - nkFloat32Lit: result.typ := getSysType(tyFloat32); - nkFloat64Lit: result.typ := getSysType(tyFloat64); - nkStrLit..nkTripleStrLit: result.typ := getSysType(tyString); - nkCharLit, nkRCharLit: result.typ := getSysType(tyChar); - + nkIntLit: if result.typ = nil then result.typ := getSysType(tyInt); + nkInt8Lit: if result.typ = nil then result.typ := getSysType(tyInt8); + nkInt16Lit: if result.typ = nil then result.typ := getSysType(tyInt16); + nkInt32Lit: if result.typ = nil then result.typ := getSysType(tyInt32); + nkInt64Lit: if result.typ = nil then result.typ := getSysType(tyInt64); + nkFloatLit: if result.typ = nil then result.typ := getSysType(tyFloat); + nkFloat32Lit: if result.typ = nil then result.typ := getSysType(tyFloat32); + nkFloat64Lit: if result.typ = nil then result.typ := getSysType(tyFloat64); + nkStrLit..nkTripleStrLit: + if result.typ = nil then result.typ := getSysType(tyString); + nkCharLit: + if result.typ = nil then result.typ := getSysType(tyChar); nkQualified, nkDotExpr: begin - result := semDotExpr(c, n, typeAllowed); + result := semDotExpr(c, n, flags); if result.kind = nkDotCall then begin result.kind := nkCall; - result := semExpr(c, result, typeAllowed) + result := semExpr(c, result, flags) end; end; // complex expressions nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand: begin // check if it is an expression macro: + checkMinSonsLen(n, 1); s := qualifiedLookup(c, n.sons[0], false); if (s <> nil) then begin case s.kind of @@ -918,9 +1209,9 @@ begin end; skType: begin include(s.flags, sfUsed); - result := semConv(c, n, s); if n.kind <> nkCall then - liMessage(n.info, errXisNotCallable, s.name.s) + liMessage(n.info, errXisNotCallable, s.name.s); + result := semConv(c, n, s); end; skProc, skConverter, skIterator: begin if s.magic = mNone then result := semDirectOp(c, n) @@ -932,6 +1223,7 @@ begin else result := semIndirectOp(c, n); end; nkBracketExpr: begin + checkMinSonsLen(n, 1); s := qualifiedLookup(c, n.sons[0], false); if (s <> nil) and (s.kind in [skProc, skConverter, skIterator]) then begin // type parameters: partial generic specialization @@ -940,7 +1232,7 @@ begin result := partialSpecialization(c, n, s); end else begin - result := semArrayAccess(c, n); + result := semArrayAccess(c, n, flags); end end; nkPragmaExpr: begin @@ -948,53 +1240,45 @@ begin internalError(n.info, 'semExpr() to implement'); // XXX: to implement end; - nkPar, nkRecordConstr, nkConstRecordConstr: begin + nkPar: begin case checkPar(n) of paNone: result := nil; - paTuple: result := semTupleConstr(c, n); - paRecord: result := semRecordConstr(c, n); - paSingle: result := semExpr(c, n.sons[0], typeAllowed); + paTuplePositions: result := semTuplePositionsConstr(c, n); + paTupleFields: result := semTupleFieldsConstr(c, n); + paSingle: result := semExpr(c, n.sons[0]); end; end; - nkCurly, nkSetConstr, nkConstSetConstr: begin - result := semSetConstr(c, n); - end; - nkBracket, nkArrayConstr, nkConstArrayConstr: begin - result := semArrayConstr(c, n); - end; - nkLambda: begin - result := semLambda(c, n); // handled in semstmts - end; + nkCurly: result := semSetConstr(c, n); + nkBracket: result := semArrayConstr(c, n); + nkLambda: result := semLambda(c, n); // handled in semstmts nkExprColonExpr: begin internalError(n.info, 'semExpr() to implement'); // XXX: to implement for array constructors! end; nkDerefExpr: begin - if sonsLen(n) = 1 then begin - n.sons[0] := semExprWithType(c, n.sons[0], typeAllowed); - result := n; - case n.sons[0].typ.kind of - tyRef, tyPtr: n.typ := n.sons[0].typ.sons[0]; - else liMessage(n.sons[0].info, errCircumNeedsPointer); - end; - result := n; - result.typ := inheritAssignable(result.typ, true); - end - else - illFormedAst(n) + checkSonsLen(n, 1); + n.sons[0] := semExprWithType(c, n.sons[0]); + result := n; + case skipVarGeneric(n.sons[0].typ).kind of + tyRef, tyPtr: n.typ := n.sons[0].typ.sons[0]; + else liMessage(n.sons[0].info, errCircumNeedsPointer); + end; + result := n; end; nkAddr: begin result := n; - n.sons[0] := semExprWithType(c, n.sons[0], false); - //if not (tfAssignable in n.sons[0].typ.flags) then - // liMessage(n.info, errExprHasNoAddress); - // XXX: the above check is not correct for parameters + checkSonsLen(n, 1); + n.sons[0] := semExprWithType(c, n.sons[0]); + if not isAssignable(n.sons[0]) then liMessage(n.info, errExprHasNoAddress); n.typ := makePtrType(c, n.sons[0].typ); end; - nkCast: begin - result := semCast(c, n); + nkHiddenAddr, nkHiddenDeref: begin + checkSonsLen(n, 1); + n.sons[0] := semExpr(c, n.sons[0], flags); end; + nkCast: result := semCast(c, n); nkAccQuoted: begin + checkSonsLen(n, 1); result := semExpr(c, n.sons[0]); end; nkHeaderQuoted: begin @@ -1002,16 +1286,20 @@ begin internalError(n.info, 'semExpr() to implement'); // XXX: to implement end; - nkIfExpr: begin - result := semIfExpr(c, n); - end; - nkStmtListExpr: begin - result := semStmtListExpr(c, n); - end; - nkBlockExpr: begin - result := semBlockExpr(c, n); - end; + nkIfExpr: result := semIfExpr(c, n); + nkStmtListExpr: result := semStmtListExpr(c, n); + nkBlockExpr: result := semBlockExpr(c, n); + nkHiddenStdConv, nkHiddenSubConv, nkConv, nkHiddenCallConv: + checkSonsLen(n, 2); + nkStringToCString, nkCStringToString, nkPassAsOpenArray, nkObjDownConv, + nkObjUpConv: + checkSonsLen(n, 1); + nkChckRangeF, nkChckRange64, nkChckRange: + checkSonsLen(n, 3); + nkCheckedFieldExpr: + checkMinSonsLen(n, 2); else begin + //InternalError(n.info, nodeKindToStr[n.kind]); liMessage(n.info, errInvalidExpressionX, renderTree(n, {@set}[renderNoComments])); result := nil diff --git a/nim/semfold.pas b/nim/semfold.pas index 2edc2e7a0..00d84f836 100644 --- a/nim/semfold.pas +++ b/nim/semfold.pas @@ -62,7 +62,7 @@ function getStrOrChar(a: PNode): string; begin case a.kind of nkStrLit..nkTripleStrLit: result := a.strVal; - nkCharLit, nkRCharLit: result := chr(int(a.intVal))+''; + nkCharLit: result := chr(int(a.intVal))+''; else begin internalError(a.info, 'getStrOrChar'); result := '' end; end end; @@ -81,11 +81,11 @@ begin mBitnotI, mBitnotI64: result := newIntNodeT(not getInt(a), n); mLengthStr: result := newIntNodeT(length(getStr(a)), n); - mLengthSeq, mLengthArray, + mLengthSeq, mLengthArray, mLengthOpenArray: result := newIntNodeT(lengthOrd(a.typ), n); - + mUnaryPlusI, mUnaryPlusI64, mUnaryPlusF64: result := a; // throw `+` away - mToFloat, mToBiggestFloat: + mToFloat, mToBiggestFloat: result := newFloatNodeT(toFloat(int(getInt(a))), n); mToInt, mToBiggestInt: result := newIntNodeT(nsystem.toInt(getFloat(a)), n); mAbsF64: result := newFloatNodeT(abs(getFloat(a)), n); @@ -93,11 +93,13 @@ begin if getInt(a) >= 0 then result := a else result := newIntNodeT(-getInt(a), n); end; - mZe, mZe64: + mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64: begin + // byte(-128) = 1...1..1000_0000'64 --> 0...0..1000_0000'64 result := newIntNodeT(getInt(a) and (1 shl a.typ.size*8 - 1), n); + end; mToU8: result := newIntNodeT(getInt(a) and $ff, n); mToU16: result := newIntNodeT(getInt(a) and $ffff, n); - mToU32: result := newIntNodeT(getInt(a) and $ffffffff, n); + mToU32: result := newIntNodeT(getInt(a) and $00000000ffffffff, n); mSucc: result := newIntNodeT(getOrdValue(a)+getInt(b), n); mPred: result := newIntNodeT(getOrdValue(a)-getInt(b), n); @@ -121,7 +123,16 @@ begin mAddF64: result := newFloatNodeT(getFloat(a)+getFloat(b), n); mSubF64: result := newFloatNodeT(getFloat(a)-getFloat(b), n); mMulF64: result := newFloatNodeT(getFloat(a)*getFloat(b), n); - mDivF64: result := newFloatNodeT(getFloat(a)/getFloat(b), n); + mDivF64: begin + if getFloat(b) = 0.0 then begin + if getFloat(a) = 0.0 then + result := newFloatNodeT(NaN, n) + else + result := newFloatNodeT(Inf, n); + end + else + result := newFloatNodeT(getFloat(a)/getFloat(b), n); + end; mMaxF64: begin if getFloat(a) > getFloat(b) then result := newFloatNodeT(getFloat(a), n) else result := newFloatNodeT(getFloat(b), n); @@ -130,7 +141,7 @@ begin if getFloat(a) > getFloat(b) then result := newFloatNodeT(getFloat(b), n) else result := newFloatNodeT(getFloat(a), n); end; - + mIsNil: result := newIntNodeT(ord(a.kind = nkNilLit), n); mLtI, mLtI64, mLtB, mLtEnum, mLtCh: result := newIntNodeT(ord(getOrdValue(a) < getOrdValue(b)), n); mLeI, mLeI64, mLeB, mLeEnum, mLeCh: @@ -185,9 +196,15 @@ begin end; mInSet: result := newIntNodeT(Ord(inSet(a, b)), n); mConStrStr: result := newStrNodeT(getStrOrChar(a)+{&}getStrOrChar(b), n); - mExit, mInc, ast.mDec, mAssert, mSwap, + mRepr: result := newStrNodeT(renderTree(a, {@set}[renderNoComments]), n); + mIntToStr, mInt64ToStr, mBoolToStr, mCharToStr: + result := newStrNodeT(toString(getOrdValue(a)), n); + mFloatToStr: result := newStrNodeT(toStringF(getFloat(a)), n); + mCStrToStr: result := newStrNodeT(getStrOrChar(a), n); + mStrToStr: result := a; + mExit, mInc, ast.mDec, mAssert, mSwap, mAppendStrCh, mAppendStrStr, mAppendSeqElem, mAppendSeqSeq, - mSetLengthStr, mSetLengthSeq: begin end; + mSetLengthStr, mSetLengthSeq, mNLen..mNError: begin end; else InternalError(a.info, 'evalOp(' +{&} magicToStr[m] +{&} ')'); end end; @@ -228,13 +245,13 @@ begin a := getConstExpr(c, n.sons[1]); b := getConstExpr(c, n.sons[2]); if a <> nil then begin - assert(a.kind in [nkIntLit..nkInt64Lit]); + assert(a.kind in [nkIntLit..nkInt64Lit]); if a.intVal = 0 then result := a - else if b <> nil then result := b + else if b <> nil then result := b else result := n.sons[2] end else if b <> nil then begin - assert(b.kind in [nkIntLit..nkInt64Lit]); + assert(b.kind in [nkIntLit..nkInt64Lit]); if b.intVal = 0 then result := b else result := n.sons[1] end @@ -249,18 +266,38 @@ begin a := getConstExpr(c, n.sons[1]); b := getConstExpr(c, n.sons[2]); if a <> nil then begin - assert(a.kind in [nkIntLit..nkInt64Lit]); + assert(a.kind in [nkIntLit..nkInt64Lit]); if a.intVal <> 0 then result := a else if b <> nil then result := b else result := n.sons[2] end else if b <> nil then begin - assert(b.kind in [nkIntLit..nkInt64Lit]); + assert(b.kind in [nkIntLit..nkInt64Lit]); if b.intVal <> 0 then result := b else result := n.sons[1] end end; +function leValueConv(a, b: PNode): Boolean; +begin + result := false; + case a.kind of + nkCharLit..nkInt64Lit: + case b.kind of + nkCharLit..nkInt64Lit: result := a.intVal <= b.intVal; + nkFloatLit..nkFloat64Lit: result := a.intVal <= round(b.floatVal); + else InternalError(a.info, 'leValueConv'); + end; + nkFloatLit..nkFloat64Lit: + case b.kind of + nkFloatLit..nkFloat64Lit: result := a.floatVal <= b.floatVal; + nkCharLit..nkInt64Lit: result := a.floatVal <= toFloat(int(b.intVal)); + else InternalError(a.info, 'leValueConv'); + end; + else InternalError(a.info, 'leValueConv'); + end +end; + function getConstExpr(c: PContext; n: PNode): PNode; var s: PSym; @@ -271,7 +308,7 @@ begin case n.kind of nkSym: begin s := n.sym; - if s.kind = skEnumField then + if s.kind = skEnumField then result := newIntNodeT(s.position, n) else if (s.kind = skConst) then begin case s.magic of @@ -282,6 +319,9 @@ begin mNimrodMinor: result := newIntNodeT(VersionMinor, n); mNimrodPatch: result := newIntNodeT(VersionPatch, n); mCpuEndian: result := newIntNodeT(ord(CPU[targetCPU].endian), n); + mNaN: result := newFloatNodeT(NaN, n); + mInf: result := newFloatNodeT(Inf, n); + mNegInf: result := newFloatNodeT(NegInf, n); else result := copyTree(s.ast); // BUGFIX end end @@ -301,17 +341,17 @@ begin mSizeOf: begin a := n.sons[1]; if computeSize(a.typ) < 0 then - liMessage(a.info, errCannotEvalXBecauseIncompletelyDefined, + liMessage(a.info, errCannotEvalXBecauseIncompletelyDefined, 'sizeof'); - if a.typ.kind in [tyArray, tyRecord, tyObject, tyTuple] then - result := nil // XXX: size computation for complex types + if a.typ.kind in [tyArray, tyObject, tyTuple] then + result := nil // XXX: size computation for complex types // is still wrong else result := newIntNodeT(a.typ.size, n); end; mLow: result := newIntNodeT(firstOrd(n.sons[1].typ), n); mHigh: begin - if not (skipVarGeneric(n.sons[1].typ).kind in [tyOpenArray, + if not (skipVarGeneric(n.sons[1].typ).kind in [tyOpenArray, tySequence, tyString]) then result := newIntNodeT(lastOrd(skipVarGeneric(n.sons[1].typ)), n); end; @@ -337,61 +377,73 @@ begin result := n; n.sons[0] := a end; - end;(* - nkHiddenSubConv: begin - // subtype conversion is ok: - // XXX: range check! - result := getConstExpr(c, n.sons[0]); - if result <> nil then - result.typ := n.typ; - end;*) - nkArrayConstr, nkConstArrayConstr: begin + end; + nkBracket: begin result := copyTree(n); for i := 0 to sonsLen(n)-1 do begin a := getConstExpr(c, n.sons[i]); if a = nil then begin result := nil; exit end; result.sons[i] := a; end; - result.kind := nkConstArrayConstr; + include(result.flags, nfAllConst); end; nkRange: begin a := getConstExpr(c, n.sons[0]); if a = nil then exit; b := getConstExpr(c, n.sons[1]); - if b = nil then exit; + if b = nil then exit; result := copyNode(n); addSon(result, a); addSon(result, b); end; - nkSetConstr, nkConstSetConstr: begin + nkCurly: begin result := copyTree(n); for i := 0 to sonsLen(n)-1 do begin a := getConstExpr(c, n.sons[i]); if a = nil then begin result := nil; exit end; result.sons[i] := a; end; - result.kind := nkConstSetConstr; + include(result.flags, nfAllConst); end; nkPar: begin // tuple constructor result := copyTree(n); - for i := 0 to sonsLen(n)-1 do begin - a := getConstExpr(c, n.sons[i]); - if a = nil then begin result := nil; exit end; - result.sons[i] := a; + if (sonsLen(n) > 0) and (n.sons[0].kind = nkExprColonExpr) then begin + for i := 0 to sonsLen(n)-1 do begin + a := getConstExpr(c, n.sons[i].sons[1]); + if a = nil then begin result := nil; exit end; + result.sons[i].sons[1] := a; + end + end + else begin + for i := 0 to sonsLen(n)-1 do begin + a := getConstExpr(c, n.sons[i]); + if a = nil then begin result := nil; exit end; + result.sons[i] := a; + end end; + include(result.flags, nfAllConst); end; - nkRecordConstr: begin - result := copyTree(n); - for i := 0 to sonsLen(n)-1 do begin - a := getConstExpr(c, n.sons[i].sons[1]); - if a = nil then begin result := nil; exit end; - result.sons[i].sons[1] := a; - end; - result.kind := nkConstRecordConstr; + nkChckRangeF, nkChckRange64, nkChckRange: begin + a := getConstExpr(c, n.sons[0]); + if a = nil then exit; + if leValueConv(n.sons[1], a) and leValueConv(a, n.sons[2]) then begin + result := a; // a <= x and x <= b + result.typ := n.typ + end + else + liMessage(n.info, errGenerated, + format(msgKindToString(errIllegalConvFromXtoY), + [typeToString(n.sons[0].typ), typeToString(n.typ)])); end; - nkHiddenStdConv, nkHiddenSubConv, nkConv, nkCast: begin + nkStringToCString, nkCStringToString: begin a := getConstExpr(c, n.sons[0]); if a = nil then exit; + result := a; + result.typ := n.typ; + end; + nkHiddenStdConv, nkHiddenSubConv, nkConv, nkCast: begin + a := getConstExpr(c, n.sons[1]); + if a = nil then exit; case skipRange(n.typ).kind of tyInt..tyInt64: begin case skipRange(a.typ).kind of @@ -430,14 +482,14 @@ function semConstExpr(c: PContext; n: PNode): PNode; var e: PNode; begin - e := semExprWithType(c, n, false); + e := semExprWithType(c, n); if e = nil then begin liMessage(n.info, errConstExprExpected); result := nil; exit end; result := getConstExpr(c, e); - if result = nil then begin + if result = nil then begin //writeln(output, renderTree(n)); - liMessage(n.info, errConstExprExpected); + liMessage(n.info, errConstExprExpected); end end; diff --git a/nim/semstmts.pas b/nim/semstmts.pas index 66db7b802..4d8372a19 100644 --- a/nim/semstmts.pas +++ b/nim/semstmts.pas @@ -50,7 +50,7 @@ begin case it.kind of nkElifBranch: begin checkSonsLen(it, 2); - it.sons[0] := semExpr(c, it.sons[0]); + it.sons[0] := semExprWithType(c, it.sons[0]); checkBool(it.sons[0]); it.sons[1] := semStmtScope(c, it.sons[1]) end; @@ -66,12 +66,9 @@ end; function semDiscard(c: PContext; n: PNode): PNode; begin result := n; - if sonsLen(n) = 1 then begin - n.sons[0] := semExpr(c, n.sons[0]); - if n.sons[0].typ = nil then liMessage(n.info, errInvalidDiscard); - end - else - illFormedAst(n); + checkSonsLen(n, 1); + n.sons[0] := semExprWithType(c, n.sons[0]); + if n.sons[0].typ = nil then liMessage(n.info, errInvalidDiscard); end; function semBreakOrContinue(c: PContext; n: PNode): PNode; @@ -80,32 +77,29 @@ var x: PNode; begin result := n; - if sonsLen(n) = 1 then begin - if n.sons[0] <> nil then begin - if n.sons[0].kind = nkIdent then begin - // lookup the symbol: - s := SymtabGet(c.Tab, n.sons[0].ident); - if s <> nil then begin - if (s.kind = skLabel) and (s.owner.id = c.p.owner.id) then begin - x := newSymNode(s); - x.info := n.info; - include(s.flags, sfUsed); - n.sons[0] := x - end - else - liMessage(n.info, errInvalidControlFlowX, s.name.s) + checkSonsLen(n, 1); + if n.sons[0] <> nil then begin + if n.sons[0].kind = nkIdent then begin + // lookup the symbol: + s := SymtabGet(c.Tab, n.sons[0].ident); + if s <> nil then begin + if (s.kind = skLabel) and (s.owner.id = c.p.owner.id) then begin + x := newSymNode(s); + x.info := n.info; + include(s.flags, sfUsed); + n.sons[0] := x end else - liMessage(n.info, errUndeclaredIdentifier, n.sons[0].ident.s); + liMessage(n.info, errInvalidControlFlowX, s.name.s) end - else illFormedAst(n) + else + liMessage(n.info, errUndeclaredIdentifier, n.sons[0].ident.s); end - else if (c.p.nestedLoopCounter <= 0) and (c.p.nestedBlockCounter <= 0) then - liMessage(n.info, errInvalidControlFlowX, - renderTree(n, {@set}[renderNoComments])) + else illFormedAst(n) end - else - illFormedAst(n); + else if (c.p.nestedLoopCounter <= 0) and (c.p.nestedBlockCounter <= 0) then + liMessage(n.info, errInvalidControlFlowX, + renderTree(n, {@set}[renderNoComments])) end; function semBlock(c: PContext; n: PNode): PNode; @@ -114,18 +108,15 @@ var begin result := n; Inc(c.p.nestedBlockCounter); - if sonsLen(n) = 2 then begin - openScope(c.tab); // BUGFIX: label is in the scope of block! - if n.sons[0] <> nil then begin - labl := newSymS(skLabel, n.sons[0], c); - addDecl(c, labl); - n.sons[0] := newSymNode(labl); // BUGFIX - end; - n.sons[1] := semStmt(c, n.sons[1]); - closeScope(c.tab); - end - else - illFormedAst(n); + checkSonsLen(n, 2); + openScope(c.tab); // BUGFIX: label is in the scope of block! + if n.sons[0] <> nil then begin + labl := newSymS(skLabel, n.sons[0], c); + addDecl(c, labl); + n.sons[0] := newSymNode(labl); // BUGFIX + end; + n.sons[1] := semStmt(c, n.sons[1]); + closeScope(c.tab); Dec(c.p.nestedBlockCounter); end; @@ -137,59 +128,55 @@ var marker: Char; begin result := n; - if sonsLen(n) = 2 then begin - marker := pragmaAsm(con, n.sons[0]); - if marker = #0 then marker := '`'; // default marker - case n.sons[1].kind of - nkStrLit, nkRStrLit, nkTripleStrLit: begin - result := copyNode(n); - str := n.sons[1].strVal; - if str = '' then liMessage(n.info, errEmptyAsm); - // now parse the string literal and substitute symbols: - a := strStart; - repeat - b := findSubStr(marker, str, a); - if b < strStart then - sub := ncopy(str, a) - else - sub := ncopy(str, a, b-1); - if sub = '' then break; + checkSonsLen(n, 2); + marker := pragmaAsm(con, n.sons[0]); + if marker = #0 then marker := '`'; // default marker + case n.sons[1].kind of + nkStrLit, nkRStrLit, nkTripleStrLit: begin + result := copyNode(n); + str := n.sons[1].strVal; + if str = '' then liMessage(n.info, errEmptyAsm); + // now parse the string literal and substitute symbols: + a := strStart; + repeat + b := findSubStr(marker, str, a); + if b < strStart then + sub := ncopy(str, a) + else + sub := ncopy(str, a, b-1); + if sub <> '' then addSon(result, newStrNode(nkStrLit, sub)); - if b < strStart then break; - c := findSubStr(marker, str, b+1); - if c < strStart then - sub := ncopy(str, b+1) - else - sub := ncopy(str, b+1, c-1); + if b < strStart then break; + c := findSubStr(marker, str, b+1); + if c < strStart then + sub := ncopy(str, b+1) + else + sub := ncopy(str, b+1, c-1); + if sub <> '' then begin e := SymtabGet(con.tab, getIdent(sub)); if e <> nil then addSon(result, newSymNode(e)) else addSon(result, newStrNode(nkStrLit, sub)); - if c < strStart then break; - a := c+1; - until false; - end; - else illFormedAst(n) - end + end; + if c < strStart then break; + a := c+1; + until false; + end; + else illFormedAst(n) end - else - illFormedAst(n); end; function semWhile(c: PContext; n: PNode): PNode; begin result := n; - if sonsLen(n) = 2 then begin - n.sons[0] := semExpr(c, n.sons[0]); - CheckBool(n.sons[0]); - inc(c.p.nestedLoopCounter); - n.sons[1] := semStmtScope(c, n.sons[1]); - dec(c.p.nestedLoopCounter); - end - else - illFormedAst(n); + checkSonsLen(n, 2); + n.sons[0] := semExprWithType(c, n.sons[0]); + CheckBool(n.sons[0]); + inc(c.p.nestedLoopCounter); + n.sons[1] := semStmtScope(c, n.sons[1]); + dec(c.p.nestedLoopCounter); end; function semCase(c: PContext; n: PNode): PNode; @@ -202,7 +189,8 @@ var begin // check selector: result := n; - n.sons[0] := semExprWithType(c, n.sons[0], false); + checkMinSonsLen(n, 2); + n.sons[0] := semExprWithType(c, n.sons[0]); chckCovered := false; covered := 0; case skipVarGenericRange(n.sons[0].Typ).Kind of @@ -214,6 +202,7 @@ begin x := n.sons[i]; case x.kind of nkOfBranch: begin + checkMinSonsLen(x, 2); semCaseBranch(c, n, x, i, covered); len := sonsLen(x); x.sons[len-1] := semStmtScope(c, x.sons[len-1]); @@ -221,14 +210,14 @@ begin nkElifBranch: begin chckCovered := false; checkSonsLen(n, 2); - x.sons[0] := semExpr(c, x.sons[0]); + x.sons[0] := semExprWithType(c, x.sons[0]); checkBool(x.sons[0]); x.sons[1] := semStmtScope(c, x.sons[1]) end; nkElse: begin chckCovered := false; - if sonsLen(x) = 1 then x.sons[0] := semStmtScope(c, x.sons[0]) - else illFormedAst(x) + checkSonsLen(x, 1); + x.sons[0] := semStmtScope(c, x.sons[0]) end; else illFormedAst(x); end; @@ -240,19 +229,75 @@ end; function semAsgn(c: PContext; n: PNode): PNode; var le: PType; + a: PNode; + id: PIdent; begin - result := n; - n.sons[0] := semExprWithType(c, n.sons[0], false); - n.sons[1] := semExprWithType(c, n.sons[1], false); + checkSonsLen(n, 2); + a := n.sons[0]; + case a.kind of + nkDotExpr, nkQualified: begin + // r.f = x + // --> `f=` (r, x) + checkSonsLen(a, 2); + id := considerAcc(a.sons[1]); + result := newNodeI(nkCall, n.info); + addSon(result, newIdentNode(getIdent(id.s+'='), n.info)); + addSon(result, semExpr(c, a.sons[0])); + addSon(result, semExpr(c, n.sons[1])); + result := semDirectCall(c, result); + if result <> nil then begin + fixAbstractType(c, result); + analyseIfAddressTakenInCall(c, result); + exit; + end + end; + nkBracketExpr: begin + // a[i..j] = x + // --> `[..]=`(a, i, j, x) + result := newNodeI(nkCall, n.info); + checkSonsLen(a, 2); + if a.sons[1].kind = nkRange then begin + checkSonsLen(a.sons[1], 2); + addSon(result, newIdentNode(getIdent(whichSliceOpr(a.sons[1])+'='), + n.info)); + addSon(result, semExpr(c, a.sons[0])); + addSonIfNotNil(result, semExpr(c, a.sons[1].sons[0])); + addSonIfNotNil(result, semExpr(c, a.sons[1].sons[1])); + addSon(result, semExpr(c, n.sons[1])); + result := semDirectCall(c, result); + if result <> nil then begin + fixAbstractType(c, result); + analyseIfAddressTakenInCall(c, result); + exit; + end + end + else begin + addSon(result, newIdentNode(getIdent('[]='), n.info)); + addSon(result, semExpr(c, a.sons[0])); + addSon(result, semExpr(c, a.sons[1])); + addSon(result, semExpr(c, n.sons[1])); + result := semDirectCall(c, result); + if result <> nil then begin + fixAbstractType(c, result); + analyseIfAddressTakenInCall(c, result); + exit; + end + end; + end; + else begin end; + end; + n.sons[0] := semExprWithType(c, n.sons[0], {@set}[efLValue]); + n.sons[1] := semExprWithType(c, n.sons[1]); le := n.sons[0].typ; - if not (tfAssignable in le.flags) and (le.kind <> tyVar) then begin + if (skipGeneric(le).kind <> tyVar) and not IsAssignable(n.sons[0]) then begin liMessage(n.sons[0].info, errXCannotBeAssignedTo, renderTree(n.sons[0], {@set}[renderNoComments])); end else begin n.sons[1] := fitNode(c, le, n.sons[1]); - fixAbstractType(c, n); - end + fixAbstractType(c, n); + end; + result := n; end; function SemReturn(c: PContext; n: PNode): PNode; @@ -261,10 +306,11 @@ var a: PNode; // temporary assignment for code generator begin result := n; - if not (c.p.owner.kind in [skConverter, skProc]) then + checkSonsLen(n, 1); + if not (c.p.owner.kind in [skConverter, skProc, skMacro]) then liMessage(n.info, errReturnNotAllowedHere); if (n.sons[0] <> nil) then begin - n.sons[0] := SemExprWithType(c, n.sons[0], false); + n.sons[0] := SemExprWithType(c, n.sons[0]); // check for type compatibility: restype := c.p.owner.typ.sons[0]; if (restype <> nil) then begin @@ -280,7 +326,7 @@ begin end else begin assert(c.p.resultSym <> nil); - addSon(a, semExprWithType(c, newSymNode(c.p.resultSym), false)); + addSon(a, semExprWithType(c, newSymNode(c.p.resultSym))); addSon(a, n.sons[0]); n.sons[0] := a; end @@ -295,10 +341,11 @@ var restype: PType; begin result := n; + checkSonsLen(n, 1); if (c.p.owner = nil) or (c.p.owner.kind <> skIterator) then liMessage(n.info, errYieldNotAllowedHere); if (n.sons[0] <> nil) then begin - n.sons[0] := SemExprWithType(c, n.sons[0], false); + n.sons[0] := SemExprWithType(c, n.sons[0]); // check for type compatibility: restype := c.p.owner.typ.sons[0]; if (restype <> nil) then begin @@ -311,11 +358,11 @@ begin end; function fitRemoveHiddenConv(c: PContext; typ: Ptype; n: PNode): PNode; -begin +begin result := fitNode(c, typ, n); if (result.kind in [nkHiddenStdConv, nkHiddenSubConv]) then begin - changeType(result.sons[0], typ); - result := result.sons[0]; + changeType(result.sons[1], typ); + result := result.sons[1]; end else if not sameType(result.typ, typ) then changeType(result, typ) @@ -332,22 +379,21 @@ begin for i := 0 to sonsLen(n)-1 do begin a := n.sons[i]; if a.kind = nkCommentStmt then continue; - assert(a.kind = nkIdentDefs); + 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 typ := nil; if a.sons[len-1] <> nil then begin - def := semExprWithType(c, a.sons[len-1], false); + def := semExprWithType(c, a.sons[len-1]); // check type compability between def.typ and typ: if (typ <> nil) then def := fitRemoveHiddenConv(c, typ, def) else typ := def.typ; end else def := nil; - typ := copyType(typ, typ.owner); - include(typ.flags, tfAssignable); for j := 0 to len-3 do begin if (c.p.owner = nil) then begin v := semIdentWithPragma(c, skVar, a.sons[j], {@set}[sfStar, sfMinus]); @@ -366,7 +412,7 @@ begin addSon(b, copyTree(def)); addSon(result, b); end - end; + end end; function semConst(c: PContext; n: PNode): PNode; @@ -380,8 +426,8 @@ begin for i := 0 to sonsLen(n)-1 do begin a := n.sons[i]; if a.kind = nkCommentStmt then continue; - assert(a.kind = nkConstDef); - assert(sonsLen(a) = 3); + if (a.kind <> nkConstDef) then IllFormedAst(a); + checkSonsLen(a, 3); if (c.p.owner = nil) then begin v := semIdentWithPragma(c, skConst, a.sons[0], {@set}[sfStar, sfMinus]); include(v.flags, sfGlobal); @@ -420,8 +466,10 @@ var countupNode, m: PNode; begin result := n; + checkMinSonsLen(n, 3); len := sonsLen(n); if n.sons[len-2].kind = nkRange then begin + checkSonsLen(n.sons[len-2], 2); // convert ``in 3..5`` to ``in countup(3, 5)`` // YYY: if the programmer overrides system.countup in a local scope // this leads to wrong code. This is extremely hard to fix! But it may @@ -430,18 +478,16 @@ begin newSons(countupNode, 3); countupNode.sons[0] := newNodeI(nkQualified, n.sons[len-2].info); newSons(countupNode.sons[0], 2); - m := newIdentNode(getIdent('system')); - m.info := n.sons[len-2].info; + m := newIdentNode(getIdent('system'), n.sons[len-2].info); countupNode.sons[0].sons[0] := m; - m := newIdentNode(getIdent('countup')); - m.info := n.sons[len-2].info; + m := newIdentNode(getIdent('countup'), n.sons[len-2].info); countupNode.sons[0].sons[1] := m; countupNode.sons[1] := n.sons[len-2].sons[0]; countupNode.sons[2] := n.sons[len-2].sons[1]; n.sons[len-2] := countupNode; end; - n.sons[len-2] := semExprWithType(c, n.sons[len-2], false); - iter := n.sons[len-2].typ; + n.sons[len-2] := semExprWithType(c, n.sons[len-2]); + iter := skipGeneric(n.sons[len-2].typ); openScope(c.tab); if iter.kind <> tyTuple then begin if len <> 3 then liMessage(n.info, errWrongNumberOfLoopVariables); @@ -472,8 +518,9 @@ var typ: PType; begin result := n; + checkSonsLen(n, 1); if n.sons[0] <> nil then begin - n.sons[0] := semExprWithType(c, n.sons[0], false); + n.sons[0] := semExprWithType(c, n.sons[0]); typ := n.sons[0].typ; if (typ.kind <> tyRef) or (typ.sons[0].kind <> tyObject) then liMessage(n.info, errExprCannotBeRaised) @@ -488,10 +535,12 @@ var check: TIntSet; begin result := n; + checkMinSonsLen(n, 2); n.sons[0] := semStmtScope(c, n.sons[0]); IntSetInit(check); for i := 1 to sonsLen(n)-1 do begin a := n.sons[i]; + checkMinSonsLen(a, 1); len := sonsLen(a); if a.kind = nkExceptBranch then begin for j := 0 to len-2 do begin @@ -504,7 +553,9 @@ begin if IntSetContainsOrIncl(check, typ.id) then liMessage(a.sons[j].info, errExceptionAlreadyHandled); end - end; + end + else if a.kind <> nkFinally then + illFormedAst(n); // last child of an nkExcept/nkFinally branch is a statement: a.sons[len-1] := semStmtScope(c, a.sons[len-1]); end; @@ -534,7 +585,6 @@ end; function resolveGenericParams(c: PContext; n: PNode): PNode; begin - //result := resolveTemplateParams(c, n); // we can use the same algorithm result := n; end; @@ -551,8 +601,8 @@ begin for i := 0 to sonsLen(n)-1 do begin a := n.sons[i]; if a.kind = nkCommentStmt then continue; - assert(a.kind = nkTypeDef); - assert(sonsLen(a) = 3); + if (a.kind <> nkTypeDef) then IllFormedAst(a); + checkSonsLen(a, 3); if (c.p.owner = nil) then begin s := semIdentWithPragma(c, skType, a.sons[0], {@set}[sfStar, sfMinus]); include(s.flags, sfGlobal); @@ -563,6 +613,8 @@ begin include(s.flags, sfInInterface); s.typ := newTypeS(tyForward, c); s.typ.sym := s; + // process pragmas: + if a.sons[0].kind = nkPragmaExpr then pragmaType(c, s, a.sons[0].sons[1]); // add it here, so that recursive types are possible: addInterfaceDecl(c, s); a.sons[0] := newSymNode(s); @@ -572,9 +624,9 @@ begin for i := 0 to sonsLen(n)-1 do begin a := n.sons[i]; if a.kind = nkCommentStmt then continue; - assert(a.kind = nkTypeDef); - assert(a.sons[0].kind = nkSym); - assert(sonsLen(a) = 3); + if (a.kind <> nkTypeDef) then IllFormedAst(a); + checkSonsLen(a, 3); + if (a.sons[0].kind <> nkSym) then IllFormedAst(a); s := a.sons[0].sym; if (s.magic = mNone) and (a.sons[2] = nil) then liMessage(a.info, errTypeXNeedsImplementation, s.name.s); @@ -583,9 +635,11 @@ begin // type's body: openScope(c.tab); pushOwner(c, s); + s.typ.kind := tyGeneric; semGenericParamList(c, a.sons[1]); - // process the type body for symbol lookup of generic params: - a.sons[2] := resolveGenericParams(c, a.sons[2]); + // process the type body for symbol lookup of generic params + // we can use the same algorithm as for template parameters: + a.sons[2] := resolveTemplateParams(c, a.sons[2]); s.ast := a; assert(s.typ.containerID = 0); s.typ.containerID := getID(); @@ -617,7 +671,7 @@ var i: int; begin for i := 1 to sonsLen(n)-1 do begin - assert(n.sons[i].kind = nkSym); + if (n.sons[i].kind <> nkSym) then InternalError(n.info, 'addParams'); addDecl(c, n.sons[i].sym); end end; @@ -628,6 +682,7 @@ var oldP: PProcCon; begin result := n; + checkSonsLen(n, codePos+1); if c.p.owner <> nil then liMessage(n.info, errIteratorNotAllowed); oldP := c.p; // restore later @@ -682,7 +737,7 @@ begin if t <> nil then begin s := newSym(skVar, getIdent('result'), getCurrOwner(c)); s.info := info; - s.typ := inheritAssignable(t, true); + s.typ := t; Include(s.flags, sfResult); addDecl(c, s); c.p.resultSym := s; @@ -700,6 +755,7 @@ var oldP: PProcCon; begin result := n; + checkSonsLen(n, codePos+1); s := newSym(skProc, getIdent(genPrefix + 'anonymous'), getCurrOwner(c)); s.info := n.info; @@ -744,18 +800,19 @@ begin c.p := oldP; // restore end; -function semProc(c: PContext; n: PNode): PNode; +function semProcAux(c: PContext; n: PNode; kind: TSymKind): PNode; var s, proto: PSym; oldP: PProcCon; begin result := n; + checkSonsLen(n, codePos+1); if c.p.owner = nil then begin - s := semIdentVis(c, skProc, n.sons[0], {@set}[sfStar]); + s := semIdentVis(c, kind, n.sons[0], {@set}[sfStar]); include(s.flags, sfGlobal); end else - s := semIdentVis(c, skProc, n.sons[0], {@set}[]); + s := semIdentVis(c, kind, n.sons[0], {@set}[]); n.sons[namePos] := newSymNode(s); oldP := c.p; // restore later if sfStar in s.flags then include(s.flags, sfInInterface); @@ -784,9 +841,13 @@ begin s.typ.callConv := lastOptionEntry(c).defaultCC; // add it here, so that recursive procs are possible: // -2 because we have a scope open for parameters - addInterfaceOverloadableSymAt(c, s, c.tab.tos-2); + if kind in OverloadableSyms then + addInterfaceOverloadableSymAt(c, s, c.tab.tos-2) + else + addDeclAt(c, s, c.tab.tos-2); if n.sons[pragmasPos] <> nil then - pragmaProc(c, s, n.sons[pragmasPos]); + if kind = skMacro then pragmaMacro(c, s, n.sons[pragmasPos]) + else pragmaProc(c, s, n.sons[pragmasPos]); end else begin if n.sons[pragmasPos] <> nil then @@ -825,48 +886,64 @@ begin else begin if proto <> nil then liMessage(n.info, errImplOfXexpected, proto.name.s); - if not (sfImportc in s.flags) then - Include(s.flags, sfForward); + if not (sfImportc in s.flags) then Include(s.flags, sfForward); end; closeScope(c.tab); // close scope for parameters popOwner(c); c.p := oldP; // restore end; +function semProc(c: PContext; n: PNode): PNode; +begin + result := semProcAux(c, n, skProc); +end; + function isTopLevel(c: PContext): bool; begin result := c.tab.tos <= 2 end; -{$include 'importer.pas'} -(* -function isConcreteStmt(n: PNode): bool; +function semConverterDef(c: PContext; n: PNode): PNode; +var + t: PType; + s: PSym; begin - case n.kind of - nkProcDef, nkIteratorDef: result := n.sons[genericParamsPos] = nil; - nkCommentStmt, nkTemplateDef, nkMacroDef: result := false; - else result := true - end + checkSonsLen(n, codePos+1); + if n.sons[genericParamsPos] <> nil then + liMessage(n.info, errNoGenericParamsAllowedForX, 'converter'); + result := semProcAux(c, n, skConverter); + s := result.sons[namePos].sym; + t := s.typ; + if t.sons[0] = nil then + liMessage(n.info, errXNeedsReturnType, 'converter'); + if sonsLen(t) <> 2 then + liMessage(n.info, errXRequiresOneArgument, 'converter'); + addConverter(c, s); end; -function TopLevelEvent(c: PContext; n: PNode): PNode; +function semMacroDef(c: PContext; n: PNode): PNode; +var + t: PType; + s: PSym; begin - result := n; - if isTopLevel(c) and (eTopLevel in c.b.eventMask) then begin - if isConcreteStmt(result) then begin - if optVerbose in gGlobalOptions then - MessageOut('compiling: ' + renderTree(result, {@set}[renderNoBody, - renderNoComments])); - result := transform(c, result); - result := c.b.topLevelEvent(c.b, result); - end - end -end; *) + checkSonsLen(n, codePos+1); + if n.sons[genericParamsPos] <> nil then + liMessage(n.info, errNoGenericParamsAllowedForX, 'macro'); + result := semProcAux(c, n, skMacro); + s := result.sons[namePos].sym; + t := s.typ; + if t.sons[0] = nil then + liMessage(n.info, errXNeedsReturnType, 'macro'); + if sonsLen(t) <> 2 then + liMessage(n.info, errXRequiresOneArgument, 'macro'); +end; + +{$include 'importer.pas'} function SemStmt(c: PContext; n: PNode): PNode; const // must be last statements in a block: - LastBlockStmts = {@set}[nkRaiseStmt, nkReturnStmt, nkBreakStmt, + LastBlockStmts = {@set}[nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt]; var len, i, j: int; @@ -910,9 +987,11 @@ begin nkReturnStmt: result := semReturn(c, n); nkAsmStmt: result := semAsm(c, n); nkYieldStmt: result := SemYield(c, n); - nkPragma: pragmaStmt(c, n); + nkPragma: pragmaStmt(c, c.p.owner, n); nkIteratorDef: result := semIterator(c, n); nkProcDef: result := semProc(c, n); + nkConverterDef: result := semConverterDef(c, n); + nkMacroDef: result := semMacroDef(c, n); nkTemplateDef: result := semTemplateDef(c, n); nkImportStmt: begin if not isTopLevel(c) then @@ -930,7 +1009,8 @@ begin result := evalInclude(c, n); end; else liMessage(n.info, errStmtExpected); - end + end; + if result = nil then InternalError(n.info, 'SemStmt: result = nil'); end; function semStmtScope(c: PContext; n: PNode): PNode; diff --git a/nim/semtempl.pas b/nim/semtempl.pas index f7f0cadd5..b861949c9 100644 --- a/nim/semtempl.pas +++ b/nim/semtempl.pas @@ -15,7 +15,7 @@ begin if n = nil then begin result := false; exit end; case n.kind of nkIdent..nkNilLit: result := true; - nkCall..nkCast: begin + nkCall..nkPassAsOpenArray: begin for i := 0 to sonsLen(n)-1 do if not isExpr(n.sons[i]) then begin result := false; exit @@ -27,7 +27,7 @@ begin end; function isTypeDesc(n: PNode): bool; -// returns true if ``n`` looks like an type desc +// returns true if ``n`` looks like a type desc var i: int; begin @@ -46,15 +46,6 @@ begin end end; -function semMacroExpr(c: PContext; n: PNode; sym: PSym): PNode; -begin - // macros can be overloaded by the number of arguments? - // no: would make variable number of arguments more - // complicated! - // XXX - result := n; -end; - function evalTemplateAux(c: PContext; templ, actual: PNode; sym: PSym): PNode; var @@ -88,7 +79,7 @@ var r: PNode; begin inc(evalTemplateCounter); - if evalTemplateCounter > 100 then + if evalTemplateCounter > 100 then liMessage(n.info, errTemplateInstantiationTooNested); // replace each param by the corresponding node: r := sym.ast.sons[paramsPos].sons[0]; @@ -156,7 +147,7 @@ begin end end end; - if realStmt >= 0 then + if realStmt >= 0 then result := transformToExpr(n.sons[realStmt]) else n.kind := nkStmtListExpr; @@ -213,7 +204,7 @@ begin n.sons[codePos] := transformToExpr(n.sons[codePos]); // only parameters are resolved, no type checking is performed - closeScope(c.tab); + closeScope(c.tab); popOwner(c); s.ast := n; diff --git a/nim/semtypes.pas b/nim/semtypes.pas index e402b9864..e0a3f59b9 100644 --- a/nim/semtypes.pas +++ b/nim/semtypes.pas @@ -38,6 +38,7 @@ begin base := nil; result := newOrPrevType(tyEnum, prev, c); result.n := newNode(nkEnumTy); + checkMinSonsLen(n, 1); if n.sons[0] <> nil then begin base := semTypeNode(c, n.sons[0].sons[0], nil); if base.kind <> tyEnum then @@ -71,7 +72,7 @@ begin StrTableAdd(c.module.tab, e); // BUGFIX end; addSon(result.n, newSymNode(e)); - addOverloadableSymAt(c, e, c.tab.tos-1); + addDeclAt(c, e, c.tab.tos-1); inc(counter); end; end; @@ -123,11 +124,26 @@ begin 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 semRangeAux(c: PContext; n: PNode; prev: PType): PType; var a, b: PNode; begin assert(n.kind = nkRange); + checkSonsLen(n, 2); result := newOrPrevType(tyRange, prev, c); result.n := copyTree(n); result.n := newNode(nkRange); @@ -197,13 +213,37 @@ end; function semTuple(c: PContext; n: PNode; prev: PType): PType; var - i: int; - elem: PType; + i, j, len, counter: int; + typ: PType; + check: TIntSet; + a: PNode; + field: PSym; begin result := newOrPrevType(tyTuple, prev, c); - for i := 1 to sonsLen(n)-1 do begin // BUGFIX: start from 1 - elem := semTypeNode(c, n.sons[i], nil); - addSon(result, elem); + 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; @@ -212,6 +252,7 @@ function instGenericAux(c: PContext; templ, actual: PNode; var i: int; begin + if templ = nil then begin result := nil; exit end; case templ.kind of nkSym: begin if (templ.sym.kind = skTypeParam) @@ -237,20 +278,27 @@ var elem: PType; inst: PNode; begin - if (s.typ = nil) or (s.typ.kind <> tyGeneric) then + if (s.typ = nil) or (s.typ.kind <> tyGeneric) then liMessage(n.info, errCannotInstantiateX, s.name.s); result := newOrPrevType(tyGenericInst, prev, c); result.containerID := s.typ.containerID; + result.sym := s; assert(s.typ.containerID <> 0); for i := 1 to sonsLen(n)-1 do begin elem := semTypeNode(c, n.sons[i], nil); + if elem.kind = tyGenericParam then result.kind := tyGeneric; addSon(result, elem); end; if s.ast <> nil then begin inst := instGenericAux(c, s.ast.sons[2], n, s); - elem := semTypeNode(c, inst, nil); - // does checking of instantiated type for us! - addSon(result, elem); + if result.kind = tyGenericInst then begin + // does checking of instantiated type for us: + elem := semTypeNode(c, inst, nil); + elem.id := result.containerID; + addSon(result, elem); + end + else + addSon(result, nil); end else liMessage(n.info, errCannotInstantiateX, s.name.s); @@ -285,9 +333,12 @@ 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: pragmaType(c, result, n.sons[1]); + skType: begin + // process pragmas later, because result.typ has not been set yet + end; skField: pragmaField(c, result, n.sons[1]); skVar: pragmaVar(c, result, n.sons[1]); skConst: pragmaConst(c, result, n.sons[1]); @@ -311,6 +362,7 @@ 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; @@ -325,6 +377,7 @@ 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 @@ -341,11 +394,12 @@ end; procedure semRecordNodeAux(c: PContext; n: PNode; var check: TIntSet; - var pos: int; father: PNode); forward; + var pos: int; father: PNode; + rectype: PSym); forward; procedure semRecordCase(c: PContext; n: PNode; var check: TIntSet; - var pos: int; father: PNode); + var pos: int; father: PNode; rectype: PSym); var i: int; covered: biggestint; @@ -354,7 +408,8 @@ var typ: PType; begin a := copyNode(n); - semRecordNodeAux(c, n.sons[0], check, pos, a); + 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); @@ -370,12 +425,18 @@ begin for i := 1 to sonsLen(n)-1 do begin b := copyTree(n.sons[i]); case n.sons[i].kind of - nkOfBranch: semCaseBranch(c, a, b, i, covered); - nkElse: chckCovered := false; - else internalError(n.info, 'semRecordAux(record case branch)'); + 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); + semRecordNodeAux(c, lastSon(n.sons[i]), check, pos, b, rectype); addSon(a, b); end; if chckCovered and (covered <> lengthOrd(a.sons[0].typ)) then @@ -385,7 +446,7 @@ end; procedure semRecordNodeAux(c: PContext; n: PNode; var check: TIntSet; - var pos: int; father: PNode); + var pos: int; father: PNode; rectype: PSym); var i, len: int; f: PSym; // new field @@ -416,22 +477,23 @@ begin end end; if branch <> nil then - semRecordNodeAux(c, branch, check, pos, father); + semRecordNodeAux(c, branch, check, pos, father, rectype); end; nkRecCase: begin - semRecordCase(c, n, check, pos, father); + semRecordCase(c, n, check, pos, father, rectype); 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); + 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 := newNode(nkRecList) else a := nil; @@ -444,6 +506,12 @@ 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); @@ -452,9 +520,7 @@ begin end; if a <> nil then addSon(father, a); end; - else begin - InternalError(n.info, 'semRecordAux(' +{&} nodeKindToStr[n.kind] +{&} ')') - end + else illFormedAst(n); end end; @@ -508,22 +574,25 @@ 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, errInheritanceOnlyWithObjects); + liMessage(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects); end else base := nil; if n.kind = nkObjectTy then result := newOrPrevType(tyObject, prev, c) else - result := newOrPrevType(tyRecord, prev, c); + InternalError(n.info, 'semObjectNode'); addSon(result, base); result.n := newNode(nkRecList); - semRecordNodeAux(c, n.sons[2], check, pos, result.n); + semRecordNodeAux(c, n.sons[2], check, pos, result.n, result.sym); + if (tfFinal in result.flags) and (base <> nil) then + liMessage(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects); end; function semProcTypeNode(c: PContext; n: PNode; prev: PType): PType; @@ -534,6 +603,7 @@ var arg: PSym; check: TIntSet; begin + checkMinSonsLen(n, 1); result := newOrPrevType(tyProc, prev, c); result.callConv := lastOptionEntry(c).defaultCC; result.n := newNode(nkFormalParams); @@ -551,17 +621,18 @@ begin counter := 0; for i := 1 to sonsLen(n)-1 do begin a := n.sons[i]; - assert(a.kind = nkIdentDefs); + 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 typ := nil; if a.sons[len-1] <> nil then begin - def := semExprWithType(c, a.sons[len-1], false); + 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 + if (cmpTypes(typ, def.typ) < isConvertible) then begin typeMismatch(a.sons[len-1], typ, def.typ); end; def := fitNode(c, typ, def); @@ -593,15 +664,15 @@ begin embeddedDbg(c, n); case n.kind of nkTypeOfExpr: begin - result := semExprWithType(c, n, true).typ; + result := semExprWithType(c, n, {@set}[efAllowType]).typ; 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); - mTuple: result := semTuple(c, n, prev); mSet: result := semSet(c, n, prev); mSeq: result := semContainer(c, n, tySequence, 'seq', prev); else result := semGeneric(c, n, s, prev); @@ -617,7 +688,6 @@ begin assignType(prev, s.typ); result := prev; end - // result := copyType(s.typ, s.owner); end; nkSym: begin if (n.sym.kind in [skTypeParam, skType]) and (n.sym.typ <> nil) then begin @@ -627,22 +697,21 @@ begin assignType(prev, s.typ); result := prev; end; - // result := copyType(n.sym.typ, n.sym.owner); include(n.sym.flags, sfUsed); // BUGFIX end else liMessage(n.info, errTypeExpected); end; - nkRecordTy, nkObjectTy: begin - result := semObjectNode(c, n, prev); - 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 := semAnyRef(c, n, tyVar, 'var', prev); + nkVarTy: result := semVarType(c, n, prev); nkProcTy: begin + checkSonsLen(n, 2); result := semProcTypeNode(c, n.sons[0], prev); // dummy symbol for `pragma`: - s := newSymS(skProc, newIdentNode(getIdent('dummy')), c); + s := newSymS(skProc, newIdentNode(getIdent('dummy'), n.info), c); s.typ := result; pragmaProcType(c, s, n.sons[1]); end; diff --git a/nim/sigmatch.pas b/nim/sigmatch.pas index 69ffdbb43..6257d5178 100644 --- a/nim/sigmatch.pas +++ b/nim/sigmatch.pas @@ -96,12 +96,9 @@ function typeRel(var mapping: TIdTable; f, a: PType): TTypeRelation; overload; function concreteType(t: PType): PType; begin case t.kind of - tyRecordConstr: begin - result := newType(tyRecord, t.owner); - // XXX semantic checking for the type? - end; - tyArrayConstr: begin // make it an open array - result := newType(tyOpenArray, t.owner); + 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; tyEmptySet, tyNil: result := nil; // what should it be? @@ -140,99 +137,35 @@ begin if a <= b then result := a else result := b end; -function recordRelAux(var mapping: TIdTable; f, a: PType; - var fields: TIntSet): TTypeRelation; +function tupleRel(var mapping: TIdTable; f, a: PType): TTypeRelation; var - i, j: int; - field: PSym; - found: bool; + i: int; + x, y: PSym; + m: TTypeRelation; begin - result := isEqual; - if (f.kind <> tyRecordConstr) and (f.sons[0] <> nil) then begin - // basetype of object - result := recordRelAux(mapping, f.sons[0], a, fields); - if result = isNone then exit; - end; - for i := 0 to sonsLen(f.n)-1 do begin - if f.n.sons[i].kind = nkSym then begin - found := false; - for j := 0 to sonsLen(a.n)-1 do begin - field := a.n.sons[j].sym; - if field.name.id = f.n.sons[i].sym.name.id then begin - found := true; - if IntSetContainsOrIncl(fields, field.name.id) then begin - result := isNone; exit - end; - result := minRel(result, typeRel(mapping, f.n.sons[i].typ, - field.typ)); - if result = isNone then exit + 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; - if not found and (f.n.sons[i].sym.ast = nil) then begin - // needs default value, but has none - result := isNone; exit end end - else begin - // case in record? - result := isNone; exit - end - end; - for i := 0 to sonsLen(a.n)-1 do begin - if not IntSetContainsOrIncl(fields, a.n.sons[i].sym.name.id) then begin - result := isNone; exit - end end end; -function recordRel(var mapping: TIdTable; f, a: PType): TTypeRelation; -var - fields: TIntSet; -begin - assert(a.kind = tyRecordConstr); - IntSetInit(fields); - result := recordRelAux(mapping, f, a, fields); -end; - -function tupleRelAux(var mapping: TIdTable; f, a: PType; - var start: int): TTypeRelation; -var - i: int; -begin - result := isEqual; - assert(a.kind = tyTuple); - if f.sons[0] <> nil then begin // basetype of object - result := tupleRelAux(mapping, f.sons[0], a, start); - if result = isNone then exit; - end; - for i := 0 to sonsLen(f.n)-1 do begin - if f.n.sons[i].kind = nkSym then begin - if i+start < sonsLen(a) then begin - result := minRel(result, typeRel(mapping, f.n.sons[i].typ, - a.sons[i+start])); - if result = isNone then exit - end - else if f.n.sons[i].sym.ast = nil then begin - // needs default value, but has none - result := isNone; exit - end - end - else begin - // case in record? - result := isNone; exit - end - end; - inc(start, sonsLen(f)); -end; - -function tupleRel(var mapping: TIdTable; f, a: PType): TTypeRelation; -var - start: int; -begin - start := 0; - result := tupleRelAux(mapping, f, a, start); -end; - function typeRel(var mapping: TIdTable; f, a: PType): TTypeRelation; var x, concrete: PType; @@ -242,7 +175,7 @@ begin // is a subtype of f? result := isNone; assert(f <> nil); assert(a <> nil); - if (a.kind = tyGenericInst) and (f.kind <> tyGeneric) then begin + if (a.kind = tyGenericInst) and (skipVar(f).kind <> tyGeneric) then begin result := typeRel(mapping, f, lastSon(a)); exit end; @@ -280,7 +213,7 @@ begin // is a subtype of f? tyVar: begin if (a.kind = f.kind) then result := typeRel(mapping, base(f), base(a)) - else //if tfAssignable in a.flags then + else result := typeRel(mapping, base(f), a) end; tyArray, tyArrayConstr: begin // tyArrayConstr cannot happen really, but @@ -347,64 +280,12 @@ begin // is a subtype of f? if a.kind = f.kind then result := isEqual end; tyTuple: begin - case a.kind of - tyTuple: begin - 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 < isGeneric then begin result := isNone; exit end; - result := minRel(result, m); - end; - if sonsLen(a) > sonsLen(f) then result := isSubtype; - end - end; - tyRecord, tyRecordConstr: begin - if sonsLen(a.n) >= sonsLen(f) then begin - result := isEqual; - for i := 0 to sonsLen(f)-1 do begin - m := typeRel(mapping, f.sons[i], a.n.sons[i].sym.typ); - if m < isGeneric then begin result := isNone; exit end; - result := minRel(result, m); - end; - if sonsLen(a.n) > sonsLen(f) then result := isSubtype; - end - end; - else begin end - end - end; - tyRecordConstr: begin // can happen for array constr of record constr - case a.kind of - tyRecord, tyRecordConstr: result := recordRel(mapping, f, a); - tyTuple: result := tupleRel(mapping, f, a); - else begin end - end - end; - tyRecord: begin - // structural equivalence is enough for constructors! - case a.kind of - tyRecord: begin - if a.id = f.id then result := isEqual - end; - tyRecordConstr: begin - result := recordRel(mapping, f, a); - end; - tyTuple: begin - result := tupleRel(mapping, f, a); - end; - else begin end - end + if a.kind = tyTuple then result := tupleRel(mapping, f, a); end; tyObject: begin - // easy: - case a.kind of - tyObject: begin - if a.id = f.id then result := isEqual - else if isObjectSubtype(a, f) then result := isSubtype - end; - tyRecordConstr: result := recordRel(mapping, f, a); - tyTuple: result := tupleRel(mapping, f, a); - else begin end + if a.kind = tyObject then begin + if a.id = f.id then result := isEqual + else if isObjectSubtype(a, f) then result := isSubtype end end; tySet: begin @@ -414,7 +295,7 @@ begin // is a subtype of f? end; tySet: begin result := typeRel(mapping, base(f), base(a)); - if result <= isConvertible then result := isEqual + if result <= isConvertible then result := isNone // BUGFIX! end; else begin end end @@ -519,15 +400,16 @@ begin // is a subtype of f? else begin end end end; - tyGenericInst: + tyGenericInst: begin result := typeRel(mapping, lastSon(f), a); + end; tyGeneric: begin x := PType(idTableGet(mapping, f)); if x = nil then begin assert(f.containerID <> 0); - if (f.containerID = a.containerID) and - (sonsLen(a) >= sonsLen(f)) then begin - // >= for partial generic matching! + assert(lastSon(f) = nil); + 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; @@ -583,21 +465,23 @@ function getInstantiatedType(c: PContext; arg: PNode; const m: TCandidate; f: PType): PType; begin result := PType(idTableGet(m.bindings, f)); - if result = nil then + if result = nil then begin result := generateTypeInstance(c, m.bindings, arg.info, f); + end; if result = nil then InternalError(arg.info, 'getInstantiatedType'); end; -function implicitConv(kind: TNodeKind; f: PType; arg: PNode; +function implicitConv(kind: TNodeKind; f: PType; arg: PNode; const m: TCandidate; c: PContext): PNode; begin - result := newNode(kind); - result.info := arg.info; - if containsGenericType(f) then + result := newNodeI(kind, arg.info); + if containsGenericType(f) then result.typ := getInstantiatedType(c, arg, m, f) else result.typ := f; - addSon(result, copyTree(arg)); + 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; @@ -613,11 +497,10 @@ begin dest := c.converters[i].typ.sons[0]; if (typeRel(m.bindings, f, dest) = isEqual) and (typeRel(m.bindings, src, a) = isEqual) then begin - result := newNode(nkHiddenCallConv); - result.info := arg.info; 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); @@ -635,44 +518,44 @@ begin case r of isConvertible: begin inc(m.convMatches); - result := implicitConv(nkHiddenStdConv, f, arg, m, c); + result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); end; isSubtype: begin inc(m.subtypeMatches); - result := implicitConv(nkHiddenSubConv, f, arg, m, c); + 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 (skipVarGeneric(f).kind in [tyTuple, tyOpenArray]) then + // BUGFIX: must pass length implicitely + result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); end; isEqual: begin inc(m.exactMatches); result := copyTree(arg); - if (skipVarGeneric(f).kind = tyOpenArray) then + if (skipVarGeneric(f).kind in [tyTuple, tyOpenArray]) then // BUGFIX: must pass length implicitely - result := implicitConv(nkHiddenStdConv, f, arg, m, c); + 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) or (f.kind = tySequence)) then begin + if (result = nil) and (f.kind = tyOpenArray) then begin r := typeRel(m.bindings, base(f), a); - if r > isGeneric then begin + 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; - exit end else result := userConvMatch(c, m, base(f), a, arg); - end *) + end end end end; @@ -711,6 +594,7 @@ begin 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 @@ -733,13 +617,12 @@ begin exit end; m.baseTypeMatch := false; - arg := ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, + 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 := newNode(nkBracket); - container.info := n.sons[a].info; + container := newNodeI(nkBracket, n.sons[a].info); addSon(container, arg); setSon(m.call, formal.position+1, container); if f <> formalLen-1 then container := nil; @@ -753,14 +636,14 @@ begin 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 skipVarGeneric(n.sons[a].typ).kind = tyString then + if skipVarGeneric(n.sons[a].typ).kind = tyString then // conversion to cstring - addSon(m.call, implicitConv(nkHiddenStdConv, - getSysType(tyCString), n.sons[a], m, c)) + addSon(m.call, implicitConv(nkHiddenStdConv, + getSysType(tyCString), copyTree(n.sons[a]), m, c)) else addSon(m.call, copyTree(n.sons[a])); end - else begin + 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 @@ -771,9 +654,14 @@ begin exit end; end + else begin + m.state := csNoMatch; + exit + end end else begin - assert(m.callee.n.sons[f].kind = nkSym); + 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: @@ -786,10 +674,10 @@ begin if (arg = nil) then begin m.state := csNoMatch; exit end; if m.baseTypeMatch then begin assert(container = nil); - container := newNode(nkBracket); - container.info := n.sons[a].info; + container := newNodeI(nkBracket, n.sons[a].info); addSon(container, arg); - setSon(m.call, formal.position+1, container); + setSon(m.call, formal.position+1, + implicitConv(nkHiddenStdConv, formal.typ, container, m, c)); if f <> formalLen-1 then container := nil; end else begin @@ -825,6 +713,8 @@ var cmp: int; begin 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); @@ -848,14 +738,14 @@ begin end; sym := nextOverloadIter(o, c, n.sons[0]) end; - result := nil; 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) then begin - assert((x.state = csMatch)); + if x.state <> csMatch then + InternalError(n.info, 'x.state is not csMatch'); //writeMatches(x); //writeMatches(y); liMessage(n.Info, errGenerated, diff --git a/nim/strtabs.pas b/nim/strtabs.pas new file mode 100644 index 000000000..1df147f08 --- /dev/null +++ b/nim/strtabs.pas @@ -0,0 +1,295 @@ +// +// +// Nimrod's Runtime Library +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit strtabs; + +// A configuration file parser; the Nimrod version of this file +// will become part of the standard library. + +interface + +{$include 'config.inc'} + +uses + nsystem, nos, hashes, strutils; + +type + TStringTableMode = ( + modeCaseSensitive, // the table is case sensitive + modeCaseInsensitive, // the table is case insensitive + modeStyleInsensitive // the table is style insensitive + ); + TKeyValuePair = record{@tuple} + key, val: string; + end; + TKeyValuePairSeq = array of TKeyValuePair; + TStringTable = object(NObject) + counter: int; + data: TKeyValuePairSeq; + mode: TStringTableMode; + end; + PStringTable = ^TStringTable; + +function newStringTable(const keyValuePairs: array of string; + mode: TStringTableMode = modeCaseSensitive): PStringTable; + +procedure put(t: PStringTable; const key, val: string); +function get(t: PStringTable; const key: string): string; +function hasKey(t: PStringTable; const key: string): bool; +function len(t: PStringTable): int; + +type + TFormatFlag = ( + useEnvironment, // use environment variable if the ``$key`` + // is not found in the table + useEmpty, // use the empty string as a default, thus it + // won't throw an exception if ``$key`` is not + // in the table + useKey // do not replace ``$key`` if it is not found + // in the table (or in the environment) + ); + TFormatFlags = set of TFormatFlag; + +function format(const f: string; t: PStringTable; + flags: TFormatFlags = {@set}[]): string; + +implementation + +const + growthFactor = 2; + startSize = 64; + +{@ignore} +function isNil(const s: string): bool; +begin + result := s = '' +end; +{@emit} + +function newStringTable(const keyValuePairs: array of string; + mode: TStringTableMode = modeCaseSensitive): PStringTable; +var + i: int; +begin + new(result); + result.mode := mode; + result.counter := 0; +{@emit + result.data := []; } + setLength(result.data, startSize); +{@ignore} + fillChar(result.data[0], length(result.data)*sizeof(result.data[0]), 0); +{@emit} + i := 0; + while i < high(keyValuePairs) do begin + put(result, keyValuePairs[i], keyValuePairs[i+1]); + inc(i, 2); + end +end; + +function myhash(t: PStringTable; const key: string): THash; +begin + case t.mode of + modeCaseSensitive: result := hashes.GetHashStr(key); + modeCaseInsensitive: result := hashes.GetHashStrCI(key); + modeStyleInsensitive: result := hashes.getNormalizedHash(key); + end +end; + +function myCmp(t: PStringTable; const a, b: string): bool; +begin + case t.mode of + modeCaseSensitive: result := cmp(a, b) = 0; + modeCaseInsensitive: result := cmpIgnoreCase(a, b) = 0; + modeStyleInsensitive: result := cmpIgnoreStyle(a, b) = 0; + end +end; + +function mustRehash(len, counter: int): bool; +begin + assert(len > counter); + result := (len * 2 < counter * 3) or (len-counter < 4); +end; + +function len(t: PStringTable): int; +begin + result := t.counter +end; + +{@ignore} +const + EmptySeq = nil; +{@emit +const + EmptySeq = []; +} + +function nextTry(h, maxHash: THash): THash; +begin + result := ((5*h) + 1) and maxHash; + // For any initial h in range(maxHash), repeating that maxHash times + // generates each int in range(maxHash) exactly once (see any text on + // random-number generation for proof). +end; + +function RawGet(t: PStringTable; const key: string): int; +var + h: THash; +begin + h := myhash(t, key) and high(t.data); // start with real hash value + while not isNil(t.data[h].key) do begin + if mycmp(t, t.data[h].key, key) then begin + result := h; exit + end; + h := nextTry(h, high(t.data)) + end; + result := -1 +end; + +function get(t: PStringTable; const key: string): string; +var + index: int; +begin + index := RawGet(t, key); + if index >= 0 then result := t.data[index].val + else result := '' +end; + +function hasKey(t: PStringTable; const key: string): bool; +begin + result := rawGet(t, key) >= 0 +end; + +procedure RawInsert(t: PStringTable; + var data: TKeyValuePairSeq; + const key, val: string); +var + h: THash; +begin + h := myhash(t, key) and high(data); + while not isNil(data[h].key) do begin + h := nextTry(h, high(data)) + end; + data[h].key := key; + data[h].val := val; +end; + +procedure Enlarge(t: PStringTable); +var + n: TKeyValuePairSeq; + i: int; +begin + n := emptySeq; + setLength(n, length(t.data) * growthFactor); +{@ignore} + fillChar(n[0], length(n)*sizeof(n[0]), 0); +{@emit} + for i := 0 to high(t.data) do + if not isNil(t.data[i].key) then + RawInsert(t, n, t.data[i].key, t.data[i].val); +{@ignore} + t.data := n; +{@emit + swap(t.data, n); +} +end; + +procedure Put(t: PStringTable; const key, val: string); +var + index: int; +begin + index := RawGet(t, key); + if index >= 0 then + t.data[index].val := val + else begin + if mustRehash(length(t.data), t.counter) then Enlarge(t); + RawInsert(t, t.data, key, val); + inc(t.counter) + end; +end; + +{@ignore} +type + EInvalidValue = int; // dummy for the Pascal compiler +{@emit} + +procedure RaiseFormatException(const s: string); +var + e: ^EInvalidValue; +begin +{@ignore} + raise EInvalidFormatStr.create(s); +{@emit + new(e);} +{@emit + e.msg := 'format string: key not found: ' + s;} +{@emit + raise e;} +end; + +function getValue(t: PStringTable; flags: TFormatFlags; + const key: string): string; +begin + if hasKey(t, key) then begin + result := get(t, key); exit + end; + if useEnvironment in flags then + result := nos.getEnv(key) + else + result := ''; + if (result = '') then begin + if useKey in flags then result := '$' + key + else if not (useEmpty in flags) then + raiseFormatException(key) + end +end; + +function format(const f: string; t: PStringTable; + flags: TFormatFlags = {@set}[]): string; +const + PatternChars = ['a'..'z', 'A'..'Z', '0'..'9', '_', #128..#255]; +var + i, j: int; + key: string; +begin + result := ''; + i := strStart; + while i <= length(f)+strStart-1 do + if f[i] = '$' then begin + case f[i+1] of + '$': begin + addChar(result, '$'); + inc(i, 2); + end; + '{': begin + j := i+1; + while (j <= length(f)+strStart-1) and (f[j] <> '}') do inc(j); + key := ncopy(f, i+2+strStart-1, j-1+strStart-1); + result := result +{&} getValue(t, flags, key); + i := j+1 + end; + 'a'..'z', 'A'..'Z', #128..#255, '_': begin + j := i+1; + while (j <= length(f)+strStart-1) and (f[j] in PatternChars) do inc(j); + key := ncopy(f, i+1+strStart-1, j-1+strStart-1); + result := result +{&} getValue(t, flags, key); + i := j + end + else begin + addChar(result, f[i]); + inc(i) + end + end + end + else begin + addChar(result, f[i]); + inc(i) + end +end; + +end. diff --git a/nim/strutils.pas b/nim/strutils.pas index b654b7868..d70fdd8c3 100644 --- a/nim/strutils.pas +++ b/nim/strutils.pas @@ -56,6 +56,7 @@ function toUpper(c: Char): Char; overload; function toUpper(s: string): string; overload; function parseInt(const s: string): int; +function parseBiggestInt(const s: string): BiggestInt; function ParseFloat(const s: string; checkEnd: Boolean = True): Real; function repeatChar(count: int; c: Char = ' '): string; @@ -74,8 +75,18 @@ const function strip(const s: string; const chars: TCharSet = WhiteSpace): string; function allCharsInSet(const s: string; const theSet: TCharSet): bool; +function quoteIfSpaceExists(const s: string): string; + implementation +function quoteIfSpaceExists(const s: string): string; +begin + if (findSubStr(' ', s) >= strStart) and (s[strStart] <> '"') then + result := '"' +{&} s +{&} '"' + else + result := s +end; + function allCharsInSet(const s: string; const theSet: TCharSet): bool; var i: int; @@ -511,7 +522,7 @@ begin while (j <= length(f)) and (f[j] in PatternChars) do inc(j); x := find(ncopy(f, i+1, j-1), args); if (x >= 0) and (x < high(args)) then result := result + args[x+1] - else raise EInvalidFormatStr.create(''); + else raise EInvalidFormatStr.create(ncopy(f, i+1, j-1)); i := j end else raise EInvalidFormatStr.create(''); @@ -584,6 +595,16 @@ begin result := int(res) // convert to smaller int type end; +function parseBiggestInt(const s: string): BiggestInt; +var + index: int; + res: BiggestInt; +begin + index := strStart; + result := rawParseInt(s, index); + if index = -1 then raise EInvalidValue.create('') +end; + {@ignore} {$ifopt Q+} {$Q-} {$else} {$define Q_on} diff --git a/nim/transf.pas b/nim/transf.pas index 33ece8116..97ad31540 100644 --- a/nim/transf.pas +++ b/nim/transf.pas @@ -12,9 +12,6 @@ // // * inlines iterators // * looks up constants -// * transforms lambdas and makes closures explicit -// * transforms `&`(a, `&` (b, c)) to `&`(a, b, c) -// * generates type information // ------------ helpers ----------------------------------------------------- @@ -27,7 +24,7 @@ begin result := newSym(skTemp, getIdent(genPrefix +{&} ToString(gTmpId)), c.transCon.owner); result.info := info; - result.typ := typ; + result.typ := skipGeneric(typ); end; // -------------------------------------------------------------------------- @@ -96,7 +93,7 @@ function transformSym(c: PContext; n: PNode): PNode; var tc: PTransCon; begin - assert(n.kind = nkSym); + if (n.kind <> nkSym) then internalError(n.info, 'transformSym'); tc := c.transCon; //writeln('transformSym', n.sym.id : 5); while tc <> nil do begin @@ -106,15 +103,19 @@ begin //writeIdNodeTable(tc.mapping); tc := tc.next end; - if (n.sym.kind = skConst) and not (n.sym.typ.kind in ConstantDataTypes) then begin - result := getConstExpr(c, n); - assert(result <> nil); + result := n; + case n.sym.kind of + skConst, skEnumField: begin // BUGFIX: skEnumField was missing + if not (skipGeneric(n.sym.typ).kind in ConstantDataTypes) then begin + result := getConstExpr(c, n); + if result = nil then InternalError(n.info, 'transformSym: const'); + end + end + else begin end end - else - result := n; end; -procedure transformContinueAux(c: PContext; n: PNode; labl: PSym; +procedure transformContinueAux(c: PContext; n: PNode; labl: PSym; var counter: int); var i: int; @@ -128,7 +129,7 @@ begin inc(counter); end; else begin - for i := 0 to sonsLen(n)-1 do + for i := 0 to sonsLen(n)-1 do transformContinueAux(c, n.sons[i], labl, counter); end end @@ -136,7 +137,7 @@ end; function transformContinue(c: PContext; n: PNode): PNode; // we transform the continue statement into a block statement -var +var i, counter: int; x: PNode; labl: PSym; @@ -151,13 +152,24 @@ begin labl.info := result.info; transformContinueAux(c, result, labl, counter); if counter > 0 then begin - x := newNodeI(nkBlockStmt, result.info); + x := newNodeI(nkBlockStmt, result.info); addSon(x, newSymNode(labl)); addSon(x, result); result := x end end; +function skipConv(n: PNode): PNode; +begin + case n.kind of + nkObjUpConv, nkObjDownConv, nkPassAsOpenArray, nkChckRange, + nkChckRangeF, nkChckRange64: + result := n.sons[0]; + nkHiddenStdConv, nkHiddenSubConv, nkConv: result := n.sons[1]; + else result := n + end +end; + function transformYield(c: PContext; n: PNode): PNode; var e: PNode; @@ -165,7 +177,8 @@ var begin result := newNodeI(nkStmtList, n.info); e := n.sons[0]; - if e.typ.kind = tyTuple then begin + if skipGeneric(e.typ).kind = tyTuple then begin + e := skipConv(e); if e.kind = nkPar then begin for i := 0 to sonsLen(e)-1 do begin addSon(result, newAsgnStmt(c, c.transCon.forStmt.sons[i], @@ -202,16 +215,15 @@ begin result := copyTree(n); for i := 0 to sonsLen(result)-1 do begin it := result.sons[i]; - assert(it.kind = nkIdentDefs); - assert(it.sons[0].kind = nkSym); - if it.sons[0].sym.kind <> skTemp then begin - newVar := copySym(it.sons[0].sym, getCurrOwner(c)); - IdNodeTablePut(c.transCon.mapping, it.sons[0].sym, - newSymNode(newVar)); - it.sons[0] := newSymNode(newVar); - end; + if it.kind = nkCommentStmt then continue; + if (it.kind <> nkIdentDefs) or (it.sons[0].kind <> nkSym) then + InternalError(it.info, 'inlineIter'); + newVar := copySym(it.sons[0].sym); + newVar.owner := getCurrOwner(c); + IdNodeTablePut(c.transCon.mapping, it.sons[0].sym, + newSymNode(newVar)); + it.sons[0] := newSymNode(newVar); it.sons[2] := transform(c, it.sons[2]); - //writeIdNodeTable(c.transCon.mapping); end end else begin @@ -233,6 +245,131 @@ begin addSon(father, vpart); end; +function transformAddrDeref(c: PContext; n: PNode; a, b: TNodeKind): PNode; +var + m: PNode; +begin + case n.sons[0].kind of + nkObjUpConv, nkObjDownConv, nkPassAsOpenArray, nkChckRange, + nkChckRangeF, nkChckRange64: begin + m := n.sons[0].sons[0]; + if (m.kind = a) or (m.kind = b) then begin + // addr ( nkPassAsOpenArray ( deref ( x ) ) ) --> nkPassAsOpenArray(x) + n.sons[0].sons[0] := m.sons[0]; + result := transform(c, n.sons[0]); + exit + end + end; + nkHiddenStdConv, nkHiddenSubConv, nkConv: begin + m := n.sons[0].sons[1]; + if (m.kind = a) or (m.kind = b) then begin + // addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) + n.sons[0].sons[1] := m.sons[0]; + result := transform(c, n.sons[0]); + exit + end + end; + else begin + if (n.sons[0].kind = a) or (n.sons[0].kind = b) then begin + // addr ( deref ( x )) --> x + result := transform(c, n.sons[0].sons[0]); + exit + end + end + end; + n.sons[0] := transform(c, n.sons[0]); + result := n; +end; + +function transformConv(c: PContext; n: PNode): PNode; +var + source, dest: PType; + diff: int; +begin + n.sons[1] := transform(c, n.sons[1]); + result := n; + // numeric types need range checks: + dest := skipVarGenericRange(n.typ); + source := skipVarGenericRange(n.sons[1].typ); + case dest.kind of + tyInt..tyInt64, tyEnum, tyChar, tyBool: begin + if (firstOrd(dest) <= firstOrd(source)) and + (lastOrd(source) <= lastOrd(dest)) then begin + // BUGFIX: simply leave n as it is; we need a nkConv node, + // but no range check: + result := n; + end + else begin // generate a range check: + if (dest.kind = tyInt64) or (source.kind = tyInt64) then + result := newNodeIT(nkChckRange64, n.info, n.typ) + else + result := newNodeIT(nkChckRange, n.info, n.typ); + dest := skipVarGeneric(n.typ); + addSon(result, n.sons[1]); + addSon(result, newIntTypeNode(nkIntLit, firstOrd(dest), source)); + addSon(result, newIntTypeNode(nkIntLit, lastOrd(dest), source)); + end + end; + tyFloat..tyFloat128: begin + if skipVarGeneric(n.typ).kind = tyRange then begin + result := newNodeIT(nkChckRangeF, n.info, n.typ); + dest := skipVarGeneric(n.typ); + addSon(result, n.sons[1]); + addSon(result, copyTree(dest.n.sons[0])); + addSon(result, copyTree(dest.n.sons[1])); + end + end; + tyOpenArray: begin + result := newNodeIT(nkPassAsOpenArray, n.info, n.typ); + addSon(result, n.sons[1]); + end; + tyCString: begin + if source.kind = tyString then begin + result := newNodeIT(nkStringToCString, n.info, n.typ); + addSon(result, n.sons[1]); + end; + end; + tyString: begin + if source.kind = tyCString then begin + result := newNodeIT(nkCStringToString, n.info, n.typ); + addSon(result, n.sons[1]); + end; + end; + tyRef, tyPtr: begin + dest := skipPtrsGeneric(dest); + source := skipPtrsGeneric(source); + if source.kind = tyObject then begin + diff := inheritanceDiff(dest, source); + if diff < 0 then begin + result := newNodeIT(nkObjUpConv, n.info, n.typ); + addSon(result, n.sons[1]); + end + else if diff > 0 then begin + result := newNodeIT(nkObjDownConv, n.info, n.typ); + addSon(result, n.sons[1]); + end + else result := n.sons[1]; + end + end; + // conversions between different object types: + tyObject: begin + diff := inheritanceDiff(dest, source); + if diff < 0 then begin + result := newNodeIT(nkObjUpConv, n.info, n.typ); + addSon(result, n.sons[1]); + end + else if diff > 0 then begin + result := newNodeIT(nkObjDownConv, n.info, n.typ); + addSon(result, n.sons[1]); + end + else result := n.sons[1]; + end; + tyGenericParam, tyAnyEnum: result := n.sons[1]; + // happens sometimes for generated assignments, etc. + else begin end + end; +end; + function transformFor(c: PContext; n: PNode): PNode; // generate access statements for the parameters (unless they are constant) // put mapping from formal parameters to actual parameters @@ -247,8 +384,7 @@ begin len := sonsLen(n); n.sons[len-1] := transformContinue(c, n.sons[len-1]); v := newNodeI(nkVarSection, n.info); - for i := 0 to len-3 do - addVar(v, copyTree(n.sons[i])); // declare new variables + for i := 0 to len-3 do addVar(v, copyTree(n.sons[i])); // declare new vars addSon(result, v); newC := newTransCon(); call := n.sons[len-2]; @@ -261,10 +397,10 @@ begin pushTransCon(c, newC); for i := 1 to sonsLen(call)-1 do begin e := getConstExpr(c, call.sons[i]); - formal := newC.owner.typ.n.sons[i].sym; + formal := skipGeneric(newC.owner.typ).n.sons[i].sym; if e <> nil then IdNodeTablePut(newC.mapping, formal, e) - else if (call.sons[i].kind = nkSym) then begin + else if (skipConv(call.sons[i]).kind = nkSym) then begin // since parameters cannot be modified, we can identify the formal and // the actual params IdNodeTablePut(newC.mapping, formal, call.sons[i]); @@ -278,14 +414,14 @@ begin end end; body := newC.owner.ast.sons[codePos]; - //writeln(renderTree(body, {@set}[renderIds])); addSon(result, inlineIter(c, body)); popTransCon(c); end; function getMagicOp(call: PNode): TMagic; begin - if (call.sons[0].kind = nkSym) and (call.sons[0].sym.kind = skProc) then + if (call.sons[0].kind = nkSym) + and (call.sons[0].sym.kind in [skProc, skConverter]) then result := call.sons[0].sym.magic else result := mNone @@ -422,7 +558,7 @@ begin closure := newNodeI(nkRecList, n.sons[codePos].info); gatherVars(c, n.sons[codePos], marked, s, closure); // add closure type to the param list (even if closure is empty!): - cl := newType(tyRecord, s); + cl := newType(tyObject, s); cl.n := closure; addSon(cl, nil); // no super class p := newType(tyRef, s); @@ -464,19 +600,18 @@ begin n.sons[i+1] := ifs; end; result := n; - for j := 0 to sonsLen(n)-1 do - result.sons[j] := transform(c, n.sons[j]); + for j := 0 to sonsLen(n)-1 do result.sons[j] := transform(c, n.sons[j]); end; function transformArrayAccess(c: PContext; n: PNode): PNode; var - j: int; + i: int; begin result := copyTree(n); - if result.sons[1].kind in [nkHiddenSubConv, nkHiddenStdConv] then - result.sons[1] := result.sons[1].sons[0]; - for j := 0 to sonsLen(result)-1 do - result.sons[j] := transform(c, result.sons[j]); + result.sons[0] := skipConv(result.sons[0]); + result.sons[1] := skipConv(result.sons[1]); + for i := 0 to sonsLen(result)-1 do + result.sons[i] := transform(c, result.sons[i]); end; function transform(c: PContext; n: PNode): PNode; @@ -510,6 +645,12 @@ begin n.sons[0] := transform(c, n.sons[0]); n.sons[1] := transformContinue(c, n.sons[1]); end; + nkAddr, nkHiddenAddr: + result := transformAddrDeref(c, n, nkDerefExpr, nkHiddenDeref); + nkDerefExpr, nkHiddenDeref: + result := transformAddrDeref(c, n, nkAddr, nkHiddenAddr); + nkHiddenStdConv, nkHiddenSubConv, nkConv: + result := transformConv(c, n); nkCommentStmt, nkTemplateDef, nkMacroDef: exit; nkConstSection: exit; // do not replace ``const c = 3`` with ``const 3 = 3`` else begin diff --git a/nim/transtmp.pas b/nim/transtmp.pas index df61aa00d..cfec21c98 100644 --- a/nim/transtmp.pas +++ b/nim/transtmp.pas @@ -9,7 +9,8 @@ // This module implements a transformator. It transforms the syntax tree // to ease the work of the code generators. Does the transformation to -// introduce temporaries to split up complex expressions. +// introduce temporaries to split up complex expressions. +// THIS MODULE IS NOT USED! procedure transInto(c: PContext; var dest: PNode; father, src: PNode); forward; // transforms the expression `src` into the destination `dest`. Uses `father` diff --git a/nim/trees.pas b/nim/trees.pas index bd4137083..a50b8f6cb 100644 --- a/nim/trees.pas +++ b/nim/trees.pas @@ -21,7 +21,7 @@ function getMagic(op: PNode): TMagic; // function getConstExpr(const t: TNode; out res: TNode): Boolean; -function isConstExpr(node: PNode): Boolean; +function isConstExpr(n: PNode): Boolean; function flattenTree(root: PNode; op: TMagic): PNode; @@ -36,9 +36,44 @@ function getProcSym(call: PNode): PSym; function ExprStructuralEquivalent(a, b: PNode): Boolean; function sameTree(a, b: PNode): boolean; +function cyclicTree(n: PNode): boolean; implementation +function hasSon(father, son: PNode): boolean; +var + i: int; +begin + for i := 0 to sonsLen(father)-1 do + if father.sons[i] = son then begin result := true; exit end; + result := false +end; + +function cyclicTreeAux(n, s: PNode): boolean; +var + i, m: int; +begin + if n = nil then begin result := false; exit end; + if hasSon(s, n) then begin result := true; exit end; + m := sonsLen(s); + addSon(s, n); + if not (n.kind in [nkEmpty..nkNilLit]) then + for i := 0 to sonsLen(n)-1 do + if cyclicTreeAux(n.sons[i], s) then begin + result := true; exit + end; + result := false; + delSon(s, m); +end; + +function cyclicTree(n: PNode): boolean; +var + s: PNode; +begin + s := newNode(nkEmpty); + result := cyclicTreeAux(n, s); +end; + function ExprStructuralEquivalent(a, b: PNode): Boolean; var i: int; @@ -77,7 +112,7 @@ begin result := true end else if (a <> nil) and (b <> nil) and (a.kind = b.kind) then begin - if a.base <> b.base then exit; + if a.flags <> b.flags then exit; if a.info.line <> int(b.info.line) then exit; if a.info.col <> int(b.info.col) then exit; //if a.info.fileIndex <> b.info.fileIndex then exit; @@ -109,7 +144,7 @@ end; function getOpSym(op: PNode): PSym; begin - if not (op.kind in [nkCall, nkGenericCall]) then + if not (op.kind in [nkCall, nkGenericCall, nkHiddenCallConv]) then result := nil else begin assert(sonsLen(op) > 0); @@ -123,7 +158,7 @@ end; function getMagic(op: PNode): TMagic; begin case op.kind of - nkCall: begin + nkCall, nkHiddenCallConv: begin case op.sons[0].Kind of nkSym, nkQualified: begin assert(op.sons[0].sym <> nil); // BUGFIX @@ -145,12 +180,10 @@ begin result := t.sym end; -function isConstExpr(node: PNode): Boolean; +function isConstExpr(n: PNode): Boolean; begin - result := (node.kind in [nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, - nkConstSetConstr, - nkConstArrayConstr, nkConstRecordConstr]) + result := (n.kind in [nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, + nkFloatLit..nkFloat64Lit]) or (nfAllConst in n.flags) end; procedure flattenTreeAux(d, a: PNode; op: TMagic); diff --git a/nim/types.pas b/nim/types.pas index 5719d181a..c63913baa 100644 --- a/nim/types.pas +++ b/nim/types.pas @@ -48,7 +48,7 @@ function mutateType(t: PType; iter: TTypeMutator; closure: PObject): PType; -function SameType(a, b: PType): Boolean; +function SameType(x, y: PType): Boolean; function SameTypeOrNil(a, b: PType): Boolean; type @@ -67,16 +67,15 @@ function isOrdinalType(t: PType): Boolean; function enumHasWholes(t: PType): Boolean; function skipRange(t: PType): PType; -function skipAbstract(t: PType): PType; function skipGeneric(t: PType): PType; +function skipGenericRange(t: PType): PType; function skipVar(t: PType): PType; function skipVarGeneric(t: PType): PType; function skipVarGenericRange(t: PType): PType; +function skipPtrsGeneric(t: PType): PType; function elemType(t: PType): PType; -function inheritAssignable(toCopy: PType; isAssignable: bool): PType; - function containsObject(t: PType): bool; function containsGarbageCollectedRef(typ: PType): Boolean; function containsHiddenPointer(typ: PType): Boolean; @@ -89,8 +88,57 @@ function getOrdValue(n: PNode): biggestInt; function computeSize(typ: PType): biggestInt; function getSize(typ: PType): biggestInt; +function isPureObject(typ: PType): boolean; + +function inheritanceDiff(a, b: PType): int; +// | returns: 0 iff `a` == `b` +// | returns: -x iff `a` is the x'th direct superclass of `b` +// | returns: +x iff `a` is the x'th direct subclass of `b` +// | returns: `maxint` iff `a` and `b` are not compatible at all + + +function InvalidGenericInst(f: PType): bool; +// for debugging + implementation +function InvalidGenericInst(f: PType): bool; +begin + result := (f.kind = tyGenericInst) and (lastSon(f) = nil); +end; + +function inheritanceDiff(a, b: PType): int; +var + x, y: PType; +begin + // conversion to superclass? + x := a; + result := 0; + while (x <> nil) do begin + if x.id = b.id then exit; + x := x.sons[0]; + dec(result); + end; + // conversion to baseclass? + y := b; + result := 0; + while (y <> nil) do begin + if y.id = a.id then exit; + y := y.sons[0]; + inc(result); + end; + result := high(int); +end; + +function isPureObject(typ: PType): boolean; +var + t: PType; +begin + t := typ; + while t.sons[0] <> nil do t := t.sons[0]; + result := (t.sym <> nil) and (sfPure in t.sym.flags); +end; + function getOrdValue(n: PNode): biggestInt; begin case n.kind of @@ -131,24 +179,11 @@ begin result := result +{&} ': ' +{&} typeToString(n.sons[0].typ); end; -function inheritAssignable(toCopy: PType; isAssignable: bool): PType; -begin - if isAssignable then begin - if tfAssignable in toCopy.flags then result := toCopy - else begin - result := copyType(toCopy, toCopy.owner); // same ID! - include(result.flags, tfAssignable); - end - end - else - result := toCopy // no need to copy -end; - function elemType(t: PType): PType; begin assert(t <> nil); case t.kind of - tyGenericInst: result := lastSon(t); + tyGenericInst: result := elemType(lastSon(t)); tyArray, tyArrayConstr: result := t.sons[1]; else result := t.sons[0]; end; @@ -186,6 +221,13 @@ begin while result.kind in [tyGenericInst, tyVar] do result := lastSon(result); end; +function skipPtrsGeneric(t: PType): PType; +begin + result := t; + while result.kind in [tyGenericInst, tyVar, tyPtr, tyRef] do + result := lastSon(result); +end; + function skipVarGenericRange(t: PType): PType; begin result := t; @@ -193,6 +235,13 @@ begin result := lastSon(result); end; +function skipGenericRange(t: PType): PType; +begin + result := t; + while result.kind in [tyGenericInst, tyVar, tyRange] do + result := lastSon(result); +end; + function isOrdinalType(t: PType): Boolean; begin assert(t <> nil); @@ -309,13 +358,13 @@ begin result := Predicate(t); if result then exit; case t.kind of - tyObject, tyRecord: begin + tyObject: begin result := searchTypeForAux(t.sons[0], predicate, marker); if not result then result := searchTypeNodeForAux(t.n, predicate, marker); end; tyGenericInst: result := searchTypeForAux(lastSon(t), predicate, marker); - tyArray, tyArrayConstr, tyTuple, tySet: begin + tyArray, tyArrayConstr, tySet, tyTuple: begin for i := 0 to sonsLen(t)-1 do begin result := searchTypeForAux(t.sons[i], predicate, marker); if result then exit @@ -400,11 +449,14 @@ begin result := iter(t, closure); if not IntSetContainsOrIncl(marker, t.id) then begin for i := 0 to sonsLen(t)-1 do begin - result.sons[i] := mutateTypeAux(marker, t.sons[i], iter, closure); + result.sons[i] := mutateTypeAux(marker, result.sons[i], iter, closure); + if (result.sons[i] = nil) and (result.kind = tyGenericInst) then + assert(false); end; if t.n <> nil then result.n := mutateNode(marker, t.n, iter, closure) - end + end; + assert(result <> nil); end; function mutateType(t: PType; iter: TTypeMutator; closure: PObject): PType; @@ -425,9 +477,9 @@ function TypeToString(typ: PType; prefer: TPreferedDesc = preferName): string; const typeToStr: array [TTypeKind] of string = ( 'None', 'bool', 'Char', '{}', 'Array Constructor [$1]', 'nil', - 'Record Constructor [$1]', 'Generic', 'GenericInst', 'GenericParam', + 'Generic', 'GenericInst', 'GenericParam', 'enum', 'anyenum', - 'array[$1, $2]', 'record', 'object', 'tuple', 'set[$1]', 'range[$1]', + 'array[$1, $2]', 'object', 'tuple', 'set[$1]', 'range[$1]', 'ptr ', 'ref ', 'var ', 'seq[$1]', 'proc', 'pointer', 'OpenArray[$1]', 'string', 'CString', 'Forward', 'int', 'int8', 'int16', 'int32', 'int64', @@ -462,21 +514,22 @@ begin tySet: result := 'set[' +{&} typeToString(t.sons[0]) +{&} ']'; tyOpenArray: result := 'openarray[' +{&} typeToString(t.sons[0]) +{&} ']'; tyTuple: begin - assert(t.n = nil); + // we iterate over t.sons here, because t.n may be nil result := 'tuple['; - for i := 0 to sonsLen(t)-1 do begin - result := result +{&} typeToString(t.sons[i]); - if i < sonsLen(t)-1 then result := result +{&} ', '; - end; - addChar(result, ']') - end; - tyRecordConstr: begin - assert(t.n <> nil); - result := 'record['; - for i := 0 to sonsLen(t.n)-1 do begin - result := result +{&} t.n.sons[i].sym.name.s +{&} ': ' - +{&} typeToString(t.n.sons[i].sym.typ); - if i < sonsLen(t.n)-1 then result := result +{&} ', '; + if t.n <> nil then begin + assert(sonsLen(t.n) = sonsLen(t)); + for i := 0 to sonsLen(t.n)-1 do begin + assert(t.n.sons[i].kind = nkSym); + result := result +{&} t.n.sons[i].sym.name.s +{&} ': ' + +{&} typeToString(t.sons[i]); + if i < sonsLen(t.n)-1 then result := result +{&} ', '; + end + end + else begin + for i := 0 to sonsLen(t)-1 do begin + result := result +{&} typeToString(t.sons[i]); + if i < sonsLen(t)-1 then result := result +{&} ', '; + end end; addChar(result, ']') end; @@ -545,6 +598,7 @@ begin result := t.n.sons[0].sym.position; end; end; + tyGenericInst: result := firstOrd(lastSon(t)); else begin InternalError('invalid kind for first(' +{&} typeKindToStr[t.kind] +{&} ')'); @@ -580,6 +634,7 @@ begin assert(t.n.sons[sonsLen(t.n)-1].kind = nkSym); result := t.n.sons[sonsLen(t.n)-1].sym.position; end; + tyGenericInst: result := firstOrd(lastSon(t)); else begin InternalError('invalid kind for last(' +{&} typeKindToStr[t.kind] +{&} ')'); @@ -680,46 +735,67 @@ begin SameLiteral(a.sons[1], b.sons[1]) end; -function sameRecordConstr(a, b: PType): Boolean; +function sameTuple(a, b: PType): boolean; +// two tuples are equivalent iff the names, types and positions are the same; +// however, both types may not have any field names (t.n may be nil) which +// complicates the matter a bit. var i: int; x, y: PSym; begin - if sonsLen(a.n) <> sonsLen(b.n) then begin - result := false; exit - end; - for i := 0 to sonsLen(a.n)-1 do begin - x := a.n.sons[i].sym; - y := getSymFromList(b.n, x.name); - if (y = nil) or not SameType(x.typ, y.typ) then begin - result := false; exit + if sonsLen(a) = sonsLen(b) then begin + result := true; + for i := 0 to sonsLen(a)-1 do begin + result := SameType(a.sons[i], b.sons[i]); + if not result then exit + end; + if (a.n <> nil) and (b.n <> nil) then begin + for i := 0 to sonsLen(a.n)-1 do begin + // check field names: + if a.n.sons[i].kind <> nkSym then InternalError(a.n.info, 'sameTuple'); + if b.n.sons[i].kind <> nkSym then InternalError(b.n.info, 'sameTuple'); + x := a.n.sons[i].sym; + y := b.n.sons[i].sym; + result := x.name.id = y.name.id; + if not result then break + end end - end; - result := true + end + else + result := false; end; -function SameType(a, b: PType): Boolean; +function SameType(x, y: PType): Boolean; var i: int; + a, b: PType; begin + a := skipGeneric(x); + b := skipGeneric(y); assert(a <> nil); assert(b <> nil); if a.kind <> b.kind then begin result := false; exit end; case a.Kind of - tyRecord, tyEnum, tyForward, tyObject: + tyEnum, tyForward, tyObject: result := (a.id = b.id); - tyGenericParam, tyGeneric, tyGenericInst, tySequence, + tyTuple: + result := sameTuple(a, b); + tyGenericInst: + result := sameType(lastSon(a), lastSon(b)); + tyGenericParam, tyGeneric, tySequence, tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyArrayConstr, - tyArray, tyTuple, tyProc: begin + tyArray, tyProc: begin if sonsLen(a) = sonsLen(b) then begin result := true; for i := 0 to sonsLen(a)-1 do begin result := SameTypeOrNil(a.sons[i], b.sons[i]); // BUGFIX if not result then exit - end + end; + if result and (a.kind = tyProc) then + result := a.callConv = b.callConv // BUGFIX end else - result := false + result := false; end; tyRange: begin result := SameTypeOrNil(a.sons[0], b.sons[0]) @@ -728,7 +804,6 @@ begin end; tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, tyInt..tyFloat128: result := true; - tyRecordConstr: result := sameRecordConstr(a, b); // BUGFIX else begin InternalError('sameType(' +{&} typeKindToStr[a.kind] +{&} ', ' +{&} typeKindToStr[b.kind] +{&} ')'); @@ -833,10 +908,10 @@ begin if firstOrd(typ) < 0 then result := 4 // use signed int32 else begin - len := lengthOrd(typ); - if len < 2 shl 8 then result := 1 - else if len < 2 shl 16 then result := 2 - else if len < 2 shl 32 then result := 4 + len := lastOrd(typ); // BUGFIX: use lastOrd! + if len+1 < 1 shl 8 then result := 1 + else if len+1 < 1 shl 16 then result := 2 + else if len+1 < 1 shl 32 then result := 4 else result := 8; end; a := result; @@ -863,7 +938,7 @@ begin result := align(result, maxAlign); a := maxAlign; end; - tyRecord, tyObject: begin + tyObject: begin if typ.sons[0] <> nil then begin result := computeSizeAux(typ.sons[0], a); maxAlign := a @@ -879,7 +954,7 @@ begin if a < maxAlign then a := maxAlign; result := align(result, a); end; - tyGeneric: begin + tyGenericInst: begin result := computeSizeAux(lastSon(typ), a); end; else begin diff --git a/nim/vis.pas b/nim/vis.pas deleted file mode 100644 index 7f59abaec..000000000 --- a/nim/vis.pas +++ /dev/null @@ -1,33 +0,0 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// - -// Virtual instruction set for Nimrod. Has been designed to support: -// * efficient C code generation (most important goal) -// * efficient LLVM code generation (second goal) -// * interpretation -// So it supports a typed virtual instruction set. - -type - TInstrKind = ( - insNone, // invalid instruction - insLabel, // a label - insTemp, - insGoto, // a goto - insTjmp, - insFjmp, - insBin, // ordinary binary operator - insLast - - ); - TInstr = record - Kind: TInstrKind; - - end; - - diff --git a/nim/wordrecg.pas b/nim/wordrecg.pas index da709a8f3..2849c1d05 100644 --- a/nim/wordrecg.pas +++ b/nim/wordrecg.pas @@ -47,8 +47,8 @@ type wMacro, wMethod, wMod, wNil, wNot, wNotin, wObject, wOf, wOr, wOut, wProc, wPtr, - wRaise, wRecord, wRef, wReturn, - wShl, wShr, wTemplate, wTry, + wRaise, wRef, wReturn, wShl, + wShr, wTemplate, wTry, wTuple, wType, wVar, wWhen, wWhere, wWhile, wWith, wWithout, wXor, wYield, @@ -57,8 +57,8 @@ type wColon, wEquals, wDot, wDotDot, wHat, wStar, wMinus, // pragmas and command line options: - wMagic, wPrefix, wInfix, wPostfix, wAssign, - wIsnegationof, wImportc, wExportc, wAlign, wNodecl, wPure, + wMagic, wTypeCheck, wFinal, wPostfix, + wObjChecks, wImportc, wExportc, wAlign, wNodecl, wPure, wVolatile, wRegister, wNostatic, wHeader, wNosideeffect, wNoreturn, wLib, wDynlib, wReturnsnew, wCompilerproc, wCppmethod, wFatal, wError, wWarning, wHint, wLine, wPush, wPop, @@ -76,12 +76,13 @@ type wL, wListcmd, wGendoc, wGenmapping, wOs, wCpu, wGenerate, wG, wC, wCpp, wYaml, wRun, wR, wVerbose, wV, wHelp, - wH, wCompilesys, wS, wX, wVersion, wAdvanced, wMergeoutput, + wH, wCompilesys, wFieldChecks, wX, wVersion, wAdvanced, wMergeoutput, wSkipcfg, wSkipProjCfg, wCc, wGenscript, wCheckPoint, wCheckPoints, wMaxErr, wExpr, wStmt, wTypeDesc, wAsmQuote, wAstCache, wCFileCache, wIndex, // commands: - wCompileToC, wCompileToCpp, wPretty, wDoc, wPas, + wCompileToC, wCompileToCpp, wCompileToEcmaScript, + wPretty, wDoc, wPas, wGenDepend, wListDef, wCheck, wParse, wScan, wBoot, wDebugTrans, wRst2html, // special for the preprocessor of configuration files: @@ -92,7 +93,7 @@ type wExports, wFinalization, wFunction, wGoto, wImplementation, wInherited, wInitialization, wInterface, wLabel, wLibrary, wPacked, - wProcedure, wProgram, wProperty, wRepeat, wResourcestring, + wProcedure, wProgram, wProperty, wRecord, wRepeat, wResourcestring, wSet, wThen, wThreadvar, wTo, wUnit, wUntil, wUses, // Pascal special tokens: @@ -120,8 +121,8 @@ const 'macro', 'method', 'mod', 'nil', 'not', 'notin', 'object', 'of', 'or', 'out', 'proc', 'ptr', - 'raise', 'record', 'ref', 'return', - 'shl', 'shr', 'template', 'try', + 'raise', 'ref', 'return', 'shl', + 'shr', 'template', 'try', 'tuple', 'type', 'var', 'when', 'where', 'while', 'with', 'without', 'xor', 'yield', @@ -130,8 +131,8 @@ const ':'+'', '='+'', '.'+'', '..', '^'+'', '*'+'', '-'+'', // pragmas and command line options: - 'magic', 'prefix', 'infix', 'postfix', 'assign', - 'isnegationof', 'importc', 'exportc', 'align', 'nodecl', 'pure', + 'magic', 'typecheck', 'final', 'postfix', + 'objchecks', 'importc', 'exportc', 'align', 'nodecl', 'pure', 'volatile', 'register', 'nostatic', 'header', 'nosideeffect', 'noreturn', 'lib', 'dynlib', 'returnsnew', 'compilerproc', 'cppmethod', 'fatal', 'error', 'warning', 'hint', 'line', 'push', 'pop', @@ -149,14 +150,15 @@ const 'l'+'', 'listcmd', 'gendoc', 'genmapping', 'os', 'cpu', 'generate', 'g'+'', 'c'+'', 'cpp', 'yaml', 'run', 'r'+'', 'verbose', 'v'+'', 'help', - 'h'+'', 'compilesys', 's'+'', 'x'+'', 'version', 'advanced', 'mergeoutput', + 'h'+'', 'compilesys', 'fieldchecks', 'x'+'', 'version', 'advanced', + 'mergeoutput', 'skipcfg', 'skipprojcfg', 'cc', 'genscript', 'checkpoint', 'checkpoints', 'maxerr', 'expr', 'stmt', 'typedesc', 'asmquote', 'astcache', 'cfilecache', 'index', // commands: - 'compiletoc', 'compiletocpp', 'pretty', 'doc', 'pas', - 'gendepend', 'listdef', 'check', 'parse', 'scan', 'boot', 'debugtrans', - 'rst2html', + 'compiletoc', 'compiletocpp', 'compiletoecmascript', + 'pretty', 'doc', 'pas', 'gendepend', 'listdef', 'check', 'parse', + 'scan', 'boot', 'debugtrans', 'rst2html', // special for the preprocessor of configuration files: 'write', 'putenv', 'prependenv', 'appendenv', @@ -166,7 +168,7 @@ const 'exports', 'finalization', 'function', 'goto', 'implementation', 'inherited', 'initialization', 'interface', 'label', 'library', 'packed', - 'procedure', 'program', 'property', 'repeat', 'resourcestring', + 'procedure', 'program', 'property', 'record', 'repeat', 'resourcestring', 'set', 'then', 'threadvar', 'to', 'unit', 'until', 'uses', |