diff options
Diffstat (limited to 'nim')
45 files changed, 1391 insertions, 862 deletions
diff --git a/nim/ast.pas b/nim/ast.pas index be967a568..c22385805 100644 --- a/nim/ast.pas +++ b/nim/ast.pas @@ -65,148 +65,148 @@ for key, val in enums.items(): cog.out(a) cog.out(b) ]]]*) -type - TTypeFlag = ( - tfVarargs, tfFinal, tfAcyclic, tfEnumHasWholes); - TTypeFlags = set of TTypeFlag; -const - TypeFlagToStr: array [TTypeFlag] of string = ( - 'tfVarargs', 'tfFinal', 'tfAcyclic', 'tfEnumHasWholes'); -type - TTypeKind = ( - tyNone, tyBool, tyChar, tyEmpty, - 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', 'tyEmpty', - '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 - TSymFlag = ( - sfUsed, sfStar, sfMinus, sfInInterface, - sfFromGeneric, sfGlobal, sfForward, sfImportc, - sfExportc, sfVolatile, sfRegister, sfPure, - sfResult, sfNoSideEffect, sfMainModule, sfSystemModule, - sfNoReturn, sfAddrTaken, sfCompilerProc, sfCppMethod, - sfDiscriminant, sfDeprecated, sfInClosure, sfTypeCheck, - sfCompileTime, sfThreadVar, sfMerge); - TSymFlags = set of TSymFlag; -const - SymFlagToStr: array [TSymFlag] of string = ( - 'sfUsed', 'sfStar', 'sfMinus', 'sfInInterface', - 'sfFromGeneric', 'sfGlobal', 'sfForward', 'sfImportc', - 'sfExportc', 'sfVolatile', 'sfRegister', 'sfPure', - 'sfResult', 'sfNoSideEffect', 'sfMainModule', 'sfSystemModule', - 'sfNoReturn', 'sfAddrTaken', 'sfCompilerProc', 'sfCppMethod', - 'sfDiscriminant', 'sfDeprecated', 'sfInClosure', 'sfTypeCheck', - 'sfCompileTime', 'sfThreadVar', 'sfMerge'); -type - TNodeFlag = ( - nfNone, nfBase2, nfBase8, nfBase16, - nfAllConst, nfTransf, nfSem); - TNodeFlags = set of TNodeFlag; -const - NodeFlagToStr: array [TNodeFlag] of string = ( - 'nfNone', 'nfBase2', 'nfBase8', 'nfBase16', - 'nfAllConst', 'nfTransf', 'nfSem'); -type - TSymKind = ( - skUnknownSym, skConditional, skDynLib, skParam, - skTypeParam, skTemp, skType, skConst, - skVar, skProc, skIterator, skConverter, - skMacro, skTemplate, skField, skEnumField, - skForVar, skModule, skLabel, skStub); - 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', 'skStub'); -type - TNodeKind = ( - nkNone, nkEmpty, nkIdent, nkSym, - 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, 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, nkStmtListType, nkBlockType, 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', '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', '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', 'nkStmtListType', 'nkBlockType', 'nkVm', - 'nkTypeOfExpr', 'nkObjectTy', 'nkTupleTy', 'nkRecList', - 'nkRecCase', 'nkRecWhen', 'nkRefTy', 'nkPtrTy', - 'nkVarTy', 'nkProcTy', 'nkEnumTy', 'nkEnumFieldDef', - 'nkReturnToken'); +type + TNodeKind = ( + nkNone, nkEmpty, nkIdent, nkSym, + nkType, nkCharLit, nkIntLit, nkInt8Lit, + nkInt16Lit, nkInt32Lit, nkInt64Lit, nkFloatLit, + nkFloat32Lit, nkFloat64Lit, nkStrLit, nkRStrLit, + nkTripleStrLit, nkMetaNode, nkNilLit, nkDotCall, + nkCommand, nkCall, nkGenericCall, nkExplicitTypeListCall, + nkExprEqExpr, nkExprColonExpr, nkIdentDefs, nkVarTuple, + nkInfix, nkPrefix, nkPostfix, nkPar, + nkCurly, nkBracket, nkBracketExpr, nkPragmaExpr, + nkRange, nkDotExpr, nkCheckedFieldExpr, nkDerefExpr, + nkIfExpr, nkElifExpr, nkElseExpr, nkLambda, + nkAccQuoted, nkHeaderQuoted, nkTableConstr, nkQualified, + nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv, nkConv, + nkCast, nkAddr, nkHiddenAddr, nkHiddenDeref, + nkObjDownConv, nkObjUpConv, nkChckRangeF, nkChckRange64, + nkChckRange, nkStringToCString, nkCStringToString, nkPassAsOpenArray, + nkAsgn, nkFastAsgn, 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, nkStmtListType, + nkBlockType, 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', 'nkIntLit', 'nkInt8Lit', + 'nkInt16Lit', 'nkInt32Lit', 'nkInt64Lit', 'nkFloatLit', + 'nkFloat32Lit', 'nkFloat64Lit', 'nkStrLit', 'nkRStrLit', + 'nkTripleStrLit', 'nkMetaNode', 'nkNilLit', 'nkDotCall', + 'nkCommand', 'nkCall', 'nkGenericCall', 'nkExplicitTypeListCall', + 'nkExprEqExpr', 'nkExprColonExpr', 'nkIdentDefs', 'nkVarTuple', + 'nkInfix', 'nkPrefix', 'nkPostfix', 'nkPar', + 'nkCurly', 'nkBracket', 'nkBracketExpr', 'nkPragmaExpr', + 'nkRange', 'nkDotExpr', 'nkCheckedFieldExpr', 'nkDerefExpr', + 'nkIfExpr', 'nkElifExpr', 'nkElseExpr', 'nkLambda', + 'nkAccQuoted', 'nkHeaderQuoted', 'nkTableConstr', 'nkQualified', + 'nkHiddenStdConv', 'nkHiddenSubConv', 'nkHiddenCallConv', 'nkConv', + 'nkCast', 'nkAddr', 'nkHiddenAddr', 'nkHiddenDeref', + 'nkObjDownConv', 'nkObjUpConv', 'nkChckRangeF', 'nkChckRange64', + 'nkChckRange', 'nkStringToCString', 'nkCStringToString', 'nkPassAsOpenArray', + 'nkAsgn', 'nkFastAsgn', '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', 'nkStmtListType', + 'nkBlockType', 'nkVm', 'nkTypeOfExpr', 'nkObjectTy', + 'nkTupleTy', 'nkRecList', 'nkRecCase', 'nkRecWhen', + 'nkRefTy', 'nkPtrTy', 'nkVarTy', 'nkProcTy', + 'nkEnumTy', 'nkEnumFieldDef', 'nkReturnToken'); +type + TSymFlag = ( + sfUsed, sfStar, sfMinus, sfInInterface, + sfFromGeneric, sfGlobal, sfForward, sfImportc, + sfExportc, sfVolatile, sfRegister, sfPure, + sfResult, sfNoSideEffect, sfMainModule, sfSystemModule, + sfNoReturn, sfAddrTaken, sfCompilerProc, sfCppMethod, + sfDiscriminant, sfDeprecated, sfInClosure, sfTypeCheck, + sfCompileTime, sfThreadVar, sfMerge, sfDeadCodeElim); + TSymFlags = set of TSymFlag; +const + SymFlagToStr: array [TSymFlag] of string = ( + 'sfUsed', 'sfStar', 'sfMinus', 'sfInInterface', + 'sfFromGeneric', 'sfGlobal', 'sfForward', 'sfImportc', + 'sfExportc', 'sfVolatile', 'sfRegister', 'sfPure', + 'sfResult', 'sfNoSideEffect', 'sfMainModule', 'sfSystemModule', + 'sfNoReturn', 'sfAddrTaken', 'sfCompilerProc', 'sfCppMethod', + 'sfDiscriminant', 'sfDeprecated', 'sfInClosure', 'sfTypeCheck', + 'sfCompileTime', 'sfThreadVar', 'sfMerge', 'sfDeadCodeElim'); +type + TTypeKind = ( + tyNone, tyBool, tyChar, tyEmpty, + 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', 'tyEmpty', + '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, nfTransf, nfSem); + TNodeFlags = set of TNodeFlag; +const + NodeFlagToStr: array [TNodeFlag] of string = ( + 'nfNone', 'nfBase2', 'nfBase8', 'nfBase16', + 'nfAllConst', 'nfTransf', 'nfSem'); +type + TTypeFlag = ( + tfVarargs, tfFinal, tfAcyclic, tfEnumHasWholes); + TTypeFlags = set of TTypeFlag; +const + TypeFlagToStr: array [TTypeFlag] of string = ( + 'tfVarargs', 'tfFinal', 'tfAcyclic', 'tfEnumHasWholes'); +type + TSymKind = ( + skUnknownSym, skConditional, skDynLib, skParam, + skTypeParam, skTemp, skType, skConst, + skVar, skProc, skIterator, skConverter, + skMacro, skTemplate, skField, skEnumField, + skForVar, skModule, skLabel, skStub); + 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', 'skStub'); {[[[end]]]} type @@ -219,43 +219,44 @@ type // if (i+1) % 6 == 0: cog.outl("") //cog.outl("m" + magics[-1]) //]]] - mNone, mDefined, mLow, mHigh, mSizeOf, mIs, - mSucc, mPred, mInc, mDec, mOrd, mNew, - mNewFinalize, mNewSeq, mRegisterFinalizer, mLengthOpenArray, mLengthStr, mLengthArray, - mLengthSeq, mIncl, mExcl, mCard, mChr, mGCref, - mGCunref, mAddI, mSubI, mMulI, mDivI, mModI, - mAddI64, mSubI64, mMulI64, mDivI64, mModI64, mShrI, - mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, - mMaxI64, mAddF64, mSubF64, mMulF64, mDivF64, mMinF64, - mMaxF64, mAddU, mSubU, mMulU, mDivU, mModU, - mAddU64, mSubU64, mMulU64, mDivU64, mModU64, mEqI, - mLeI, mLtI, mEqI64, mLeI64, mLtI64, mEqF64, - mLeF64, mLtF64, mLeU, mLtU, mLeU64, mLtU64, - mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, - mEqB, mLeB, mLtB, mEqRef, mEqProc, mEqUntracedRef, - mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, mUnaryMinusI64, - mAbsI, mAbsI64, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusI64, - mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, 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, - mAsgn, mRepr, mExit, mSetLengthStr, mSetLengthSeq, mAssert, - mSwap, mIsNil, mArrToSeq, mArray, mOpenArray, mRange, - mSet, mSeq, mInt, mInt8, mInt16, mInt32, - mInt64, mFloat, mFloat32, mFloat64, mBool, mChar, - mString, mCstring, mPointer, mAnyEnum, mEmptySet, mIntSetBaseType, - mNil, mIsMainModule, 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 + mNone, mDefined, mLow, mHigh, mSizeOf, mIs, + mSucc, mPred, mInc, mDec, mOrd, mNew, + mNewFinalize, mNewSeq, mRegisterFinalizer, mLengthOpenArray, mLengthStr, mLengthArray, + mLengthSeq, mIncl, mExcl, mCard, mChr, mGCref, + mGCunref, mAddI, mSubI, mMulI, mDivI, mModI, + mAddI64, mSubI64, mMulI64, mDivI64, mModI64, mShrI, + mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, + mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, + mMaxI64, mAddF64, mSubF64, mMulF64, mDivF64, mMinF64, + mMaxF64, mAddU, mSubU, mMulU, mDivU, mModU, + mAddU64, mSubU64, mMulU64, mDivU64, mModU64, mEqI, + mLeI, mLtI, mEqI64, mLeI64, mLtI64, mEqF64, + mLeF64, mLtF64, mLeU, mLtU, mLeU64, mLtU64, + mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, + mEqB, mLeB, mLtB, mEqRef, mEqProc, mEqUntracedRef, + mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, mUnaryMinusI64, + mAbsI, mAbsI64, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusI64, + mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, mZe8ToI64, + mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, mToU16, + mToU32, mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, mCharToStr, + mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, + mEnumToStr, mAnd, mOr, mEqStr, mLeStr, mLtStr, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, + mSymDiffSet, mConStrStr, mConArrArr, mConArrT, mConTArr, mConTT, + mSlice, mAppendStrCh, mAppendStrStr, mAppendSeqElem, mAppendSeqSeq, mInRange, + mInSet, mAsgn, mRepr, mExit, mSetLengthStr, mSetLengthSeq, + mAssert, mSwap, mIsNil, mArrToSeq, mArray, mOpenArray, + mRange, mSet, mSeq, mInt, mInt8, mInt16, + mInt32, mInt64, mFloat, mFloat32, mFloat64, mBool, + mChar, mString, mCstring, mPointer, mAnyEnum, mEmptySet, + mIntSetBaseType, mNil, mIsMainModule, mCompileDate, mCompileTime, mNimrodVersion, + mNimrodMajor, mNimrodMinor, mNimrodPatch, mCpuEndian, mHostOS, mHostCPU, + 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]]] ); @@ -322,7 +323,6 @@ type locProc, // location is a proc (an address of a procedure) locData, // location is a constant locCall, // location is a call expression - locImmediate, // location is an immediate value locOther // location is something other ); @@ -477,43 +477,44 @@ const // "MagicToStr" array: // if (i+1) % 6 == 0: cog.outl("") //cog.outl("'%s'" % magics[-1]) //]]] - 'None', 'Defined', 'Low', 'High', 'SizeOf', 'Is', - 'Succ', 'Pred', 'Inc', 'Dec', 'Ord', 'New', - 'NewFinalize', 'NewSeq', 'RegisterFinalizer', 'LengthOpenArray', 'LengthStr', 'LengthArray', - 'LengthSeq', 'Incl', 'Excl', 'Card', 'Chr', 'GCref', - 'GCunref', 'AddI', 'SubI', 'MulI', 'DivI', 'ModI', - 'AddI64', 'SubI64', 'MulI64', 'DivI64', 'ModI64', 'ShrI', - 'ShlI', 'BitandI', 'BitorI', 'BitxorI', 'MinI', 'MaxI', - 'ShrI64', 'ShlI64', 'BitandI64', 'BitorI64', 'BitxorI64', 'MinI64', - 'MaxI64', 'AddF64', 'SubF64', 'MulF64', 'DivF64', 'MinF64', - 'MaxF64', 'AddU', 'SubU', 'MulU', 'DivU', 'ModU', - 'AddU64', 'SubU64', 'MulU64', 'DivU64', 'ModU64', 'EqI', - 'LeI', 'LtI', 'EqI64', 'LeI64', 'LtI64', 'EqF64', - 'LeF64', 'LtF64', 'LeU', 'LtU', 'LeU64', 'LtU64', - 'EqEnum', 'LeEnum', 'LtEnum', 'EqCh', 'LeCh', 'LtCh', - 'EqB', 'LeB', 'LtB', 'EqRef', 'EqProc', 'EqUntracedRef', - 'LePtr', 'LtPtr', 'EqCString', 'Xor', 'UnaryMinusI', 'UnaryMinusI64', - 'AbsI', 'AbsI64', 'Not', 'UnaryPlusI', 'BitnotI', 'UnaryPlusI64', - 'BitnotI64', 'UnaryPlusF64', 'UnaryMinusF64', 'AbsF64', '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', - 'Asgn', 'Repr', 'Exit', 'SetLengthStr', 'SetLengthSeq', 'Assert', - 'Swap', 'IsNil', 'ArrToSeq', 'Array', 'OpenArray', 'Range', - 'Set', 'Seq', 'Int', 'Int8', 'Int16', 'Int32', - 'Int64', 'Float', 'Float32', 'Float64', 'Bool', 'Char', - 'String', 'Cstring', 'Pointer', 'AnyEnum', 'EmptySet', 'IntSetBaseType', - 'Nil', 'IsMainModule', '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' + 'None', 'Defined', 'Low', 'High', 'SizeOf', 'Is', + 'Succ', 'Pred', 'Inc', 'Dec', 'Ord', 'New', + 'NewFinalize', 'NewSeq', 'RegisterFinalizer', 'LengthOpenArray', 'LengthStr', 'LengthArray', + 'LengthSeq', 'Incl', 'Excl', 'Card', 'Chr', 'GCref', + 'GCunref', 'AddI', 'SubI', 'MulI', 'DivI', 'ModI', + 'AddI64', 'SubI64', 'MulI64', 'DivI64', 'ModI64', 'ShrI', + 'ShlI', 'BitandI', 'BitorI', 'BitxorI', 'MinI', 'MaxI', + 'ShrI64', 'ShlI64', 'BitandI64', 'BitorI64', 'BitxorI64', 'MinI64', + 'MaxI64', 'AddF64', 'SubF64', 'MulF64', 'DivF64', 'MinF64', + 'MaxF64', 'AddU', 'SubU', 'MulU', 'DivU', 'ModU', + 'AddU64', 'SubU64', 'MulU64', 'DivU64', 'ModU64', 'EqI', + 'LeI', 'LtI', 'EqI64', 'LeI64', 'LtI64', 'EqF64', + 'LeF64', 'LtF64', 'LeU', 'LtU', 'LeU64', 'LtU64', + 'EqEnum', 'LeEnum', 'LtEnum', 'EqCh', 'LeCh', 'LtCh', + 'EqB', 'LeB', 'LtB', 'EqRef', 'EqProc', 'EqUntracedRef', + 'LePtr', 'LtPtr', 'EqCString', 'Xor', 'UnaryMinusI', 'UnaryMinusI64', + 'AbsI', 'AbsI64', 'Not', 'UnaryPlusI', 'BitnotI', 'UnaryPlusI64', + 'BitnotI64', 'UnaryPlusF64', 'UnaryMinusF64', 'AbsF64', 'Ze8ToI', 'Ze8ToI64', + 'Ze16ToI', 'Ze16ToI64', 'Ze32ToI64', 'ZeIToI64', 'ToU8', 'ToU16', + 'ToU32', 'ToFloat', 'ToBiggestFloat', 'ToInt', 'ToBiggestInt', 'CharToStr', + 'BoolToStr', 'IntToStr', 'Int64ToStr', 'FloatToStr', 'CStrToStr', 'StrToStr', + 'EnumToStr', 'And', 'Or', 'EqStr', 'LeStr', 'LtStr', + 'EqSet', 'LeSet', 'LtSet', 'MulSet', 'PlusSet', 'MinusSet', + 'SymDiffSet', 'ConStrStr', 'ConArrArr', 'ConArrT', 'ConTArr', 'ConTT', + 'Slice', 'AppendStrCh', 'AppendStrStr', 'AppendSeqElem', 'AppendSeqSeq', 'InRange', + 'InSet', 'Asgn', 'Repr', 'Exit', 'SetLengthStr', 'SetLengthSeq', + 'Assert', 'Swap', 'IsNil', 'ArrToSeq', 'Array', 'OpenArray', + 'Range', 'Set', 'Seq', 'Int', 'Int8', 'Int16', + 'Int32', 'Int64', 'Float', 'Float32', 'Float64', 'Bool', + 'Char', 'String', 'Cstring', 'Pointer', 'AnyEnum', 'EmptySet', + 'IntSetBaseType', 'Nil', 'IsMainModule', 'CompileDate', 'CompileTime', 'NimrodVersion', + 'NimrodMajor', 'NimrodMinor', 'NimrodPatch', 'CpuEndian', 'HostOS', 'HostCPU', + '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]]] ); @@ -1342,13 +1343,13 @@ end; function IntSetContains(const s: TIntSet; key: int): bool; var - u: int; + u: TBitScalar; t: PTrunk; begin - t := IntSetGet(s, key shr TrunkShift); + t := IntSetGet(s, shru(key, TrunkShift)); if t <> nil then begin u := key and TrunkMask; - result := (t.bits[u shr IntShift] and (1 shl (u and IntMask))) <> 0 + result := (t.bits[shru(u, IntShift)] and shlu(1, u and IntMask)) <> 0 end else result := false @@ -1356,27 +1357,27 @@ end; procedure IntSetIncl(var s: TIntSet; key: int); var - u: int; + u: TBitScalar; t: PTrunk; begin - t := IntSetPut(s, key shr TrunkShift); + t := IntSetPut(s, shru(key, TrunkShift)); u := key and TrunkMask; - t.bits[u shr IntShift] := t.bits[u shr IntShift] - or (1 shl (u and IntMask)); + t.bits[shru(u, IntShift)] := t.bits[shru(u, IntShift)] + or shlu(1, u and IntMask); end; function IntSetContainsOrIncl(var s: TIntSet; key: int): bool; var - u: int; + u: TBitScalar; t: PTrunk; begin - t := IntSetGet(s, key shr TrunkShift); + t := IntSetGet(s, shru(key, TrunkShift)); if t <> nil then begin u := key and TrunkMask; - result := (t.bits[u shr IntShift] and (1 shl (u and IntMask))) <> 0; + result := (t.bits[shru(u, IntShift)] and shlu(1, u and IntMask)) <> 0; if not result then - t.bits[u shr IntShift] := t.bits[u shr IntShift] - or (1 shl (u and IntMask)); + t.bits[shru(u, IntShift)] := t.bits[shru(u, IntShift)] + or shlu(1, u and IntMask); end else begin IntSetIncl(s, key); diff --git a/nim/astalgo.pas b/nim/astalgo.pas index 0e31f4ac7..f7b6f651d 100644 --- a/nim/astalgo.pas +++ b/nim/astalgo.pas @@ -450,29 +450,27 @@ begin else begin istr := spaces(indent+2); result := ropef('{$n$1"kind": $2', - [istr, makeYamlString(nodeKindToStr[n.kind])]); + [istr, makeYamlString(nodeKindToStr[n.kind])]); if maxRecDepth <> 0 then begin appf(result, ',$n$1"info": $2', [istr, lineInfoToStr(n.info)]); case n.kind of nkCharLit..nkInt64Lit: - appf(result, '$n$1"intVal": $2', [istr, toRope(n.intVal)]); + appf(result, ',$n$1"intVal": $2', [istr, toRope(n.intVal)]); nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, '$n$1"floatVal": $2', - [istr, toRopeF(n.floatVal)]); + appf(result, ',$n$1"floatVal": $2', [istr, toRopeF(n.floatVal)]); nkStrLit..nkTripleStrLit: - appf(result, '$n$1"strVal": $2', - [istr, makeYamlString(n.strVal)]); + appf(result, ',$n$1"strVal": $2', [istr, makeYamlString(n.strVal)]); nkSym: appf(result, ',$n$1"sym": $2', [istr, symToYamlAux(n.sym, marker, indent+2, maxRecDepth)]); nkIdent: begin if n.ident <> nil then - appf(result, '$n$1"ident": $2', + appf(result, ',$n$1"ident": $2', [istr, makeYamlString(n.ident.s)]) else - appf(result, '$n$1"ident": null', [istr]) + appf(result, ',$n$1"ident": null', [istr]) end else begin if sonsLen(n) > 0 then begin @@ -552,12 +550,12 @@ begin if maxRecDepth <> 0 then begin case n.kind of nkCharLit..nkInt64Lit: - appf(result, '$n$1"intVal": $2', [istr, toRope(n.intVal)]); + appf(result, ',$n$1"intVal": $2', [istr, toRope(n.intVal)]); nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, '$n$1"floatVal": $2', + appf(result, ',$n$1"floatVal": $2', [istr, toRopeF(n.floatVal)]); nkStrLit..nkTripleStrLit: - appf(result, '$n$1"strVal": $2', + appf(result, ',$n$1"strVal": $2', [istr, makeYamlString(n.strVal)]); nkSym: appf(result, ',$n$1"sym": $2_$3', @@ -565,10 +563,10 @@ begin nkIdent: begin if n.ident <> nil then - appf(result, '$n$1"ident": $2', + appf(result, ',$n$1"ident": $2', [istr, makeYamlString(n.ident.s)]) else - appf(result, '$n$1"ident": null', [istr]) + appf(result, ',$n$1"ident": null', [istr]) end else begin if sonsLen(n) > 0 then begin diff --git a/nim/ccgexprs.pas b/nim/ccgexprs.pas index f94cff3a4..161804208 100644 --- a/nim/ccgexprs.pas +++ b/nim/ccgexprs.pas @@ -126,7 +126,7 @@ var j: int; begin result := 0; - if CPU[hostCPU].endian = CPU[targetCPU].endian then begin + if CPU[platform.hostCPU].endian = CPU[targetCPU].endian then begin for j := 0 to size-1 do if j < length(s) then result := result or shlu(Ze64(s[j]), j * 8) @@ -773,6 +773,34 @@ begin putIntoDest(p, d, field.typ, r); end; +procedure genTupleElem(p: BProc; e: PNode; var d: TLoc); +var + a: TLoc; + field: PSym; + ty: PType; + r: PRope; + i: int; +begin + initLocExpr(p, e.sons[0], a); + if d.k = locNone then d.s := a.s; + {@discard} getTypeDesc(p.module, a.t); // fill the record's fields.loc + ty := getUniqueType(a.t); + r := rdLoc(a); + case e.sons[1].kind of + nkIntLit..nkInt64Lit: i := int(e.sons[1].intVal); + else internalError(e.info, 'genTupleElem'); + end; + if ty.n <> nil then begin + field := ty.n.sons[i].sym; + if field = nil then InternalError(e.info, 'genTupleElem'); + if field.loc.r = nil then InternalError(e.info, 'genTupleElem'); + appf(r, '.$1', [field.loc.r]); + end + else + appf(r, '.Field$1', [toRope(i)]); + putIntoDest(p, d, ty.sons[i], r); +end; + procedure genInExprAux(p: BProc; e: PNode; var a, b, d: TLoc); forward; procedure genCheckedRecordField(p: BProc; e: PNode; var d: TLoc); @@ -848,10 +876,11 @@ begin first := intLiteral(firstOrd(ty)); // emit range check: if (optBoundsCheck in p.options) then begin - if b.k <> locImmediate then begin // semantic pass has already checked: + if not isConstExpr(e.sons[1]) then begin + // semantic pass has already checked for const index expressions useMagic(p.module, 'raiseIndexError'); if firstOrd(ty) = 0 then begin - if lastOrd(b.t) > lastOrd(ty) then + if (firstOrd(b.t) < firstOrd(ty)) or (lastOrd(b.t) > lastOrd(ty)) then appf(p.s[cpsStmts], 'if ((NU)($1) > (NU)($2)) raiseIndexError();$n', [rdCharLoc(b), intLiteral(lastOrd(ty))]) @@ -1289,14 +1318,22 @@ var a, b, f: TLoc; refType, bt: PType; ti: PRope; + oldModule: BModule; begin useMagic(p.module, 'newObj'); refType := skipVarGenericRange(e.sons[1].typ); InitLocExpr(p, e.sons[1], a); + + // This is a little hack: + oldModule := p.module; + p.module := gmti; InitLocExpr(p, e.sons[2], f); + p.module := oldModule; + initLoc(b, locExpr, a.t, OnHeap); ti := genTypeInfo(p.module, refType); - appf(p.module.s[cfsTypeInit3], '$1->finalizer = (void*)$2;$n', [ + + appf(gmti.s[cfsTypeInit3], '$1->finalizer = (void*)$2;$n', [ ti, rdLoc(f)]); b.r := ropef('($1) newObj($2, sizeof($3))', [getTypeDesc(p.module, refType), ti, @@ -1331,7 +1368,7 @@ begin UseMagic(p.module, 'reprChar'); putIntoDest(p, d, e.typ, ropef('reprChar($1)', [rdLoc(a)])) end; - tyEnum: begin + tyEnum, tyAnyEnum: begin UseMagic(p.module, 'reprEnum'); putIntoDest(p, d, e.typ, ropef('reprEnum($1, $2)', [rdLoc(a), genTypeInfo(p.module, t)])) @@ -1853,6 +1890,7 @@ begin mFloatToStr: genDollar(p, e, d, 'nimFloatToStr', 'nimFloatToStr($1)'); mCStrToStr: genDollar(p, e, d, 'cstrToNimstr', 'cstrToNimstr($1)'); mStrToStr: expr(p, e.sons[1], d); + mEnumToStr: genRepr(p, e, d); mAssert: begin if (optAssert in p.Options) then begin useMagic(p.module, 'internalAssert'); @@ -1996,23 +2034,31 @@ var it: PNode; t: PType; begin - // the code generator assumes that there are only tuple constructors with - // field names! if not handleConstExpr(p, n, d) then begin t := getUniqueType(n.typ); {@discard} getTypeDesc(p.module, t); // so that any fields are initialized if d.k = locNone then getTemp(p, t, d); - 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'); - initLoc(rec, 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); + if it.kind = nkExprColonExpr then begin + initLoc(rec, 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 + else if t.n = nil then begin + initLoc(rec, locExpr, it.typ, d.s); + rec.r := ropef('$1.Field$2', [rdLoc(d), toRope(i)]); + expr(p, it, rec); + end + else begin + initLoc(rec, locExpr, it.typ, d.s); + if (t.n.sons[i].kind <> nkSym) then + InternalError(n.info, 'genTupleConstr: 2'); + rec.r := ropef('$1.$2', [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)]); + expr(p, it, rec); + end end end end; @@ -2123,11 +2169,10 @@ begin sym := e.sym; case sym.Kind of skProc, skConverter: begin - // generate prototype if not already declared in this translation unit - genProcPrototype(p.module, sym); + genProc(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) + putLocIntoDest(p, d, sym.loc); end; skConst: if isSimpleConst(sym.typ) then @@ -2160,8 +2205,6 @@ begin nkStrLit..nkTripleStrLit, nkIntLit..nkInt64Lit, nkFloatLit..nkFloat64Lit, nkNilLit, nkCharLit: begin putIntoDest(p, d, e.typ, genLiteral(p, e)); - if d.k in [locNone, locExpr] then - d.k := locImmediate // for removal of index checks end; nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkPostfix, nkCommand: begin if (e.sons[0].kind = nkSym) and @@ -2189,6 +2232,7 @@ begin tyOpenArray: genOpenArrayElem(p, e, d); tySequence, tyString: genSeqElem(p, e, d); tyCString: genCStringElem(p, e, d); + tyTuple: genTupleElem(p, e, d); else InternalError(e.info, 'expr(nkBracketExpr, ' + typeKindToStr[ty.kind] + ')'); end diff --git a/nim/ccgstmts.pas b/nim/ccgstmts.pas index 0e93d6b0f..e611bbeea 100644 --- a/nim/ccgstmts.pas +++ b/nim/ccgstmts.pas @@ -801,9 +801,16 @@ begin assert(key.kind = nkIdent); case whichKeyword(key.ident) of wBreakpoint: genBreakPoint(p, it); + wDeadCodeElim: begin + if not (optDeadCodeElim in gGlobalOptions) then begin + // we need to keep track of ``deadCodeElim`` pragma + if (sfDeadCodeElim in p.module.module.flags) then + addPendingModule(p.module) + end + end else begin end end - end + end; end; procedure genAsgn(p: BProc; e: PNode); @@ -816,6 +823,17 @@ begin expr(p, e.sons[1], a); end; +procedure genFastAsgn(p: BProc; e: PNode); +var + a: TLoc; +begin + genLineDir(p, e); // BUGFIX + InitLocExpr(p, e.sons[0], a); + include(a.flags, lfNoDeepCopy); + assert(a.t <> nil); + expr(p, e.sons[1], a); +end; + procedure genStmts(p: BProc; t: PNode); var a: TLoc; @@ -844,6 +862,7 @@ begin initLocExpr(p, t, a); end; nkAsgn: genAsgn(p, t); + nkFastAsgn: genFastAsgn(p, t); nkDiscardStmt: begin genLineDir(p, t); initLocExpr(p, t.sons[0], a); @@ -865,17 +884,13 @@ begin nkProcDef, nkConverterDef: begin if (t.sons[genericParamsPos] = nil) then begin prc := t.sons[namePos].sym; - if (t.sons[codePos] <> nil) - or (lfDynamicLib in prc.loc.flags) then begin // BUGFIX - if IntSetContainsOrIncl(p.module.debugDeclared, prc.id) then begin - internalError(t.info, 'genStmts(): ' + toString(prc.id)); - // XXX: remove this check! - end; - //if IntSetContains(p.module.debugDeclared, 2642) then - // InternalError(t.info, 'this sucks ' + toString(prc.id)); - genProc(p.module, prc) + if not (optDeadCodeElim in gGlobalOptions) and + not (sfDeadCodeElim in getModule(prc).flags) + or ([sfExportc, sfCompilerProc] * prc.flags = [sfExportc]) then begin + if (t.sons[codePos] <> nil) or (lfDynamicLib in prc.loc.flags) then begin + genProc(p.module, prc) + end end - //else if sfCompilerProc in prc.flags then genProcPrototype(prc); end end; else diff --git a/nim/ccgtypes.pas b/nim/ccgtypes.pas index 5f4def667..f6eb64c08 100644 --- a/nim/ccgtypes.pas +++ b/nim/ccgtypes.pas @@ -8,7 +8,7 @@ // //var -// newDummyVar: int; // just to check the rodgen mechanism +// newDummyVar: int; // just to check the symbol file mechanism // ------------------------- Name Mangling -------------------------------- @@ -461,6 +461,22 @@ begin app(result, '};' + tnl); end; +function getTupleDesc(m: BModule; typ: PType; name: PRope; + var check: TIntSet): PRope; +var + desc: PRope; + i: int; +begin + result := ropef('struct $1 {$n', [name]); + desc := nil; + for i := 0 to sonsLen(typ)-1 do + appf(desc, '$1 Field$2;$n', + [getTypeDescAux(m, typ.sons[i], check), toRope(i)]); + if (desc = nil) then app(result, 'char dummy;' + tnl) + else app(result, desc); + app(result, '};' + tnl); +end; + procedure pushType(m: BModule; typ: PType); var L: int; @@ -571,13 +587,15 @@ begin if result = nil then begin result := getTypeName(t); if not isImportedType(t) then - appf(m.s[cfsForwardTypes], - getForwardStructFormat(), [result]); + appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]); IdTablePut(m.forwTypeCache, t, result) end; IdTablePut(m.typeCache, t, result); // always call for sideeffects: - recdesc := getRecordDesc(m, t, result, check); + if t.n <> nil then + recdesc := getRecordDesc(m, t, result, check) + else + recdesc := getTupleDesc(m, t, result, check); if not isImportedType(t) then app(m.s[cfsTypes], recdesc); end; tySet: begin @@ -735,9 +753,11 @@ begin assert(n.sons[0].kind = nkSym); field := n.sons[0].sym; tmp := getTempName(); + useMagic(m, 'chckNil'); appf(m.s[cfsTypeInit3], '$1.kind = 3;$n' + '$1.offset = offsetof($2, $3);$n' + '$1.typ = $4;$n' + + 'chckNil($1.typ);$n' + '$1.name = $5;$n' + '$1.sons = &$6[0];$n' + '$1.len = $7;$n', @@ -746,7 +766,7 @@ begin makeCString(field.name.s), tmp, toRope(lengthOrd(field.typ))]); appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', - [tmp, toRope(lengthOrd(field.typ)+1)]); + [tmp, toRope(lengthOrd(field.typ)+1)]); for i := 1 to len-1 do begin b := n.sons[i]; // branch tmp2 := getNimNode(m); @@ -761,18 +781,18 @@ begin y := int(getOrdValue(b.sons[j].sons[1])); while x <= y do begin appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', - [tmp, toRope(x), tmp2]); + [tmp, toRope(x), tmp2]); inc(x); end; end else appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', - [tmp, toRope(getOrdValue(b.sons[j])), tmp2]) + [tmp, toRope(getOrdValue(b.sons[j])), tmp2]) end end; nkElse: begin appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', - [tmp, toRope(lengthOrd(field.typ)), tmp2]); + [tmp, toRope(lengthOrd(field.typ)), tmp2]); end else internalError(n.info, 'genObjectFields(nkRecCase)'); @@ -781,9 +801,11 @@ begin end; nkSym: begin field := n.sym; + useMagic(m, 'chckNil'); appf(m.s[cfsTypeInit3], '$1.kind = 1;$n' + '$1.offset = offsetof($2, $3);$n' + '$1.typ = $4;$n' + + 'chckNil($1.typ);$n' + '$1.name = $5;$n', [expr, getTypeDesc(m, typ), field.loc.r, genTypeInfo(m, field.typ), @@ -804,6 +826,41 @@ begin appf(m.s[cfsTypeInit3], '$1->node = &$2;$n', [name, tmp]); end; +procedure genTupleInfo(m: BModule; typ: PType; name: PRope); +var + tmp, expr, tmp2: PRope; + i, len: int; + a: PType; +begin + genTypeInfoAuxBase(m, typ, name, toRope('0'+'')); + expr := getNimNode(m); + len := sonsLen(typ); + if len > 0 then begin + tmp := getTempName(); + appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', [tmp, toRope(len)]); + for i := 0 to len-1 do begin + a := typ.sons[i]; + tmp2 := getNimNode(m); + appf(m.s[cfsTypeInit3], '$1[$2] = &$3;$n', [tmp, toRope(i), tmp2]); + useMagic(m, 'chckNil'); + appf(m.s[cfsTypeInit3], '$1.kind = 1;$n' + + '$1.offset = offsetof($2, Field$3);$n' + + '$1.typ = $4;$n' + + 'chckNil($1.typ);$n' + + '$1.name = "Field$3";$n', + [tmp2, getTypeDesc(m, typ), toRope(i), + genTypeInfo(m, a)]); + end; + appf(m.s[cfsTypeInit3], + '$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n', [ + expr, toRope(len), tmp]); + end + else + appf(m.s[cfsTypeInit3], + '$1.len = $2; $1.kind = 2;$n', [expr, toRope(len)]); + appf(m.s[cfsTypeInit3], '$1->node = &$2;$n', [name, tmp]); +end; + procedure genEnumInfo(m: BModule; typ: PType; name: PRope); var nodePtrs, elemNode, enumNames, enumArray, counter, specialCases: PRope; @@ -817,7 +874,8 @@ begin genTypeInfoAux(m, typ, name); nodePtrs := getTempName(); len := sonsLen(typ.n); - appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', [nodePtrs, toRope(len)]); + appf(m.s[cfsTypeInit1], 'static TNimNode* $1[$2];$n', + [nodePtrs, toRope(len)]); enumNames := nil; specialCases := nil; firstNimNode := m.typeNodes; @@ -879,83 +937,79 @@ function genTypeInfo(m: BModule; typ: PType): PRope; var t: PType; id: int; - dataGen: bool; + dataGenerated: bool; begin t := getUniqueType(typ); id := IiTableGet(gToTypeInfoId, t.id); if id = invalidKey then begin - dataGen := false; - case t.kind of - tyEnum, tyBool: begin - id := t.id; - dataGen := true - end; - tyObject: begin - if isPureObject(t) then - id := getID() - else begin - id := t.id; - dataGen := true - end - end - else - id := getID(); - end; + dataGenerated := false; + id := t.id; // getID(); IiTablePut(gToTypeInfoId, t.id, id); end else - dataGen := true; + dataGenerated := true; result := ropef('NTI$1', [toRope(id)]); - if not IntSetContainsOrIncl(m.typeInfoMarker, t.id) then begin + if not IntSetContainsOrIncl(m.typeInfoMarker, id) then begin // declare type information structures: useMagic(m, 'TNimType'); useMagic(m, 'TNimNode'); - if dataGen then - appf(m.s[cfsVars], 'extern TNimType* $1; /* $2 */$n', - [result, toRope(typeToString(t))]); + appf(m.s[cfsVars], 'extern TNimType* $1; /* $2 */$n', + [result, toRope(typeToString(t))]); end; - if dataGen then exit; + if dataGenerated then exit; case t.kind of tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, tyInt..tyFloat128, tyVar: - genTypeInfoAuxBase(m, t, result, toRope('0'+'')); - tyRef, tyPtr, tySequence, tyRange: genTypeInfoAux(m, t, result); - tyArrayConstr, tyArray: genArrayInfo(m, t, result); - tySet: genSetInfo(m, t, result); - tyEnum: genEnumInfo(m, t, result); - tyObject, tyTuple: genObjectInfo(m, t, result); + genTypeInfoAuxBase(gmti, t, result, toRope('0'+'')); + tyRef, tyPtr, tySequence, tyRange: genTypeInfoAux(gmti, t, result); + tyArrayConstr, tyArray: genArrayInfo(gmti, t, result); + tySet: genSetInfo(gmti, t, result); + tyEnum: genEnumInfo(gmti, t, result); + tyObject: genObjectInfo(gmti, t, result); + tyTuple: begin + if t.n <> nil then genObjectInfo(gmti, t, result) + else genTupleInfo(gmti, t, result); + end; else InternalError('genTypeInfo(' + typekindToStr[t.kind] + ')'); end end; procedure genTypeSection(m: BModule; n: PNode); +begin +end; + +(* +procedure genTypeSection(m: BModule; n: PNode); var i: int; a: PNode; t: PType; begin - for i := 0 to sonsLen(n)-1 do begin - a := n.sons[i]; - if a.kind = nkCommentStmt then continue; - if (a.sons[0].kind <> nkSym) then InternalError(a.info, 'genTypeSection'); - t := a.sons[0].sym.typ; - if (a.sons[2] = nil) - or not (a.sons[2].kind in [nkSym, nkIdent, nkAccQuoted]) then - if t <> nil then - case t.kind of - tyEnum, tyBool: begin - useMagic(m, 'TNimType'); - useMagic(m, 'TNimNode'); - genEnumInfo(m, t, ropef('NTI$1', [toRope(t.id)])); - end; - tyObject: begin - if not isPureObject(t) then begin + if not (optDeadCodeElim in gGlobalOptions) then begin + for i := 0 to sonsLen(n)-1 do begin + a := n.sons[i]; + if a.kind = nkCommentStmt then continue; + if (a.sons[0].kind <> nkSym) then InternalError(a.info, 'genTypeSection'); + t := a.sons[0].sym.typ; + if (a.sons[2] = nil) + or not (a.sons[2].kind in [nkSym, nkIdent, nkAccQuoted]) then + if t <> nil then + case t.kind of + tyEnum, tyBool: begin useMagic(m, 'TNimType'); useMagic(m, 'TNimNode'); - genObjectInfo(m, t, ropef('NTI$1', [toRope(t.id)])); + genEnumInfo(m, t, ropef('NTI$1', [toRope(t.id)])); + end; + tyObject: begin + if not isPureObject(t) then begin + useMagic(m, 'TNimType'); + useMagic(m, 'TNimNode'); + genObjectInfo(m, t, ropef('NTI$1', [toRope(t.id)])); + end end + else begin end end - else begin end - end + end end end; +*) \ No newline at end of file diff --git a/nim/ccgutils.pas b/nim/ccgutils.pas index 05f2ea828..97ef65f70 100644 --- a/nim/ccgutils.pas +++ b/nim/ccgutils.pas @@ -27,16 +27,48 @@ function GetUniqueType(key: PType): PType; implementation var - gTypeTable: TIdTable; + gTypeTable: array [TTypeKind] of TIdTable; + +procedure initTypeTables(); +var + i: TTypeKind; +begin + for i := low(TTypeKind) to high(TTypeKind) do + InitIdTable(gTypeTable[i]); +end; function GetUniqueType(key: PType): PType; var t: PType; h: THash; + k: TTypeKind; begin - // this was a hotspot in the compiler! + // this is a hotspot in the compiler! result := key; if key = nil then exit; + k := key.kind; + case k of + tyObject, tyEnum: begin + result := PType(IdTableGet(gTypeTable[k], key)); + if result = nil then begin + IdTablePut(gTypeTable[k], key, key); + result := key; + end + end; + tyGenericInst: result := GetUniqueType(lastSon(key)); + tyProc: begin end; + else begin + // we have to do a slow linear search because types may need + // to be compared by their structure: + if IdTableHasObjectAsKey(gTypeTable[k], key) then exit; + for h := 0 to high(gTypeTable[k].data) do begin + t := PType(gTypeTable[k].data[h].key); + if (t <> nil) and sameType(t, key) then begin result := t; exit end + end; + IdTablePut(gTypeTable[k], key, key); + end; + end; + (* case key.Kind of tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, tyInt..tyFloat128, tyProc, tyAnyEnum: begin end; @@ -62,7 +94,7 @@ begin end end; tyGenericInst: result := GetUniqueType(lastSon(key)); - end; + end; *) end; function TableGetType(const tab: TIdTable; key: PType): PObject; @@ -122,6 +154,6 @@ begin app(result, toRope(res)); end; -initialization - InitIdTable(gTypeTable); +begin + InitTypeTables(); end. diff --git a/nim/cgen.pas b/nim/cgen.pas index 736d4b796..02713f902 100644 --- a/nim/cgen.pas +++ b/nim/cgen.pas @@ -73,7 +73,6 @@ type cpsStmts // section of local statements for C proc ); - TCProcSections = array [TCProcSection] of PRope; // TCProcSections represents a generated C proc @@ -112,21 +111,64 @@ type typeCache: TIdTable; // cache the generated types forwTypeCache: TIdTable; // cache for forward declarations of types declaredThings: TIntSet; // things we have declared in this .c file - debugDeclared: TIntSet; // for debugging purposes + declaredProtos: TIntSet; // prototypes we have declared in this .c file headerFiles: TLinkedList; // needed headers to include typeInfoMarker: TIntSet; // needed for generating type information initProc: BProc; // code for init procedure typeStack: TTypeSeq; // used for type generation dataCache: TNodeTable; + forwardedProcs: TSymSeq; // keep forwarded procs here typeNodes, nimTypes: int;// used for type info generation - typeNodesName, nimTypesName: PRope; // used for type info generation + typeNodesName, nimTypesName: PRope; // used for type info generation end; var mainModProcs, mainModInit: PRope; // parts of the main module gMapping: PRope; // the generated mapping file (if requested) gProcProfile: Natural; // proc profile counter + gGeneratedSyms: TIntSet; // set of ID's of generated symbols + gPendingModules: array of BModule = {@ignore} nil {@emit @[]}; + // list of modules that are not finished with code generation + gForwardedProcsCounter: int = 0; + gmti: BModule; // generated type info: no need to initialize: defaults fit + +procedure addForwardedProc(m: BModule; prc: PSym); +var + L: int; +begin + L := length(m.forwardedProcs); + setLength(m.forwardedProcs, L+1); + m.forwardedProcs[L] := prc; + inc(gForwardedProcsCounter); +end; + +procedure addPendingModule(m: BModule); +var + L, i: int; +begin + for i := 0 to high(gPendingModules) do + if gPendingModules[i] = m then + InternalError('module already pending: ' + m.module.name.s); + L := length(gPendingModules); + setLength(gPendingModules, L+1); + gPendingModules[L] := m; +end; +function findPendingModule(m: BModule; s: PSym): BModule; +var + ms: PSym; + i: int; +begin + ms := getModule(s); + if ms.id = m.module.id then begin + result := m; exit + end; + for i := 0 to high(gPendingModules) do begin + result := gPendingModules[i]; + if result.module.id = ms.id then exit; + end; + InternalError(s.info, 'no pending module found for: ' + s.name.s); +end; procedure initLoc(var result: TLoc; k: TLocKind; typ: PType; s: TStorageLoc); begin @@ -209,26 +251,13 @@ end; // -------------------------- Variable manager ---------------------------- -procedure declareGlobalVar(m: BModule; s: PSym); -begin - 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(m.s[cfsVars], ' register'); - if sfVolatile in s.flags then - app(m.s[cfsVars], ' volatile'); - if sfThreadVar in s.flags then - app(m.s[cfsVars], ' NIM_THREADVAR'); - appf(m.s[cfsVars], ' $1;$n', [s.loc.r]) - end -end; - procedure assignLocalVar(p: BProc; s: PSym); 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), OnStack); + if s.loc.k = locNone then + 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'); @@ -248,11 +277,19 @@ end; procedure assignGlobalVar(m: BModule; s: PSym); begin - fillLoc(s.loc, locGlobalVar, s.typ, mangleName(s), OnHeap); + if s.loc.k = locNone then + 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(m.s[cfsVars], 'extern '); - declareGlobalVar(m, s); + app(m.s[cfsVars], getTypeDesc(m, s.loc.t)); + if sfRegister in s.flags then + app(m.s[cfsVars], ' register'); + if sfVolatile in s.flags then + app(m.s[cfsVars], ' volatile'); + if sfThreadVar in s.flags then + app(m.s[cfsVars], ' NIM_THREADVAR'); + appf(m.s[cfsVars], ' $1;$n', [s.loc.r]); if [optStackTrace, optEndb] * m.module.options = [optStackTrace, optEndb] then begin useMagic(m, 'dbgRegisterGlobal'); @@ -282,6 +319,12 @@ begin end end; +procedure fillProcLoc(sym: PSym); +begin + if sym.loc.k = locNone then + fillLoc(sym.loc, locProc, sym.typ, mangleName(sym), OnStack); +end; + // -------------------------- label manager ------------------------------- // note that a label is a location too @@ -296,11 +339,11 @@ begin appf(p.s[cpsStmts], '$1: ;$n', [labl]) end; -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; +procedure genProcPrototype(m: BModule; sym: PSym); forward; {$include 'ccgexprs.pas'} {$include 'ccgstmts.pas'} @@ -343,11 +386,11 @@ begin 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 - appf(m.s[cfsDynLibInit], - '$1 = ($2) nimGetProcAddr($3, $4);$n', - [tmp, getTypeDesc(m, sym.typ), lib.name, - makeCString(ropeToStr(extname))]); - declareGlobalVar(m, sym) + appf(m.s[cfsDynLibInit], '$1 = ($2) nimGetProcAddr($3, $4);$n', + [tmp, getTypeDesc(m, sym.typ), lib.name, makeCString(ropeToStr(extname))]); + + app(m.s[cfsVars], getTypeDesc(m, sym.loc.t)); + appf(m.s[cfsVars], ' $1;$n', [sym.loc.r]); end; // ----------------------------- sections --------------------------------- @@ -356,16 +399,16 @@ procedure UseMagic(m: BModule; const name: string); var sym: PSym; begin - 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, skConverter: genProcPrototype(m, sym); - skVar: genVarPrototype(m, sym); - skType: {@discard} getTypeDesc(m, sym.typ); - else InternalError('useMagic: ' + name) - end + if sym <> nil then + case sym.kind of + skProc, skConverter: genProc(m, sym); + skVar: genVarPrototype(m, sym); + skType: {@discard} getTypeDesc(m, sym.typ); + else InternalError('useMagic: ' + name) + end + else if not (sfSystemModule in m.module.flags) then + rawMessage(errSystemNeeds, name); // don't be too picky here end; procedure generateHeaders(m: BModule); @@ -405,95 +448,131 @@ begin result := (s.typ.sons[0] <> nil) and not isInvalidReturnType(s.typ.sons[0]) end; -procedure genProc(m: BModule; prc: PSym); +procedure genProcAux(m: BModule; prc: PSym); var p: BProc; generatedProc, header, returnStmt: PRope; - i, profileId: int; + i: int; res, param: PSym; begin - 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(m, prc) - else if not (sfImportc in prc.flags) then begin - // we have a real proc here: - p := newProc(prc, m); - header := genProcHeader(m, prc); - if (sfCompilerProc in prc.flags) - 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); - - if not (sfPure in prc.flags) and (prc.typ.sons[0] <> nil) then begin - res := prc.ast.sons[resultPos].sym; // get result symbol - if not isInvalidReturnType(prc.typ.sons[0]) then begin - // declare the result symbol: - assignLocalVar(p, res); - assert(res.loc.r <> nil); - returnStmt := ropef('return $1;$n', [rdLoc(res.loc)]); - end - else begin - fillResult(res); - assignParam(p, res); - end; - initVariable(p, res); - genObjectInit(p, res.typ, res.loc, true); - end; - for i := 1 to sonsLen(prc.typ.n)-1 do begin - param := prc.typ.n.sons[i].sym; - assignParam(p, param) + p := newProc(prc, m); + header := genProcHeader(m, prc); + returnStmt := nil; + assert(prc.ast <> nil); + + if not (sfPure in prc.flags) and (prc.typ.sons[0] <> nil) then begin + res := prc.ast.sons[resultPos].sym; // get result symbol + if not isInvalidReturnType(prc.typ.sons[0]) then begin + // declare the result symbol: + assignLocalVar(p, res); + assert(res.loc.r <> nil); + returnStmt := ropef('return $1;$n', [rdLoc(res.loc)]); + end + else begin + fillResult(res); + assignParam(p, res); end; + initVariable(p, res); + genObjectInit(p, res.typ, res.loc, true); + end; + for i := 1 to sonsLen(prc.typ.n)-1 do begin + param := prc.typ.n.sons[i].sym; + assignParam(p, param) + end; - genStmts(p, prc.ast.sons[codePos]); // modifies p.locals, p.init, etc. - if sfPure in prc.flags then - 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], ropef( - 'F.procname = $1;$n' + - 'F.prev = framePtr;$n' + - 'F.filename = $2;$n' + - 'F.line = 0;$n' + - 'framePtr = (TFrame*)&F;$n', - [makeCString(prc.owner.name.s +{&} '.' +{&} prc.name.s), - makeCString(toFilename(prc.info))])); - end; - if optProfiler in prc.options then begin - if gProcProfile >= 64*1024 then // XXX: hard coded value! - InternalError(prc.info, 'too many procedures for profiling'); - useMagic(m, 'profileData'); - app(p.s[cpsLocals], 'ticks NIM_profilingStart;'+tnl); - if prc.loc.a < 0 then begin - appf(m.s[cfsDebugInit], 'profileData[$1].procname = $2;$n', - [toRope(gProcProfile), - makeCString(prc.owner.name.s +{&} '.' +{&} prc.name.s)]); - prc.loc.a := gProcProfile; - inc(gProcProfile); - end; - prepend(p.s[cpsInit], toRope('NIM_profilingStart = getticks();' + tnl)); + genStmts(p, prc.ast.sons[codePos]); // modifies p.locals, p.init, etc. + if sfPure in prc.flags then + 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], ropef( + 'F.procname = $1;$n' + + 'F.prev = framePtr;$n' + + 'F.filename = $2;$n' + + 'F.line = 0;$n' + + 'framePtr = (TFrame*)&F;$n', + [makeCString(prc.owner.name.s +{&} '.' +{&} prc.name.s), + makeCString(toFilename(prc.info))])); + end; + if optProfiler in prc.options then begin + if gProcProfile >= 64*1024 then // XXX: hard coded value! + InternalError(prc.info, 'too many procedures for profiling'); + useMagic(m, 'profileData'); + app(p.s[cpsLocals], 'ticks NIM_profilingStart;'+tnl); + if prc.loc.a < 0 then begin + appf(m.s[cfsDebugInit], 'profileData[$1].procname = $2;$n', + [toRope(gProcProfile), + makeCString(prc.owner.name.s +{&} '.' +{&} prc.name.s)]); + prc.loc.a := gProcProfile; + inc(gProcProfile); end; - app(generatedProc, con(p.s)); - if p.beforeRetNeeded then - app(generatedProc, 'BeforeRet: ;' + tnl); - if optStackTrace in prc.options then - app(generatedProc, 'framePtr = framePtr->prev;' + tnl); - if optProfiler in prc.options then - appf(generatedProc, - 'profileData[$1].total += elapsed(getticks(), NIM_profilingStart);$n', - [toRope(prc.loc.a)]); - app(generatedProc, returnStmt); - app(generatedProc, '}' + tnl); + prepend(p.s[cpsInit], toRope('NIM_profilingStart = getticks();' + tnl)); end; - app(m.s[cfsProcs], generatedProc); + app(generatedProc, con(p.s)); + if p.beforeRetNeeded then + app(generatedProc, 'BeforeRet: ;' + tnl); + if optStackTrace in prc.options then + app(generatedProc, 'framePtr = framePtr->prev;' + tnl); + if optProfiler in prc.options then + appf(generatedProc, + 'profileData[$1].total += elapsed(getticks(), NIM_profilingStart);$n', + [toRope(prc.loc.a)]); + app(generatedProc, returnStmt); + app(generatedProc, '}' + tnl); + end; + app(m.s[cfsProcs], generatedProc); +end; + +procedure genProcPrototype(m: BModule; sym: PSym); +begin + useHeader(m, sym); + if (lfNoDecl in sym.loc.Flags) then exit; + if lfDynamicLib in sym.loc.Flags then begin + if (sym.owner.id <> m.module.id) and + not intSetContainsOrIncl(m.declaredThings, sym.id) then begin + appf(m.s[cfsVars], 'extern $1 Dl_$2;$n', + [getTypeDesc(m, sym.loc.t), toRope(sym.id)]) + end + end + else begin + if not IntSetContainsOrIncl(m.declaredProtos, sym.id) then + appf(m.s[cfsProcHeaders], '$1;$n', [genProcHeader(m, sym)]); + end +end; + +procedure genProcNoForward(m: BModule; prc: PSym); +begin + fillProcLoc(prc); + useHeader(m, prc); + genProcPrototype(m, prc); + if (lfNoDecl in prc.loc.Flags) then exit; + if prc.typ.callConv = ccInline then begin + // We add inline procs to the calling module to enable C based inlining. + // This also means that a check with ``gGeneratedSyms`` is wrong, we need + // a check for ``m.declaredThings``. + if not intSetContainsOrIncl(m.declaredThings, prc.id) then + genProcAux(m, prc); end + else if lfDynamicLib in prc.loc.flags then begin + if not IntSetContainsOrIncl(gGeneratedSyms, prc.id) then + SymInDynamicLib(findPendingModule(m, prc), prc); + end + else if not (sfImportc in prc.flags) then begin + if not IntSetContainsOrIncl(gGeneratedSyms, prc.id) then + genProcAux(findPendingModule(m, prc), prc); + end +end; + +procedure genProc(m: BModule; prc: PSym); +begin + fillProcLoc(prc); + if [sfForward, sfFromGeneric] * prc.flags <> [] then + addForwardedProc(m, prc) + else + genProcNoForward(m, prc) end; procedure genVarPrototype(m: BModule; sym: PSym); @@ -522,7 +601,8 @@ end; procedure genConstPrototype(m: BModule; sym: PSym); begin useHeader(m, sym); - fillLoc(sym.loc, locData, sym.typ, mangleName(sym), OnUnknown); + if sym.loc.k = locNone then + fillLoc(sym.loc, locData, sym.typ, mangleName(sym), OnUnknown); if (lfNoDecl in sym.loc.Flags) or intSetContainsOrIncl(m.declaredThings, sym.id) then exit; @@ -535,32 +615,6 @@ begin end end; -procedure genProcPrototype(m: BModule; sym: PSym); -begin - 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 <> 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(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(m.declaredThings, sym.id) then exit; - appf(m.s[cfsProcHeaders], '$1;$n', [genProcHeader(m, sym)]); - if (sym.typ.callConv = ccInline) - and (sym.owner.id <> m.module.id) then - genProc(m, sym) // generate the code again! - end -end; - function getFileHeader(const cfilenoext: string): PRope; begin if optCompileOnly in gGlobalOptions then @@ -593,6 +647,7 @@ procedure genMainProc(m: BModule); const CommonMainBody = ' setStackBottom(dummy);$n' + + ' nim__datInit();$n' + ' systemInit();$n' + '$1' + '$2'; @@ -652,8 +707,7 @@ var initname: PRope; begin initname := getInitName(m); - appf(mainModProcs, 'N_NOINLINE(void, $1)(void);$n', - [initname]); + appf(mainModProcs, 'N_NOINLINE(void, $1)(void);$n', [initname]); if not (sfSystemModule in m.flags) then appf(mainModInit, '$1();$n', [initname]); end; @@ -669,14 +723,18 @@ begin {@discard} lists.IncludeStr(m.headerFiles, '<cycle.h>'); end; initname := getInitName(m.module); - registerModuleToMain(m.module); prc := ropef('N_NOINLINE(void, $1)(void) {$n', [initname]); - if m.typeNodes > 0 then + + if m.typeNodes > 0 then begin + useMagic(m, 'TNimNode'); appf(m.s[cfsTypeInit1], 'static TNimNode $1[$2];$n', - [m.typeNodesName, toRope(m.typeNodes)]); - if m.nimTypes > 0 then + [m.typeNodesName, toRope(m.typeNodes)]); + end; + if m.nimTypes > 0 then begin + useMagic(m, 'TNimType'); appf(m.s[cfsTypeInit1], 'static TNimType $1[$2];$n', [m.nimTypesName, toRope(m.nimTypes)]); + end; if optStackTrace in m.initProc.options then begin getFrameDecl(m.initProc); app(prc, m.initProc.s[cpsLocals]); @@ -716,7 +774,7 @@ begin for i := low(TCFileSection) to cfsProcs do app(result, m.s[i]) end; -function newModule(module: PSym; const filename: string): BModule; +function rawNewModule(module: PSym; const filename: string): BModule; begin new(result); {@ignore} @@ -724,7 +782,7 @@ begin {@emit} InitLinkedList(result.headerFiles); intSetInit(result.declaredThings); - intSetInit(result.debugDeclared); + intSetInit(result.declaredProtos); result.cfilename := filename; result.filename := filename; initIdTable(result.typeCache); @@ -735,12 +793,36 @@ begin result.initProc.options := gOptions; initNodeTable(result.dataCache); {@emit result.typeStack := @[];} +{@emit result.forwardedProcs := @[];} result.typeNodesName := getTempName(); result.nimTypesName := getTempName(); end; +function newModule(module: PSym; const filename: string): BModule; +begin + result := rawNewModule(module, filename); + if (optDeadCodeElim in gGlobalOptions) then begin + if (sfDeadCodeElim in module.flags) then + InternalError('added pending module twice: ' + filename); + addPendingModule(result) + end; +end; + +procedure registerTypeInfoModule(); +const + moduleName = 'nim__dat'; +var + s: PSym; +begin + s := NewSym(skModule, getIdent(moduleName), nil); + gmti := rawNewModule(s, joinPath(options.projectPath, moduleName)+'.nim'); + addPendingModule(gmti); + appf(mainModProcs, 'N_NOINLINE(void, $1)(void);$n', [getInitName(s)]); +end; + function myOpen(module: PSym; const filename: string): PPassContext; begin + if gmti = nil then registerTypeInfoModule(); result := newModule(module, filename); end; @@ -749,6 +831,7 @@ function myOpenCached(module: PSym; const filename: string; var cfile, cfilenoext, objFile: string; begin + if gmti = nil then registerTypeInfoModule(); //MessageOut('cgen.myOpenCached has been called ' + filename); cfile := changeFileExt(completeCFilePath(filename), cExt); cfilenoext := changeFileExt(cfile, ''); @@ -761,6 +844,8 @@ begin end; *) addFileToLink(cfilenoext); registerModuleToMain(module); + // XXX: this cannot be right here, initalization has to be appended during + // the ``myClose`` call result := nil; end; @@ -790,37 +875,80 @@ begin genStmts(m.initProc, n); end; -function myClose(b: PPassContext; n: PNode): PNode; +procedure finishModule(m: BModule); +var + i: int; + prc: PSym; +begin + i := 0; + while i <= high(m.forwardedProcs) do begin + // Note: ``genProc`` may add to ``m.forwardedProcs``, so we cannot use + // a for loop here + prc := m.forwardedProcs[i]; + if sfForward in prc.flags then InternalError(prc.info, 'still forwarded'); + genProcNoForward(m, prc); + inc(i); + end; + assert(gForwardedProcsCounter >= i); + dec(gForwardedProcsCounter, i); + setLength(m.forwardedProcs, 0); +end; + +procedure writeModule(m: BModule); var cfile, cfilenoext: string; - m: BModule; code: PRope; begin - result := n; - if b = nil then exit; - m := BModule(b); - if n <> nil then begin - m.initProc.options := gOptions; - genStmts(m.initProc, n); - end; // generate code for the init statements of the module: genInitCode(m); finishTypeDescriptions(m); + cfile := completeCFilePath(m.cfilename); cfilenoext := changeFileExt(cfile, ''); if sfMainModule in m.module.flags then begin // generate main file: app(m.s[cfsProcHeaders], mainModProcs); - genMainProc(m); end; code := genModule(m, cfilenoext); if shouldRecompile(code, changeFileExt(cfile, cExt), cfilenoext) then begin - addFileToCompile(cfilenoext); // is to compile + addFileToCompile(cfilenoext); end; addFileToLink(cfilenoext); if sfMainModule in m.module.flags then writeMapping(cfile, gMapping); end; +function myClose(b: PPassContext; n: PNode): PNode; +var + m: BModule; + i: int; +begin + result := n; + if b = nil then exit; + m := BModule(b); + if n <> nil then begin + m.initProc.options := gOptions; + genStmts(m.initProc, n); + end; + registerModuleToMain(m.module); + if not (optDeadCodeElim in gGlobalOptions) and + not (sfDeadCodeElim in m.module.flags) then + finishModule(m); + if sfMainModule in m.module.flags then begin + genMainProc(m); + // we need to process the transitive closure because recursive module + // deps are allowed (and the system module is processed in the wrong + // order anyway) + while gForwardedProcsCounter > 0 do + for i := 0 to high(gPendingModules) do + finishModule(gPendingModules[i]); + for i := 0 to high(gPendingModules) do writeModule(gPendingModules[i]); + setLength(gPendingModules, 0); + end; + if not (optDeadCodeElim in gGlobalOptions) and + not (sfDeadCodeElim in m.module.flags) then + writeModule(m); +end; + function cgenPass(): TPass; begin initPass(result); @@ -832,4 +960,5 @@ end; initialization InitIiTable(gToTypeInfoId); + IntSetInit(gGeneratedSyms); end. diff --git a/nim/commands.pas b/nim/commands.pas index be863e917..d87a8f084 100644 --- a/nim/commands.pas +++ b/nim/commands.pas @@ -39,14 +39,14 @@ const {$ifdef fpc} compileDate = {$I %date%}; {$else} - compileDate = '2008-0-0'; + compileDate = '2009-0-0'; {$endif} {@emit} const HelpMessage = 'Nimrod Compiler Version $1 (' +{&} compileDate +{&} ') [$2: $3]' +{&} nl +{&} - 'Copyright (c) 2004-2008 by Andreas Rumpf' +{&} nl; + 'Copyright (c) 2004-2009 by Andreas Rumpf' +{&} nl; const Usage = '' @@ -82,6 +82,7 @@ const +{&} ' --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 +{&} ' -a, --assertions:on|off code generation for assertions ON|OFF' +{&} nl ++{&} ' --dead_code_elim:on|off whole program dead code elimination ON|OFF' +{&} nl +{&} ' --opt:none|speed|size optimize not at all or for speed|size' +{&} nl +{&} ' --app:console|gui|lib generate a console|GUI application or a shared lib' +{&} nl +{&} ' -r, --run run the compiled program with given arguments' +{&} nl @@ -96,7 +97,7 @@ const // cog.outl(f(line)) //]]] +{&} 'Advanced commands::' +{&} nl -+{&} ' pas convert a Pascal file to Nimrod standard syntax' +{&} nl ++{&} ' pas convert a Pascal file to Nimrod syntax' +{&} nl +{&} ' pretty pretty print the inputfile' +{&} nl +{&} ' gen_depend generate a DOT file containing the' +{&} nl +{&} ' module dependency graph' +{&} nl @@ -135,8 +136,8 @@ const function getCommandLineDesc: string; begin - result := format(HelpMessage, [VersionAsString, platform.os[hostOS].name, - cpu[hostCPU].name]) +{&} Usage + result := format(HelpMessage, [VersionAsString, + platform.os[platform.hostOS].name, cpu[platform.hostCPU].name]) +{&} Usage end; var @@ -157,8 +158,10 @@ procedure writeAdvancedUsage(pass: TCmdLinePass); begin if (pass = passCmd1) and not advHelpWritten then begin // BUGFIX 19 - MessageOut(format(HelpMessage, [VersionAsString, platform.os[hostOS].name, - cpu[hostCPU].name]) +{&} AdvancedUsage); + MessageOut(format(HelpMessage, [VersionAsString, + platform.os[platform.hostOS].name, + cpu[platform.hostCPU].name]) +{&} + AdvancedUsage); advHelpWritten := true; helpWritten := true; halt(0); @@ -170,8 +173,9 @@ begin if (pass = passCmd1) and not versionWritten then begin versionWritten := true; helpWritten := true; - messageOut(format(HelpMessage, [VersionAsString, platform.os[hostOS].name, - cpu[hostCPU].name])) + messageOut(format(HelpMessage, [VersionAsString, + platform.os[platform.hostOS].name, + cpu[platform.hostCPU].name])) end end; @@ -388,6 +392,7 @@ begin wOverflowChecks: ProcessOnOffSwitch({@set}[optOverflowCheck], arg, pass, info); wLineDir: ProcessOnOffSwitch({@set}[optLineDir], arg, pass, info); wAssertions, wA: ProcessOnOffSwitch({@set}[optAssert], arg, pass, info); + wDeadCodeElim: ProcessOnOffSwitchG({@set}[optDeadCodeElim], arg, pass, info); wOpt: begin case whichKeyword(arg) of wSpeed: begin @@ -453,7 +458,7 @@ begin theOS := platform.NameToOS(arg); if theOS = osNone then liMessage(info, errUnknownOS, arg); - if theOS <> hostOS then begin + if theOS <> platform.hostOS then begin setTarget(theOS, targetCPU); include(gGlobalOptions, optCompileOnly); condsyms.InitDefines() @@ -465,7 +470,7 @@ begin cpu := platform.NameToCPU(arg); if cpu = cpuNone then liMessage(info, errUnknownCPU, arg); - if cpu <> hostCPU then begin + if cpu <> platform.hostCPU then begin setTarget(targetOS, cpu); include(gGlobalOptions, optCompileOnly); condsyms.InitDefines() diff --git a/nim/docgen.pas b/nim/docgen.pas index 19dc93a91..bd4613180 100644 --- a/nim/docgen.pas +++ b/nim/docgen.pas @@ -218,8 +218,6 @@ begin end; function nextSplitPoint(const s: string; start: int): int; -var - i: int; begin result := start; while result < length(s)+strStart do begin @@ -227,7 +225,7 @@ begin '_': exit; 'a'..'z': begin if result+1 < length(s)+strStart then - if s[result+1] in ['A'..'Z'] then exit; + if s[result+1] in ['A'..'Z'] then exit; end; else begin end; end; @@ -393,7 +391,8 @@ begin fillChar(r, sizeof(r), 0); {@emit} comm := genRecComment(d, n); // call this here for the side-effect! - initTokRender(r, n, {@set}[renderNoPragmas, renderNoBody]); + initTokRender(r, n, {@set}[renderNoPragmas, renderNoBody, renderNoComments, + renderDocComments]); while true do begin getNextTok(r, kind, literal); case kind of @@ -579,7 +578,7 @@ begin end; rnHyperlink: begin result := ropef('`$1 <$2>`_', [renderRstToRst(d, n.sons[0]), - renderRstToRst(d, n.sons[1])]); + renderRstToRst(d, n.sons[1])]); end; rnGeneralRole: begin result := renderRstToRst(d, n.sons[0]); @@ -661,21 +660,26 @@ begin result := ropef('<ul class="simple">$1</ul>', [result]); end; +function fieldAux(const s: string): PRope; +begin + result := toRope(strip(s)) +end; + function renderImage(d: PDoc; n: PRstNode): PRope; var s: string; begin result := ropef('<img src="$1"', [toRope(getArgument(n))]); s := getFieldValue(n, 'height'); - if s <> '' then appf(result, ' height="$1"', [toRope(s)]); + if s <> '' then appf(result, ' height="$1"', [fieldAux(s)]); s := getFieldValue(n, 'width'); - if s <> '' then appf(result, ' width="$1"', [toRope(s)]); + if s <> '' then appf(result, ' width="$1"', [fieldAux(s)]); s := getFieldValue(n, 'scale'); - if s <> '' then appf(result, ' scale="$1"', [toRope(s)]); + if s <> '' then appf(result, ' scale="$1"', [fieldAux(s)]); s := getFieldValue(n, 'alt'); - if s <> '' then appf(result, ' alt="$1"', [toRope(s)]); + if s <> '' then appf(result, ' alt="$1"', [fieldAux(s)]); s := getFieldValue(n, 'align'); - if s <> '' then appf(result, ' align="$1"', [toRope(s)]); + if s <> '' then appf(result, ' align="$1"', [fieldAux(s)]); app(result, ' />'); if rsonsLen(n) >= 3 then app(result, renderRstToHtml(d, n.sons[2])) end; @@ -863,15 +867,18 @@ begin 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); + if n.sons[i].kind <> nkCommentStmt then + genItem(d, n.sons[i], n.sons[i].sons[0], skVar); end; nkConstSection: begin for i := 0 to sonsLen(n)-1 do - genItem(d, n.sons[i], n.sons[i].sons[0], skConst); + if n.sons[i].kind <> nkCommentStmt then + genItem(d, n.sons[i], n.sons[i].sons[0], skConst); end; nkTypeSection: begin for i := 0 to sonsLen(n)-1 do - genItem(d, n.sons[i], n.sons[i].sons[0], skType); + if n.sons[i].kind <> nkCommentStmt then + genItem(d, n.sons[i], n.sons[i].sons[0], skType); end; nkStmtList: begin for i := 0 to sonsLen(n)-1 do generateDoc(d, n.sons[i]); diff --git a/nim/ecmasgen.pas b/nim/ecmasgen.pas index d50be9b0c..c9dfcfe25 100644 --- a/nim/ecmasgen.pas +++ b/nim/ecmasgen.pas @@ -896,7 +896,8 @@ begin or (skipGeneric(y.typ).kind in [tyRef, tyPtr, tyVar]) end; -procedure genAsgnAux(var p: TProc; x, y: PNode; var r: TCompRes); +procedure genAsgnAux(var p: TProc; x, y: PNode; var r: TCompRes; + noCopyNeeded: bool); var a, b: TCompRes; begin @@ -906,7 +907,7 @@ begin 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 + if needsNoCopy(y) or noCopyNeeded then appf(r.com, '$1 = $2;$n', [a.res, b.res]) else begin useMagic(p, 'NimCopy'); @@ -930,7 +931,13 @@ 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); + genAsgnAux(p, n.sons[0], n.sons[1], r, false); +end; + +procedure genFastAsgn(var p: TProc; n: PNode; var r: TCompRes); +begin + genLineDir(p, n, r); + genAsgnAux(p, n.sons[0], n.sons[1], r, true); end; procedure genSwap(var p: TProc; n: PNode; var r: TCompRes); @@ -1692,6 +1699,7 @@ begin nkReturnStmt: genReturnStmt(p, n, r); nkBreakStmt: genBreakStmt(p, n, r); nkAsgn: genAsgn(p, n, r); + nkFastAsgn: genFastAsgn(p, n, r); nkDiscardStmt: begin genLineDir(p, n, r); gen(p, n.sons[0], r); diff --git a/nim/evals.pas b/nim/evals.pas index bb14f8be9..f9ca85c8f 100644 --- a/nim/evals.pas +++ b/nim/evals.pas @@ -28,7 +28,7 @@ type TStackFrame = record mapping: TIdNodeTable; // mapping from symbols to nodes prc: PSym; // current prc; proc that is evaluated - call: PNode; // current for stmt + call: PNode; next: PStackFrame; // for stacking params: TNodeSeq; // parameters passed to the proc end; @@ -127,7 +127,7 @@ begin inc(i) end; if (i < len) and (sonsLen(n.sons[i]) < 2) then // eval else-part - result := evalAux(c, n.sons[0]) + result := evalAux(c, n.sons[i].sons[0]) else result := emptyNode end; @@ -1227,7 +1227,7 @@ begin nkDerefExpr, nkHiddenDeref: result := evalDeref(c, n); nkAddr, nkHiddenAddr: result := evalAddr(c, n); nkHiddenStdConv, nkHiddenSubConv, nkConv: result := evalConv(c, n); - nkAsgn: result := evalAsgn(c, n); + nkAsgn, nkFastAsgn: result := evalAsgn(c, n); nkWhenStmt, nkIfStmt, nkIfExpr: result := evalIf(c, n); nkWhileStmt: result := evalWhile(c, n); nkCaseStmt: result := evalCase(c, n); @@ -1259,7 +1259,7 @@ begin nkTemplateDef, nkConstSection, nkIteratorDef, nkConverterDef, nkIncludeStmt, nkImportStmt, nkFromStmt: begin end; nkIdentDefs, nkCast, nkYieldStmt, nkAsmStmt, nkForStmt, nkPragmaExpr, - nkQualified, nkLambda, nkContinueStmt: + nkQualified, nkLambda, nkContinueStmt, nkIdent: stackTrace(c, n, errCannotInterpretNodeX, nodeKindToStr[n.kind]); else InternalError(n.info, 'evalAux: ' + nodekindToStr[n.kind]); end; diff --git a/nim/extccomp.pas b/nim/extccomp.pas index 5bc7011c1..51cf009d1 100644 --- a/nim/extccomp.pas +++ b/nim/extccomp.pas @@ -343,17 +343,11 @@ begin result := ccNone end; - -procedure addStr(var dest: string; const src: string); -begin - dest := dest +{&} src; -end; - procedure addOpt(var dest: string; const src: string); begin if (length(dest) = 0) or (dest[length(dest)-1+strStart] <> ' ') then - addStr(dest, ' '+''); - addStr(dest, src); + add(dest, ' '+''); + add(dest, src); end; procedure addCompileOption(const option: string); @@ -473,40 +467,52 @@ begin key := cc[c].name + '.exe'; if existsConfigVar(key) then exe := getConfigVar(key); + if targetOS = osWindows then exe := appendFileExt(exe, 'exe'); if (optGenDynLib in gGlobalOptions) and (ospNeedsPIC in platform.OS[targetOS].props) then - addStr(options, ' ' + cc[c].pic); + add(options, ' ' + cc[c].pic); - if targetOS = hostOS then begin + if targetOS = platform.hostOS then begin // compute include paths: includeCmd := cc[c].includeCmd; // this is more complex than needed, but // a workaround of a FPC bug... - addStr(includeCmd, libpath); - compilePattern := quoteIfSpaceExists(JoinPath(ccompilerpath, exe)); + add(includeCmd, quoteIfContainsWhite(libpath)); + compilePattern := JoinPath(ccompilerpath, exe); end else begin includeCmd := ''; compilePattern := cc[c].compilerExe end; - if targetOS = hostOS then + if targetOS = platform.hostOS then cfile := cfilename else cfile := extractFileName(cfilename); - if not isExternal or (targetOS <> hostOS) then + if not isExternal or (targetOS <> platform.hostOS) then objfile := toObjFile(cfile) else objfile := completeCFilePath(toObjFile(cfile)); - - result := format(compilePattern +{&} ' ' +{&} cc[c].compileTmpl, - ['file', AppendFileExt(cfile, cExt), + cfile := quoteIfContainsWhite(AppendFileExt(cfile, cExt)); + objfile := quoteIfContainsWhite(objfile); + + result := quoteIfContainsWhite(format(compilePattern, + ['file', cfile, 'objfile', objfile, 'options', options, 'include', includeCmd, 'nimrod', getPrefixDir(), 'lib', libpath - ]); + ])); + add(result, ' '); + add(result, format(cc[c].compileTmpl, + ['file', cfile, + 'objfile', objfile, + 'options', options, + 'include', includeCmd, + 'nimrod', quoteIfContainsWhite(getPrefixDir()), + 'lib', quoteIfContainsWhite(libpath) + ])); end; procedure CompileCFile(const list: TLinkedList; @@ -551,11 +557,12 @@ begin // call the linker: linkerExe := getConfigVar(cc[c].name + '.linkerexe'); if length(linkerExe) = 0 then linkerExe := cc[c].linkerExe; + if targetOS = osWindows then linkerExe := appendFileExt(linkerExe, 'exe'); - if (hostOS <> targetOS) then - linkCmd := linkerExe + if (platform.hostOS <> targetOS) then + linkCmd := quoteIfContainsWhite(linkerExe) else - linkCmd := quoteIfSpaceExists(JoinPath(ccompilerpath, linkerExe)); + linkCmd := quoteIfContainsWhite(JoinPath(ccompilerpath, linkerExe)); if optGenDynLib in gGlobalOptions then buildDll := cc[c].buildDll @@ -570,27 +577,29 @@ begin exefile := platform.os[targetOS].dllPrefix else exefile := ''; - if targetOS = hostOS then - addStr(exefile, projectFile) + if targetOS = platform.hostOS then + add(exefile, projectFile) else - addStr(exefile, extractFileName(projectFile)); + add(exefile, extractFileName(projectFile)); if optGenDynLib in gGlobalOptions then - addStr(exefile, platform.os[targetOS].dllExt) + add(exefile, platform.os[targetOS].dllExt) else - addStr(exefile, platform.os[targetOS].exeExt); + add(exefile, platform.os[targetOS].exeExt); + exefile := quoteIfContainsWhite(exefile); it := PStrEntry(toLink.head); objfiles := ''; while it <> nil do begin - addStr(objfiles, ' '+''); - if targetOS = hostOS then - addStr(objfiles, toObjfile(it.data)) + add(objfiles, ' '+''); + if targetOS = platform.hostOS then + add(objfiles, quoteIfContainsWhite(toObjfile(it.data))) else - addStr(objfiles, toObjfile(extractFileName(it.data))); + add(objfiles, quoteIfContainsWhite( + toObjfile(extractFileName(it.data)))); it := PStrEntry(it.next); end; - linkCmd := format(linkCmd +{&} ' ' +{&} cc[c].linkTmpl, [ + linkCmd := quoteIfContainsWhite(format(linkCmd, [ 'builddll', builddll, 'buildgui', buildgui, 'options', linkOptions, @@ -598,7 +607,18 @@ begin 'exefile', exefile, 'nimrod', getPrefixDir(), 'lib', libpath - ]); + ])); + add(linkCmd, ' '); + add(linkCmd, format(cc[c].linkTmpl, [ + 'builddll', builddll, + 'buildgui', buildgui, + 'options', linkOptions, + 'objfiles', objfiles, + 'exefile', exefile, + 'nimrod', quoteIfContainsWhite(getPrefixDir()), + 'lib', quoteIfContainsWhite(libpath) + ])); + if not (optCompileOnly in gGlobalOptions) then execExternalProgram(linkCmd); end // end if not noLinking diff --git a/nim/hashes.pas b/nim/hashes.pas index 1bd3c7d2a..0d7eb205d 100644 --- a/nim/hashes.pas +++ b/nim/hashes.pas @@ -61,7 +61,7 @@ begin result := x -{%} 1; // 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 ((sizeof(int)-4)* 8)); result := result or (result shr 16); result := result or (result shr 8); result := result or (result shr 4); diff --git a/nim/lexbase.pas b/nim/lexbase.pas index 11200f652..2b056c04f 100644 --- a/nim/lexbase.pas +++ b/nim/lexbase.pas @@ -64,7 +64,7 @@ function getCurrentLine(const L: TBaseLexer; marker: boolean = true): string; function getColNumber(const L: TBaseLexer; pos: int): int; function HandleCR(var L: TBaseLexer; pos: int): int; -// Call this if you scanned over CR in the buffer; it returns the the +// Call this if you scanned over CR in the buffer; it returns the // position to continue the scanning from. `pos` must be the position // of the CR. @@ -211,8 +211,7 @@ end; function getColNumber(const L: TBaseLexer; pos: int): int; begin - result := pos - L.lineStart; - assert(result >= 0); + result := abs(pos - L.lineStart); end; function getCurrentLine(const L: TBaseLexer; marker: boolean = true): string; diff --git a/nim/magicsys.pas b/nim/magicsys.pas index 55ec0b002..7a717e61d 100644 --- a/nim/magicsys.pas +++ b/nim/magicsys.pas @@ -96,9 +96,10 @@ begin result := StrTableGet(compilerprocs, ident); if result = nil then begin result := StrTableGet(rodCompilerProcs, ident); - if result = nil then rawMessage(errSystemNeeds, name); - strTableAdd(compilerprocs, result); - if result.kind = skStub then loadStub(result); + if result <> nil then begin + strTableAdd(compilerprocs, result); + if result.kind = skStub then loadStub(result); + end; // A bit hacky that this code is needed here, but it is the easiest // solution in order to avoid special cases for sfCompilerProc in the // rodgen module. Another solution would be to always recompile the system diff --git a/nim/msgs.pas b/nim/msgs.pas index d65a5a1e4..a91c328ef 100644 --- a/nim/msgs.pas +++ b/nim/msgs.pas @@ -173,7 +173,7 @@ type errSelectorMustBeOrdinal, errOrdXMustNotBeNegative, errLenXinvalid, - errWrongNumberOfLoopVariables, + errWrongNumberOfVariables, errExprCannotBeRaised, errBreakOnlyInLoop, errTypeXhasUnknownSize, @@ -431,7 +431,7 @@ const 'selector must be of an ordinal type', 'ord($1) must not be negative', 'len($1) must be less than 32768', - 'wrong number of loop variables', + 'wrong number of variables', 'only objects can be raised', '''break'' only allowed in loop construct', 'type ''$1'' has unknown size', diff --git a/nim/nimrod.pas b/nim/nimrod.pas index d197a3448..99d9a9d0f 100644 --- a/nim/nimrod.pas +++ b/nim/nimrod.pas @@ -93,7 +93,8 @@ begin } end; if optRun in gGlobalOptions then - execExternalProgram(changeFileExt(filename, '') +{&} ' ' +{&} arguments) + execExternalProgram(quoteIfContainsWhite(changeFileExt(filename, '')) +{&} + ' ' +{&} arguments) end end; diff --git a/nim/nos.pas b/nim/nos.pas index 002803b53..73b17ae58 100644 --- a/nim/nos.pas +++ b/nim/nos.pas @@ -35,9 +35,11 @@ const {$ifdef mswindows} dirsep = '\'; // seperator within paths altsep = '/'; + exeExt = 'exe'; {$else} dirsep = '/'; altsep = #0; // work around fpc bug + exeExt = ''; {$endif} pathSep = ';'; // seperator between paths sep = dirsep; // alternative name diff --git a/nim/nsystem.pas b/nim/nsystem.pas index c33236189..f476e09ca 100644 --- a/nim/nsystem.pas +++ b/nim/nsystem.pas @@ -149,8 +149,12 @@ function subU(a, b: biggestInt): biggestInt; function mulU(a, b: biggestInt): biggestInt; function divU(a, b: biggestInt): biggestInt; function modU(a, b: biggestInt): biggestInt; -function shlU(a, b: biggestInt): biggestInt; -function shrU(a, b: biggestInt): biggestInt; +function shlU(a, b: biggestInt): biggestInt; overload; +function shrU(a, b: biggestInt): biggestInt; overload; + +function shlU(a, b: Int32): Int32;overload; +function shrU(a, b: int32): int32;overload; + function ltU(a, b: biggestInt): bool; function leU(a, b: biggestInt): bool; @@ -281,6 +285,16 @@ begin result := biggestInt(biggestUInt(a) shr biggestUInt(b)); end; +function shlU(a, b: Int32): Int32; +begin + result := Int32(UInt32(a) shl UInt32(b)); +end; + +function shrU(a, b: int32): int32; +begin + result := Int32(UInt32(a) shr UInt32(b)); +end; + function ltU(a, b: biggestInt): bool; begin result := biggestUInt(a) < biggestUInt(b); diff --git a/nim/nversion.pas b/nim/nversion.pas index 9629079b2..7d179bb35 100644 --- a/nim/nversion.pas +++ b/nim/nversion.pas @@ -31,10 +31,10 @@ const //cog.outl('VersionMinor = %s;' % ver[1]) //cog.outl('VersionPatch = %s;' % ver[2]) //]]] - VersionAsString = '0.7.2'; + VersionAsString = '0.7.4'; VersionMajor = 0; VersionMinor = 7; - VersionPatch = 2; + VersionPatch = 4; //[[[[end]]]] implementation diff --git a/nim/optast.pas b/nim/optast.pas deleted file mode 100644 index 9f66a53db..000000000 --- a/nim/optast.pas +++ /dev/null @@ -1,34 +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 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 9a9eaae36..5bbfbbbee 100644 --- a/nim/options.pas +++ b/nim/options.pas @@ -201,6 +201,12 @@ begin if startsWith(dir, prefix) then begin result := ncopy(dir, length(prefix) + strStart); exit end; + prefix := projectPath +{&} dirSep; + //writeln(output, prefix); + //writeln(output, dir); + if startsWith(dir, prefix) then begin + result := ncopy(dir, length(prefix) + strStart); exit + end; result := dir end; @@ -209,7 +215,7 @@ var head, tail: string; begin splitPath(path, head, tail); - result := joinPath([projectPath, genSubDir, shortenDir(head), + result := joinPath([projectPath, genSubDir, shortenDir(head +{&} dirSep), changeFileExt(tail, ext)]) end; @@ -219,9 +225,11 @@ var head, tail, subdir: string; begin splitPath(f, head, tail); - subdir := joinPath([projectPath, genSubDir, shortenDir(head)]); - if createSubDir then + subdir := joinPath([projectPath, genSubDir, shortenDir(head +{&} dirSep)]); + if createSubDir then begin + //Writeln(output, subdir); createDir(subdir); + end; result := joinPath(subdir, tail) end; diff --git a/nim/parseopt.pas b/nim/parseopt.pas index d543b998e..0ca87bd37 100644 --- a/nim/parseopt.pas +++ b/nim/parseopt.pas @@ -51,7 +51,7 @@ begin else begin result.cmd := ''; for i := 1 to ParamCount() do - result.cmd := result.cmd +{&} quoteIfSpaceExists(paramStr(i)) +{&} ' '; + result.cmd := result.cmd +{&} quoteIfContainsWhite(paramStr(i)) +{&} ' '; {@ignore} result.cmd := result.cmd + #0; {@emit} diff --git a/nim/passaux.pas b/nim/passaux.pas index 6344efb0b..8b052257f 100644 --- a/nim/passaux.pas +++ b/nim/passaux.pas @@ -14,7 +14,7 @@ unit passaux; interface uses - nsystem, strutils, ast, passes, msgs, options; + nsystem, strutils, ast, astalgo, passes, msgs, options; function verbosePass: TPass; function cleanupPass: TPass; @@ -50,6 +50,8 @@ var s: PSym; begin result := n; + // we cannot clean up if dead code elimination is activated + if (optDeadCodeElim in gGlobalOptions) then exit; case n.kind of nkStmtList: begin for i := 0 to sonsLen(n)-1 do {@discard} cleanup(c, n.sons[i]); @@ -57,7 +59,8 @@ begin nkProcDef: begin if (n.sons[namePos].kind = nkSym) then begin s := n.sons[namePos].sym; - if not astNeeded(s) then s.ast.sons[codePos] := nil; // free the memory + if not (sfDeadCodeElim in getModule(s).flags) and + not astNeeded(s) then s.ast.sons[codePos] := nil; // free the memory end end else begin end; diff --git a/nim/platform.pas b/nim/platform.pas index 1c021db86..8bf4f3d9b 100644 --- a/nim/platform.pas +++ b/nim/platform.pas @@ -23,7 +23,7 @@ uses type TSystemOS = ( - // Also add OS for in initialization section and alias conditionals to + // Also add OS in initialization section and alias conditionals to // condsyms (end of module). osNone, osDos, @@ -264,8 +264,8 @@ const curDir: '.'+''; exeExt: ''; extSep: '.'+''; - props: {@set}[ospNeedsPIC, ospPosix]; - ), + props: {@set}[ospNeedsPIC, ospPosix]; + ), ( name: 'PalmOS'; parDir: '..'; diff --git a/nim/pnimsyn.pas b/nim/pnimsyn.pas index 2cb34e708..95d6e64f9 100644 --- a/nim/pnimsyn.pas +++ b/nim/pnimsyn.pas @@ -9,7 +9,7 @@ unit pnimsyn; // This module implements the parser of the standard Nimrod representation. -// The parser is strictly reflects the grammar ("doc/grammar.txt"); however +// The parser strictly reflects the grammar ("doc/grammar.txt"); however // it uses several helper routines to keep the parser small. A special // efficient algorithm is used for the precedence levels. The parser here can // be seen as a refinement of the grammar, as it specifies how the AST is build @@ -98,15 +98,21 @@ end; // ---------------- parser helpers -------------------------------------------- +procedure parMessage(const p: TParser; const msg: TMsgKind; + const arg: string = ''); +begin + lexMessage(p.lex^, msg, arg); +end; + procedure skipComment(var p: TParser; node: PNode); begin if p.tok.tokType = tkComment then begin if node <> nil then begin if node.comment = snil then node.comment := ''; - node.comment := node.comment +{&} p.tok.literal; + add(node.comment, p.tok.literal); end else - assert(false); + parMessage(p, errInternal, 'skipComment'); getTok(p); end end; @@ -116,6 +122,11 @@ begin if p.tok.tokType = tkInd then getTok(p) end; +procedure optSad(var p: TParser); +begin + if p.tok.tokType = tkSad then getTok(p) +end; + procedure optInd(var p: TParser; n: PNode); begin skipComment(p, n); @@ -146,12 +157,6 @@ begin else lexMessage(p.lex^, errTokenExpected, TokTypeToStr[tokType]) end; -procedure parMessage(const p: TParser; const msg: TMsgKind; - const arg: string = ''); -begin - lexMessage(p.lex^, msg, arg); -end; - function parLineInfo(const p: TParser): TLineInfo; begin result := getLineInfo(p.lex^) @@ -385,7 +390,7 @@ begin result := newNodeP(nkExprEqExpr, p); addSon(result, a); getTok(p); - optInd(p, result); + //optInd(p, result); case p.tok.tokType of tkVar, tkRef, tkPtr, tkProc: addSon(result, parseTypeDescK(p)); @@ -413,21 +418,16 @@ begin addSon(result, first); getTok(p); optInd(p, result); - while true do begin - if p.tok.tokType = tkBracketRi then begin - getTok(p); break - end; - if p.tok.tokType = tkEof then begin - parMessage(p, errTokenExpected, TokTypeToStr[tkBracketRi]); break - end; + while (p.tok.tokType <> tkBracketRi) and (p.tok.tokType <> tkEof) + and (p.tok.tokType <> tkSad) do begin a := namedTypeOrExpr(p); - optInd(p, a); - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; + optSad(p); + eat(p, tkBracketRi); end; function exprColonEqExpr(var p: TParser; kind: TNodeKind; @@ -439,7 +439,7 @@ begin if p.tok.tokType = tok then begin result := newNodeP(kind, p); getTok(p); - optInd(p, result); + //optInd(p, result); addSon(result, a); addSon(result, parseExpr(p)); end @@ -454,21 +454,14 @@ var begin getTok(p); optInd(p, result); - while true do begin - if p.tok.tokType = endTok then begin - getTok(p); break - end; - if p.tok.tokType = tkEof then begin - parMessage(p, errTokenExpected, TokTypeToStr[endtok]); break - end; + while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) do begin a := exprColonEqExpr(p, elemKind, sepTok); - optInd(p, a); - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; + eat(p, endTok); end; function qualifiedIdent(var p: TParser): PNode; @@ -476,7 +469,7 @@ var a: PNode; begin result := parseSymbol(p); - optInd(p, result); + //optInd(p, result); if p.tok.tokType = tkDot then begin getTok(p); optInd(p, result); @@ -494,28 +487,41 @@ var begin getTok(p); optInd(p, result); - while true do begin - if p.tok.tokType = endTok then begin - getTok(p); break - end; - if p.tok.tokType = tkEof then begin - parMessage(p, errTokenExpected, TokTypeToStr[endtok]); break - end; + while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) do begin a := qualifiedIdent(p); - optInd(p, a); - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; addSon(result, a); + //optInd(p, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) + end; + eat(p, endTok); +end; + +procedure exprColonEqExprListAux(var p: TParser; elemKind: TNodeKind; + endTok, sepTok: TTokType; result: PNode); +var + a: PNode; +begin + getTok(p); + optInd(p, result); + while (p.tok.tokType <> endTok) and (p.tok.tokType <> tkEof) + and (p.tok.tokType <> tkSad) do begin + a := exprColonEqExpr(p, elemKind, sepTok); + addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; + optSad(p); + eat(p, endTok); end; function exprColonEqExprList(var p: TParser; kind, elemKind: TNodeKind; endTok, sepTok: TTokType): PNode; begin result := newNodeP(kind, p); - exprListAux(p, elemKind, endTok, sepTok, result); + exprColonEqExprListAux(p, elemKind, endTok, sepTok, result); end; function parseCast(var p: TParser): PNode; @@ -525,12 +531,12 @@ begin eat(p, tkBracketLe); optInd(p, result); addSon(result, parseTypeDesc(p)); - optInd(p, result); + optSad(p); eat(p, tkBracketRi); eat(p, tkParLe); optInd(p, result); addSon(result, parseExpr(p)); - optInd(p, result); + optSad(p); eat(p, tkParRi); end; @@ -541,7 +547,7 @@ begin eat(p, tkParLe); optInd(p, result); addSon(result, parseExpr(p)); - optInd(p, result); + optSad(p); eat(p, tkParRi); end; @@ -667,7 +673,7 @@ begin a := result; result := newNodeP(nkCall, p); addSon(result, a); - exprListAux(p, nkExprEqExpr, tkParRi, tkEquals, result); + exprColonEqExprListAux(p, nkExprEqExpr, tkParRi, tkEquals, result); end; tkDot: begin a := result; @@ -709,8 +715,9 @@ begin opNode := newIdentNodeP(op.ident, p); // skip operator: getTok(p); - skipComment(p, opNode); - skipInd(p); + //skipComment(p, opNode); + //skipInd(p); + optInd(p, opNode); // read sub-expression with higher priority nextop := lowestExprAux(p, v2, opPred); @@ -739,12 +746,12 @@ begin while true do begin getTok(p); // skip `if`, `elif` branch := newNodeP(nkElifExpr, p); - optInd(p, branch); + //optInd(p, branch); addSon(branch, parseExpr(p)); eat(p, tkColon); - optInd(p, branch); + //optInd(p, branch); addSon(branch, parseExpr(p)); - optInd(p, branch); + //optInd(p, branch); addSon(result, branch); if p.tok.tokType <> tkElif then break end; @@ -770,31 +777,33 @@ var begin result := newNodeP(nkPragma, p); getTok(p); - while true do begin - skipComment(p, result); - skipInd(p); - case p.tok.TokType of - tkCurlyDotRi, tkCurlyRi: begin - getTok(p); // skip } or .} - break - end; - tkEof: begin - parMessage(p, errTokenExpected, '.}'); - break - end - else begin - a := exprColonEqExpr(p, nkExprColonExpr, tkColon); - addSon(result, a); - if p.tok.tokType = tkComma then begin - getTok(p); - skipComment(p, a) - end - end + optInd(p, result); + while (p.tok.tokType <> tkCurlyDotRi) and (p.tok.tokType <> tkCurlyRi) + and (p.tok.tokType <> tkEof) and (p.tok.tokType <> tkSad) do begin + a := exprColonEqExpr(p, nkExprColonExpr, tkColon); + addSon(result, a); + if p.tok.tokType = tkComma then begin + getTok(p); + optInd(p, a) end - end + end; + optSad(p); + if (p.tok.tokType = tkCurlyDotRi) or (p.tok.tokType = tkCurlyRi) then + getTok(p) + else + parMessage(p, errTokenExpected, '.}'); end; // ---------------------- statement parser ------------------------------------ +function isExprStart(const p: TParser): bool; +begin + case p.tok.tokType of + tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkLambda, + tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit: result := true; + else result := false; + end; +end; + function parseExprStmt(var p: TParser): PNode; var a, b, e: PNode; @@ -813,16 +822,16 @@ begin result.info := a.info; addSon(result, a); while true do begin - case p.tok.tokType of + (*case p.tok.tokType of tkColon, tkInd, tkSad, tkDed, tkEof, tkComment: break; else begin end - end; + end;*) + if not isExprStart(p) then break; e := parseExpr(p); - if p.tok.tokType = tkComma then begin - getTok(p); - skipComment(p, e) - end; addSon(result, e); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a); end; if sonsLen(result) <= 1 then result := a else a := result; @@ -897,7 +906,7 @@ begin break end; end; - optInd(p, a); + //optInd(p, a); if p.tok.tokType = tkAs then begin getTok(p); optInd(p, a); @@ -906,11 +915,10 @@ begin addSon(a, b); addSon(a, parseSymbol(p)); end; - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; end; @@ -942,12 +950,11 @@ begin break end; end; - optInd(p, a); - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; addSon(result, a); + //optInd(p, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; end; @@ -977,7 +984,7 @@ begin end end; addSon(result, a); - optInd(p, a); + //optInd(p, a); eat(p, tkImport); optInd(p, result); while true do begin @@ -989,12 +996,11 @@ begin break end; end; - optInd(p, a); - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; + //optInd(p, a); addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; end; @@ -1074,6 +1080,7 @@ begin result := newNodeP(nkCaseStmt, p); getTok(p); addSon(result, parseExpr(p)); + if p.tok.tokType = tkColon then getTok(p); skipComment(p, result); inElif := false; while true do begin @@ -1145,22 +1152,15 @@ begin result := newNodeP(nkForStmt, p); getTok(p); optInd(p, result); - while true do begin - if p.tok.tokType = tkIn then begin - getTok(p); break - end; - if p.tok.tokType = tkEof then begin - parMessage(p, errTokenExpected, TokTypeToStr[tkIn]); break - end; - - a := parseSymbol(p); - if a = nil then break; + a := parseSymbol(p); + addSon(result, a); + while p.tok.tokType = tkComma do begin + getTok(p); optInd(p, a); - if p.tok.tokType = tkComma then begin - getTok(p); optInd(p, a) - end; - addSon(result, a); + a := parseSymbol(p); + addSon(result, a); end; + eat(p, tkIn); addSon(result, exprColonEqExpr(p, nkRange, tkDotDot)); eat(p, tkColon); skipComment(p, result); @@ -1246,12 +1246,11 @@ begin if a = nil then exit; end end; - optInd(p, a); - if p.tok.tokType = tkComma then begin - getTok(p); - optInd(p, a) - end; addSon(result, a); + //optInd(p, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; if p.tok.tokType = tkColon then begin getTok(p); optInd(p, result); @@ -1282,15 +1281,17 @@ begin while true do begin case p.tok.tokType of tkSymbol, tkAccent: a := parseIdentColonEquals(p, false); - tkParRi: begin getTok(p); break end; + tkParRi: break; else begin parMessage(p, errTokenExpected, ')'+''); break; end; end; - optInd(p, a); - if p.tok.tokType = tkComma then begin - getTok(p); optInd(p, a) - end; + //optInd(p, a); addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; + optSad(p); + eat(p, tkParRi); end; if p.tok.tokType = tkColon then begin getTok(p); @@ -1336,18 +1337,15 @@ begin 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); + while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin + a := parseIdentColonEquals(p, false); + addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; + optSad(p); + eat(p, tkBracketRi); end; else begin InternalError(parLineInfo(p), 'pnimsyn.parseTypeDescK'); @@ -1389,18 +1387,15 @@ begin result := newNodeP(nkGenericParams, p); getTok(p); optInd(p, result); - while true do begin - case p.tok.tokType of - tkSymbol, tkAccent: a := parseGenericParam(p); - 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; + while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin + a := parseGenericParam(p); addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) end; + optSad(p); + eat(p, tkBracketRi); end; function parseRoutine(var p: TParser; kind: TNodeKind): PNode; @@ -1484,7 +1479,8 @@ begin break end end - end + end; + popInd(p.lex^); end; tkSymbol, tkAccent: addSon(result, defparser(p)); else parMessage(p, errIdentifierExpected, tokToStr(p.tok)); @@ -1628,7 +1624,8 @@ begin break end end - end + end; + popInd(p.lex^); end; tkWhen: result := parseRecordWhen(p); tkCase: result := parseRecordCase(p); @@ -1688,9 +1685,34 @@ begin indAndComment(p, result); // special extension! end; +function parseVarTuple(var p: TParser): PNode; +var + a: PNode; +begin + result := newNodeP(nkVarTuple, p); + getTok(p); // skip '(' + optInd(p, result); + while (p.tok.tokType = tkSymbol) or (p.tok.tokType = tkAccent) do begin + a := identWithPragma(p); + addSon(result, a); + if p.tok.tokType <> tkComma then break; + getTok(p); + optInd(p, a) + end; + addSon(result, nil); // no type desc + optSad(p); + eat(p, tkParRi); + eat(p, tkEquals); + optInd(p, result); + addSon(result, parseExpr(p)); +end; + function parseVariable(var p: TParser): PNode; begin - result := parseIdentColonEquals(p, true); + if p.tok.tokType = tkParLe then + result := parseVarTuple(p) + else + result := parseIdentColonEquals(p, true); indAndComment(p, result); // special extension! end; @@ -1708,10 +1730,15 @@ begin tkFrom: result := parseFromStmt(p); tkInclude: result := parseIncludeStmt(p); tkComment: result := newCommentStmt(p); - //tkSad, tkInd, tkDed: assert(false); - else result := parseExprStmt(p) + else begin + if isExprStart(p) then + result := parseExprStmt(p) + else + result := nil; + end end; - skipComment(p, result); + if result <> nil then + skipComment(p, result); end; function complexOrSimpleStmt(var p: TParser): PNode; @@ -1738,6 +1765,8 @@ begin end; function parseStmt(var p: TParser): PNode; +var + a: PNode; begin if p.tok.tokType = tkInd then begin result := newNodeP(nkStmtList, p); @@ -1748,9 +1777,14 @@ begin tkSad: getTok(p); tkEof: break; tkDed: begin getTok(p); break end; - else addSon(result, complexOrSimpleStmt(p)); - end; - end + else begin + a := complexOrSimpleStmt(p); + if a = nil then break; + addSon(result, a); + end + end + end; + popInd(p.lex^); end else begin // the case statement is only needed for better error messages: @@ -1762,7 +1796,7 @@ begin end else begin result := simpleStmt(p); - skipComment(p, result); + if result = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); if p.tok.tokType = tkSad then getTok(p); end end @@ -1770,6 +1804,8 @@ begin end; function parseModule(var p: TParser): PNode; +var + a: PNode; begin result := newNodeP(nkStmtList, p); while true do begin @@ -1777,7 +1813,11 @@ begin tkSad: getTok(p); tkDed, tkInd: parMessage(p, errInvalidIndentation); tkEof: break; - else addSon(result, complexOrSimpleStmt(p)); + else begin + a := complexOrSimpleStmt(p); + if a = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); + addSon(result, a); + end end end end; @@ -1795,6 +1835,7 @@ begin tkEof: break; else begin result := complexOrSimpleStmt(p); + if result = nil then parMessage(p, errExprExpected, tokToStr(p.tok)); break end end diff --git a/nim/pragmas.pas b/nim/pragmas.pas index 68bc366f1..636a1198a 100644 --- a/nim/pragmas.pas +++ b/nim/pragmas.pas @@ -135,8 +135,8 @@ var v: string; m: TMagic; begin - if not (sfSystemModule in c.module.flags) then - liMessage(n.info, errMagicOnlyInSystem); + //if not (sfSystemModule in c.module.flags) then + // liMessage(n.info, errMagicOnlyInSystem); if n.kind <> nkExprColonExpr then liMessage(n.info, errStringLiteralExpected); if n.sons[1].kind = nkIdent then v := n.sons[1].ident.s @@ -172,6 +172,19 @@ begin liMessage(n.info, errOnOrOffExpected) end; +procedure pragmaDeadCodeElim(c: PContext; n: PNode); +begin + if (n.kind = nkExprColonExpr) and (n.sons[1].kind = nkIdent) then begin + case whichKeyword(n.sons[1].ident) of + wOn: include(c.module.flags, sfDeadCodeElim); + wOff: exclude(c.module.flags, sfDeadCodeElim); + else liMessage(n.info, errOnOrOffExpected) + end + end + else + liMessage(n.info, errOnOrOffExpected) +end; + procedure processCallConv(c: PContext; n: PNode); var sw: TSpecialWord; @@ -466,6 +479,7 @@ begin wVolatile: begin noVal(it); Include(sym.flags, sfVolatile); end; wRegister: begin noVal(it); include(sym.flags, sfRegister); end; wThreadVar: begin noVal(it); include(sym.flags, sfThreadVar); end; + wDeadCodeElim: pragmaDeadCodeElim(c, it); wMagic: processMagic(c, it, sym); wCompileTime: begin noVal(it); @@ -612,7 +626,7 @@ begin wHint, wWarning, wError, wFatal, wDefine, wUndef, wCompile, wLink, wLinkSys, wPure, wPush, wPop, wFixupSystem, wBreakpoint, wCheckpoint, - wPassL, wPassC]); + wPassL, wPassC, wDeadCodeElim]); end; procedure pragmaLambda(c: PContext; s: PSym; n: PNode); diff --git a/nim/rnimsyn.pas b/nim/rnimsyn.pas index 6b8e3b3cb..6cb78efcf 100644 --- a/nim/rnimsyn.pas +++ b/nim/rnimsyn.pas @@ -21,7 +21,7 @@ uses type TRenderFlag = (renderNone, renderNoBody, renderNoComments, - renderNoPragmas, renderIds); + renderDocComments, renderNoPragmas, renderIds); TRenderFlags = set of TRenderFlag; TRenderTok = record @@ -354,12 +354,20 @@ end; const Space = ' '+''; +function shouldRenderComment(var g: TSrcGen; n: PNode): bool; +begin + result := false; + if n.comment <> snil then + result := not (renderNoComments in g.flags) or + (renderDocComments in g.flags) and startsWith(n.comment, '##'); +end; + procedure gcom(var g: TSrcGen; n: PNode); var ml: int; begin assert(n <> nil); - if (n.comment <> snil) and not (renderNoComments in g.flags) then begin + if shouldRenderComment(g, n) then begin if (g.pendingNL < 0) and (length(g.buf) > 0) and (g.buf[length(g.buf)] <> ' ') then put(g, tkSpaces, Space); @@ -488,7 +496,7 @@ begin 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; + nkExprEqExpr, nkDefaultTypeParam, nkAsgn, nkFastAsgn: result := lsons(n)+3; nkPar, nkCurly, nkBracket: result := lcomma(n)+2; nkTupleTy: result := lcomma(n)+length('tuple[]'); nkQualified, nkDotExpr: result := lsons(n)+1; @@ -502,11 +510,12 @@ begin if n.sons[L-1] <> nil then result := result + lsub(n.sons[L-1]) + 3; end; + nkVarTuple: result := lcomma(n, 0, -3) + length('() = ') + lsub(lastSon(n)); nkChckRangeF: result := length('chckRangeF') + 2 + lcomma(n); nkChckRange64: result := length('chckRange64') + 2 + lcomma(n); nkChckRange: result := length('chckRange') + 2 + lcomma(n); - - nkObjDownConv, nkObjUpConv, + + nkObjDownConv, nkObjUpConv, nkStringToCString, nkCStringToString, nkPassAsOpenArray: begin result := 2; if sonsLen(n) >= 1 then @@ -981,7 +990,7 @@ begin put(g, tkSpaces, space); gcomma(g, n, 1); end; - nkExprEqExpr, nkDefaultTypeParam, nkAsgn: begin + nkExprEqExpr, nkDefaultTypeParam, nkAsgn, nkFastAsgn: begin gsub(g, n.sons[0]); put(g, tkSpaces, Space); putWithSpace(g, tkEquals, '='+''); @@ -997,7 +1006,7 @@ begin put(g, tkSymbol, 'chckRange64'); put(g, tkParLe, '('+''); gcomma(g, n); - put(g, tkParRi, ')'+''); + put(g, tkParRi, ')'+''); end; nkChckRange: begin put(g, tkSymbol, 'chckRange'); @@ -1005,13 +1014,13 @@ begin gcomma(g, n); put(g, tkParRi, ')'+''); end; - nkObjDownConv, nkObjUpConv, + 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, ')'+''); + put(g, tkParRi, ')'+''); end; nkPar: begin put(g, tkParLe, '('+''); @@ -1056,6 +1065,14 @@ begin gsub(g, n.sons[L-1], c) end; end; + nkVarTuple: begin + put(g, tkParLe, '('+''); + gcomma(g, n, 0, -3); + put(g, tkParRi, ')'+''); + put(g, tkSpaces, Space); + putWithSpace(g, tkEquals, '='+''); + gsub(g, lastSon(n), c); + end; nkExprColonExpr: begin gsub(g, n.sons[0]); putWithSpace(g, tkColon, ':'+''); @@ -1362,11 +1379,11 @@ begin nkTupleTy: begin put(g, tkTuple, 'tuple'); put(g, tkBracketLe, '['+''); - assert(n.sons[0].kind = nkIdentDefs); gcomma(g, n); put(g, tkBracketRi, ']'+''); end; else begin + //nkNone, nkMetaNode, nkTableConstr, nkExplicitTypeListCall: begin InternalError(n.info, 'rnimsyn.gsub(' +{&} nodeKindToStr[n.kind] +{&} ')') end end diff --git a/nim/rodwrite.pas b/nim/rodwrite.pas index 64f3d6733..637f69ff7 100644 --- a/nim/rodwrite.pas +++ b/nim/rodwrite.pas @@ -503,7 +503,7 @@ end; function process(c: PPassContext; n: PNode): PNode; var - i, j: int; + i: int; w: PRodWriter; a: PNode; s: PSym; diff --git a/nim/ropes.pas b/nim/ropes.pas index e82f1e96d..a6ba2a11b 100644 --- a/nim/ropes.pas +++ b/nim/ropes.pas @@ -14,7 +14,7 @@ unit ropes; efficiently; especially concatenation is done in O(1) instead of O(N). Ropes make use a lazy evaluation: They are essentially concatenation trees that are only flattened when converting to a native Nimrod - string or when written to disk. The empty string is represented with a + string or when written to disk. The empty string is represented by a nil pointer. A little picture makes everything clear: @@ -541,7 +541,6 @@ begin if (r.data <> snil) then begin if r.len > bufSize then // A token bigger than 1 KB? - This cannot happen in reality. - // Well, at least I hope so. 1 KB did happen! internalError('ropes: token too long'); readBytes := readBuffer(bin, buf, r.len); result := (readBytes = r.len) // BUGFIX diff --git a/nim/rst.pas b/nim/rst.pas index cc92e41eb..55c2c933a 100644 --- a/nim/rst.pas +++ b/nim/rst.pas @@ -494,7 +494,13 @@ begin if n.kind = rnLeaf then begin for i := strStart to length(n.text)+strStart-1 do begin case n.text[i] of - 'a'..'z', '0'..'9': begin + '0'..'9': begin + if b then begin addChar(r, '-'); b := false; end; + // BUGFIX: HTML id's cannot start with a digit + if length(r) = 0 then addChar(r, 'Z'); + addChar(r, n.text[i]) + end; + 'a'..'z': begin if b then begin addChar(r, '-'); b := false; end; addChar(r, n.text[i]) end; @@ -1235,7 +1241,7 @@ begin result := nil; if (p.tok[p.idx].kind = tkIndent) and (p.tok[p.idx+1].symbol = ':'+'') then begin - col := p.tok[p.idx].col; + col := p.tok[p.idx].ival; // BUGFIX! result := newRstNode(rnFieldList); inc(p.idx); while true do begin @@ -1252,10 +1258,10 @@ var i: int; f: PRstNode; begin - assert(n.kind = rnDirective); result := ''; if n.sons[1] = nil then exit; - assert(n.sons[1].kind = rnFieldList); + if (n.sons[1].kind <> rnFieldList) then + InternalError('getFieldValue (2): ' + rstnodeKindToStr[n.sons[1].kind]); for i := 0 to rsonsLen(n.sons[1])-1 do begin f := n.sons[1].sons[i]; if cmpIgnoreStyle(addNodes(f.sons[0]), fieldname) = 0 then begin diff --git a/nim/scanner.pas b/nim/scanner.pas index 83f5c12b0..a78f9c6ce 100644 --- a/nim/scanner.pas +++ b/nim/scanner.pas @@ -21,9 +21,8 @@ interface {$include 'config.inc'} uses - charsets, nsystem, sysutils, - hashes, options, msgs, strutils, platform, idents, - lexbase, llstream, wordrecg; + charsets, nsystem, sysutils, hashes, options, msgs, strutils, platform, + idents, lexbase, llstream, wordrecg; const MaxLineLength = 80; // lines longer than this lead to a warning @@ -31,7 +30,7 @@ const numChars: TCharSet = ['0'..'9','a'..'z','A'..'Z']; SymChars: TCharSet = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255]; SymStartChars: TCharSet = ['a'..'z', 'A'..'Z', #128..#255]; - OpChars: TCharSet = ['+', '-', '*', '/', '<', '>', '!', '?', '^', '.', + OpChars: TCharSet = ['+', '-', '*', '/', '\', '<', '>', '!', '?', '^', '.', '|', '=', '%', '&', '$', '@', '~', #128..#255]; type @@ -162,6 +161,8 @@ var gLinesCompiled: int; // all lines that have been compiled procedure pushInd(var L: TLexer; indent: int); +procedure popInd(var L: TLexer); + function isKeyword(kind: TTokType): boolean; procedure openLexer(out lex: TLexer; const filename: string; @@ -206,6 +207,14 @@ begin //writeln('push indent ', indent); end; +procedure popInd(var L: TLexer); +var + len: int; +begin + len := length(L.indentStack); + setLength(L.indentStack, len-1); +end; + function findIdent(const L: TLexer; indent: int): boolean; var i: int; @@ -809,13 +818,11 @@ begin end; dec(L.dedent); tok.tokType := tkDed; - if i >= 0 then - setLength(L.indentStack, i+1) // pop indentations - else begin + if i < 0 then begin tok.tokType := tkSad; // for the parser it is better as SAD lexMessage(L, errInvalidIndentation); end - end; + end end; procedure scanComment(var L: TLexer; var tok: TToken); diff --git a/nim/sem.pas b/nim/sem.pas index 59bf29be5..6d97da3e8 100644 --- a/nim/sem.pas +++ b/nim/sem.pas @@ -83,9 +83,32 @@ begin result := nil; exit end; result := getConstExpr(c.module, e); + if result = nil then + liMessage(n.info, errConstExprExpected); +end; + +function semAndEvalConstExpr(c: PContext; n: PNode): PNode; +var + e: PNode; + p: PEvalContext; + s: PStackFrame; +begin + e := semExprWithType(c, n); + if e = nil then begin + liMessage(n.info, errConstExprExpected); + result := nil; exit + end; + result := getConstExpr(c.module, e); if result = nil then begin //writeln(output, renderTree(n)); - liMessage(n.info, errConstExprExpected); + p := newEvalContext(c.module, ''); + s := newStackFrame(); + s.call := e; + pushStackFrame(p, s); + result := eval(p, e); + popStackFrame(p); + if (result = nil) or (result.kind = nkEmpty) then + liMessage(n.info, errConstExprExpected); end end; diff --git a/nim/semdata.pas b/nim/semdata.pas index f920fae2a..9ffd41eac 100644 --- a/nim/semdata.pas +++ b/nim/semdata.pas @@ -43,6 +43,7 @@ type PContext = ^TContext; TContext = object(TPassContext) // a context represents a module module: PSym; // the module sym belonging to the context + filename: string; // the module's filename tab: TSymTab; // each module has its own symbol table AmbigiousSymbols: TIntSet; // contains ids of all ambigious symbols (cannot // store this info in the syms themselves!) @@ -160,6 +161,7 @@ begin result.module := module; result.generics := newNode(nkStmtList); {@emit result.converters := @[];} + result.filename := nimfile; end; procedure addConverter(c: PContext; conv: PSym); diff --git a/nim/semexprs.pas b/nim/semexprs.pas index 2c5672f7f..3e95e3457 100644 --- a/nim/semexprs.pas +++ b/nim/semexprs.pas @@ -36,9 +36,9 @@ var diff: int; begin diff := inheritanceDiff(castDest, src); - if diff = 0 then - liMessage(info, hintConvToBaseNotNeeded) - else if diff = high(int) then + //if diff = 0 then + // liMessage(info, hintConvToBaseNotNeeded) + if diff = high(int) then liMessage(info, errGenerated, format(MsgKindToString(errIllegalConvFromXtoY), [typeToString(src), typeToString(castDest)])); @@ -466,11 +466,11 @@ begin if m.state <> csMatch then begin msg := msgKindToString(errTypeMismatch); for i := 1 to sonsLen(n)-1 do begin - msg := msg +{&} typeToString(n.sons[i].typ); - if i <> sonsLen(n)-1 then msg := msg + ', '; + add(msg, typeToString(n.sons[i].typ)); + if i <> sonsLen(n)-1 then add(msg, ', '); end; - msg := msg +{&} ')' +{&} nl +{&} msgKindToString(errButExpected) +{&} - nl +{&} typeToString(n.sons[0].typ); + add(msg, ')' +{&} nl +{&} msgKindToString(errButExpected) +{&} + nl +{&} typeToString(n.sons[0].typ)); liMessage(n.Info, errGenerated, msg); result := nil end @@ -1117,7 +1117,7 @@ begin if s <> nil then result := semSym(c, n, s, flags) else - // test! + // this is a test comment; please don't touch it result := semFieldAccess(c, n, flags); end; diff --git a/nim/semfold.pas b/nim/semfold.pas index fa2e97635..422ddbd01 100644 --- a/nim/semfold.pas +++ b/nim/semfold.pas @@ -94,6 +94,25 @@ begin end end; +function enumValToString(a: PNode): string; +var + n: PNode; + field: PSym; + x: biggestInt; + i: int; +begin + x := getInt(a); + n := a.typ.n; + for i := 0 to sonsLen(n)-1 do begin + if n.sons[i].kind <> nkSym then InternalError(a.info, 'enumValToString'); + field := n.sons[i].sym; + if field.position = x then begin + result := field.name.s; exit + end; + end; + InternalError(a.info, 'no symbol for ordinal value: ' + toString(x)); +end; + function evalOp(m: TMagic; n, a, b: PNode): PNode; // if this is an unary operation, b is nil begin @@ -246,11 +265,18 @@ begin // available for interpretation. I don't know how to fix this. //result := newStrNodeT(renderTree(a, {@set}[renderNoComments]), n); end; - mIntToStr, mInt64ToStr, mBoolToStr, mCharToStr: + mIntToStr, mInt64ToStr: result := newStrNodeT(toString(getOrdValue(a)), n); + mBoolToStr: begin + if getOrdValue(a) = 0 then + result := newStrNodeT('false', n) + else + result := newStrNodeT('true', n) + end; mFloatToStr: result := newStrNodeT(toStringF(getFloat(a)), n); - mCStrToStr: result := newStrNodeT(getStrOrChar(a), n); + mCStrToStr, mCharToStr: result := newStrNodeT(getStrOrChar(a), n); mStrToStr: result := a; + mEnumToStr: result := newStrNodeT(enumValToString(a), n); mArrToSeq: begin result := copyTree(a); result.typ := n.typ; @@ -370,6 +396,10 @@ begin mNimrodMinor: result := newIntNodeT(VersionMinor, n); mNimrodPatch: result := newIntNodeT(VersionPatch, n); mCpuEndian: result := newIntNodeT(ord(CPU[targetCPU].endian), n); + mHostOS: + result := newStrNodeT(toLower(platform.OS[targetOS].name), n); + mHostCPU: + result := newStrNodeT(toLower(platform.CPU[targetCPU].name),n); mNaN: result := newFloatNodeT(NaN, n); mInf: result := newFloatNodeT(Inf, n); mNegInf: result := newFloatNodeT(NegInf, n); diff --git a/nim/semstmts.pas b/nim/semstmts.pas index 7d6403db4..098b95072 100644 --- a/nim/semstmts.pas +++ b/nim/semstmts.pas @@ -324,7 +324,7 @@ begin a := newNodeI(nkAsgn, n.sons[0].info); n.sons[0] := fitNode(c, restype, n.sons[0]); - // optimize away ``return result``, because it would be transferred + // optimize away ``return result``, because it would be transformed // to ``result = result; return``: if (n.sons[0].kind = nkSym) and (sfResult in n.sons[0].sym.flags) then begin @@ -378,14 +378,14 @@ function semVar(c: PContext; n: PNode): PNode; var i, j, len: int; a, b, def: PNode; - typ: PType; + typ, tup: PType; v: PSym; begin result := copyNode(n); for i := 0 to sonsLen(n)-1 do begin a := n.sons[i]; if a.kind = nkCommentStmt then continue; - if (a.kind <> nkIdentDefs) then IllFormedAst(a); + if (a.kind <> nkIdentDefs) and (a.kind <> nkVarTuple) then IllFormedAst(a); checkMinSonsLen(a, 3); len := sonsLen(a); if a.sons[len-2] <> nil then @@ -401,14 +401,21 @@ begin end else def := nil; + tup := skipGeneric(typ); + if a.kind = nkVarTuple then begin + if tup.kind <> tyTuple then liMessage(a.info, errXExpected, 'tuple'); + if len-2 <> sonsLen(tup) then + liMessage(a.info, errWrongNumberOfVariables); + end; for j := 0 to len-3 do begin - if (c.p.owner = nil) then begin + if c.p.owner = nil then begin v := semIdentWithPragma(c, skVar, a.sons[j], {@set}[sfStar, sfMinus]); include(v.flags, sfGlobal); end else v := semIdentWithPragma(c, skVar, a.sons[j], {@set}[]); - v.typ := typ; + if a.kind <> nkVarTuple then v.typ := typ + else v.typ := tup.sons[j]; if v.flags * [sfStar, sfMinus] <> {@set}[] then include(v.flags, sfInInterface); addInterfaceDecl(c, v); @@ -443,7 +450,7 @@ begin if a.sons[1] <> nil then typ := semTypeNode(c, a.sons[1], nil) else typ := nil; - def := semConstExpr(c, a.sons[2]); + def := semAndEvalConstExpr(c, a.sons[2]); // check type compability between def.typ and typ: if (typ <> nil) then begin def := fitRemoveHiddenConv(c, typ, def); @@ -495,7 +502,7 @@ begin iter := skipGeneric(n.sons[len-2].typ); openScope(c.tab); if iter.kind <> tyTuple then begin - if len <> 3 then liMessage(n.info, errWrongNumberOfLoopVariables); + if len <> 3 then liMessage(n.info, errWrongNumberOfVariables); v := newSymS(skForVar, n.sons[0], c); v.typ := iter; n.sons[0] := newSymNode(v); @@ -503,7 +510,7 @@ begin end else begin if len-2 <> sonsLen(iter) then - liMessage(n.info, errWrongNumberOfLoopVariables); + liMessage(n.info, errWrongNumberOfVariables); for i := 0 to len-3 do begin v := newSymS(skForVar, n.sons[i], c); v.typ := iter.sons[i]; @@ -840,6 +847,7 @@ begin closeScope(c.tab); // close scope for parameters popOwner(); c.p := oldP; // restore + result.typ := s.typ; end; function semProcAux(c: PContext; n: PNode; kind: TSymKind): PNode; diff --git a/nim/semtypes.pas b/nim/semtypes.pas index 5d9bd626a..37958c4d0 100644 --- a/nim/semtypes.pas +++ b/nim/semtypes.pas @@ -256,8 +256,8 @@ begin if templ = nil then begin result := nil; exit end; case templ.kind of nkSym: begin - if (templ.sym.kind = skTypeParam) - and (templ.sym.owner.id = sym.id) then + if (templ.sym.kind = skTypeParam) then + //and (templ.sym.owner.id = sym.id) then result := copyTree(actual.sons[templ.sym.position+1]) else result := copyNode(templ) @@ -285,15 +285,18 @@ begin result.containerID := s.typ.containerID; // ... but the same containerID result.sym := s; if (s.typ.containerID = 0) then - InternalError(n.info, 'semGeneric'); + InternalError(n.info, 'semtypes.semGeneric'); for i := 1 to sonsLen(n)-1 do begin elem := semTypeNode(c, n.sons[i], nil); - if elem.kind = tyGenericParam then result.kind := tyGeneric; + if elem.kind = tyGenericParam then + result.kind := tyGeneric; // prevend type from instantiation addSon(result, elem); end; if s.ast <> nil then begin - inst := instGenericAux(c, s.ast.sons[2], n, s); - if result.kind = tyGenericInst then begin + if (result.kind = tyGenericInst) then begin + inst := instGenericAux(c, s.ast.sons[2], n, s); + internalError(n.info, 'Generic containers not implemented'); + // XXX: implementation does not work this way // does checking of instantiated type for us: elem := semTypeNode(c, inst, nil); elem.id := result.containerID; @@ -303,7 +306,9 @@ begin addSon(result, nil); end else - liMessage(n.info, errCannotInstantiateX, s.name.s); + liMessage(n.info, errCannotInstantiateX, s.name.s); + (*if computeSize(result) < 0 then + liMessage(s.info, errIllegalRecursionInTypeX, s.name.s);*) end; function semIdentVis(c: PContext; kind: TSymKind; n: PNode; diff --git a/nim/sigmatch.pas b/nim/sigmatch.pas index 741052f05..289a17673 100644 --- a/nim/sigmatch.pas +++ b/nim/sigmatch.pas @@ -80,20 +80,23 @@ var begin result := msgKindToString(errTypeMismatch); for i := 1 to sonsLen(n)-1 do begin - result := result +{&} typeToString(n.sons[i].typ); - if i <> sonsLen(n)-1 then result := result + ', '; + debug(n.sons[i].typ); + add(result, typeToString(n.sons[i].typ)); + if i <> sonsLen(n)-1 then add(result, ', '); end; addChar(result, ')'); candidates := ''; sym := initOverloadIter(o, c, n.sons[0]); while sym <> nil do begin - if sym.kind in [skProc, skIterator, skConverter] then - candidates := candidates +{&} getProcHeader(sym) +{&} nl; + if sym.kind in [skProc, skIterator, skConverter] then begin + add(candidates, getProcHeader(sym)); + add(candidates, nl) + end; sym := nextOverloadIter(o, c, n.sons[0]); end; if candidates <> '' then - result := result +{&} nl +{&} msgKindToString(errButExpected) +{&} nl - +{&} candidates; + add(result, nl +{&} msgKindToString(errButExpected) +{&} nl + +{&} candidates); end; function typeRel(var mapping: TIdTable; f, a: PType): TTypeRelation; overload; @@ -431,7 +434,7 @@ begin // is a subtype of f? tyAnyEnum: begin case a.kind of tyRange: result := typeRel(mapping, f, base(a)); - tyEnum: result := isEqual; + tyEnum: result := isSubtype; else begin end end end; diff --git a/nim/strtabs.pas b/nim/strtabs.pas index 295c46faa..b07aefab1 100644 --- a/nim/strtabs.pas +++ b/nim/strtabs.pas @@ -8,8 +8,7 @@ // unit strtabs; -// A configuration file parser; the Nimrod version of this file -// will become part of the standard library. +// String tables. interface diff --git a/nim/strutils.pas b/nim/strutils.pas index 3d8f0424b..71a428dbb 100644 --- a/nim/strutils.pas +++ b/nim/strutils.pas @@ -75,13 +75,14 @@ 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; +function quoteIfContainsWhite(const s: string): string; implementation -function quoteIfSpaceExists(const s: string): string; +function quoteIfContainsWhite(const s: string): string; begin - if (findSubStr(' ', s) >= strStart) and (s[strStart] <> '"') then + if ((findSubStr(' ', s) >= strStart) + or (findSubStr(#9, s) >= strStart)) and (s[strStart] <> '"') then result := '"' +{&} s +{&} '"' else result := s diff --git a/nim/tigen.pas b/nim/tigen.pas new file mode 100644 index 000000000..937883e5e --- /dev/null +++ b/nim/tigen.pas @@ -0,0 +1,47 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// + +unit tigen; + +// Type information generator. It transforms types into the AST of walker +// procs. This is used by the code generators. + +interface + +{$include 'config.inc'} + +uses + nsystem, ast, astalgo, strutils, hashes, trees, treetab, platform, magicsys, + options, msgs, crc, idents, lists, types, rnimsyn; + +function gcWalker(t: PType): PNode; +function initWalker(t: PType): PNode; +function asgnWalker(t: PType): PNode; +function reprWalker(t: PType): PNode; + +implementation + +function gcWalker(t: PType): PNode; +begin +end; + +function initWalker(t: PType): PNode; +begin +end; + +function asgnWalker(t: PType): PNode; +begin +end; + +function reprWalker(t: PType): PNode; +begin +end; + +end. + diff --git a/nim/transf.pas b/nim/transf.pas index d74f2aa83..98d1e89ea 100644 --- a/nim/transf.pas +++ b/nim/transf.pas @@ -22,7 +22,7 @@ interface uses sysutils, nsystem, charsets, strutils, lists, options, ast, astalgo, trees, treetab, - msgs, nos, idents, rnimsyn, types, passes, semfold; + msgs, nos, idents, rnimsyn, types, passes, semfold, magicsys; const genPrefix = ':tmp'; // prefix for generated names @@ -139,7 +139,7 @@ More efficient, but not implementable: function newAsgnStmt(c: PTransf; le, ri: PNode): PNode; begin - result := newNodeI(nkAsgn, ri.info); + result := newNodeI(nkFastAsgn, ri.info); addSon(result, le); addSon(result, ri); end; @@ -224,6 +224,28 @@ begin end end; +function newTupleAccess(tup: PNode; i: int): PNode; +var + lit: PNode; +begin + result := newNodeIT(nkBracketExpr, tup.info, tup.typ.sons[i]); + addSon(result, copyTree(tup)); + lit := newNodeIT(nkIntLit, tup.info, getSysType(tyInt)); + lit.intVal := i; + addSon(result, lit); +end; + +procedure unpackTuple(c: PTransf; n, father: PNode); +var + i: int; +begin + // XXX: BUG: what if `n` is an expression with side-effects? + for i := 0 to sonsLen(n)-1 do begin + addSon(father, newAsgnStmt(c, c.transCon.forStmt.sons[i], + transform(c, newTupleAccess(n, i)))); + end +end; + function transformYield(c: PTransf; n: PNode): PNode; var e: PNode; @@ -239,10 +261,8 @@ begin transform(c, copyTree(e.sons[i])))); end end - else begin - // XXX: tuple unpacking: - internalError(n.info, 'tuple unpacking is not implemented'); - end + else + unpackTuple(c, e, result); end else begin e := transform(c, copyTree(e)); @@ -523,7 +543,7 @@ end; (* # example: proc map(f: proc (x: int): int {.closure}, a: seq[int]): seq[int] = - result = [] + result = @[] for elem in a: add result, f(a) @@ -534,12 +554,12 @@ end; proc map(f: proc(x: int): int, closure: pointer, a: seq[int]): seq[int] = - result = [] + result = @[] for elem in a: add result, f(a, closure) type - PMyClosure = ref record + PMyClosure = ref object y: var int proc myLambda(x: int, closure: pointer) = diff --git a/nim/types.pas b/nim/types.pas index 0686a368f..25ad54b33 100644 --- a/nim/types.pas +++ b/nim/types.pas @@ -638,15 +638,15 @@ 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 +{&} ', '; + add(result, t.n.sons[i].sym.name.s +{&} ': ' + +{&} typeToString(t.sons[i])); + if i < sonsLen(t.n)-1 then add(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 +{&} ', '; + add(result, typeToString(t.sons[i])); + if i < sonsLen(t)-1 then add(result, ', '); end end; addChar(result, ']') @@ -659,14 +659,14 @@ begin tyProc: begin result := 'proc ('; for i := 1 to sonsLen(t)-1 do begin - result := result +{&} typeToString(t.sons[i]); - if i < sonsLen(t)-1 then result := result +{&} ', '; + add(result, typeToString(t.sons[i])); + if i < sonsLen(t)-1 then add(result, ', '); end; addChar(result, ')'); if t.sons[0] <> nil then - result := result +{&} ': ' +{&} TypeToString(t.sons[0]); + add(result, ': ' +{&} TypeToString(t.sons[0])); if t.callConv <> ccDefault then - result := result +{&} '{.' +{&} CallingConvToStr[t.callConv] +{&} '.}'; + add(result, '{.' +{&} CallingConvToStr[t.callConv] +{&} '.}'); end; else begin result := typeToStr[t.kind] diff --git a/nim/wordrecg.pas b/nim/wordrecg.pas index 309b2f7c1..587005c2a 100644 --- a/nim/wordrecg.pas +++ b/nim/wordrecg.pas @@ -73,7 +73,7 @@ type wOverflowchecks, wNilchecks, wAssertions, wWarnings, wW, wHints, wOptimization, wSpeed, wSize, wNone, wPath, wP, wD, wU, wDebuginfo, wCompileonly, wNolinking, wForcebuild, - wF, wDeadelim, wSafecode, wCompileTime, + wF, wDeadCodeElim, wSafecode, wCompileTime, wGc, wRefc, wBoehm, wA, wOpt, wO, wApp, wConsole, wGui, wPassc, wT, wPassl, wL, wListcmd, wGendoc, wGenmapping, @@ -86,7 +86,7 @@ type // commands: wCompileToC, wCompileToCpp, wCompileToEcmaScript, wPretty, wDoc, wPas, - wGenDepend, wListDef, wCheck, wParse, wScan, wBoot, wDebugTrans, + wGenDepend, wListDef, wCheck, wParse, wScan, wBoot, wLazy, wRst2html, wI, // special for the preprocessor of configuration files: wWrite, wPutEnv, wPrependEnv, wAppendEnv, @@ -147,7 +147,7 @@ const 'overflowchecks', 'nilchecks', 'assertions', 'warnings', 'w'+'', 'hints', 'optimization', 'speed', 'size', 'none', 'path', 'p'+'', 'd'+'', 'u'+'', 'debuginfo', 'compileonly', 'nolinking', 'forcebuild', - 'f'+'', 'deadelim', 'safecode', 'compiletime', + 'f'+'', 'deadcodeelim', 'safecode', 'compiletime', 'gc', 'refc', 'boehm', 'a'+'', 'opt', 'o'+'', 'app', 'console', 'gui', 'passc', 't'+'', 'passl', 'l'+'', 'listcmd', 'gendoc', 'genmapping', @@ -160,7 +160,7 @@ const // commands: 'compiletoc', 'compiletocpp', 'compiletoecmascript', 'pretty', 'doc', 'pas', 'gendepend', 'listdef', 'check', 'parse', - 'scan', 'boot', 'debugtrans', 'rst2html', 'i'+'', + 'scan', 'boot', 'lazy', 'rst2html', 'i'+'', // special for the preprocessor of configuration files: 'write', 'putenv', 'prependenv', 'appendenv', |