diff options
45 files changed, 604 insertions, 371 deletions
diff --git a/compiler/ast.nim b/compiler/ast.nim index cdca68c20..edf93f4c9 100755 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -198,6 +198,9 @@ type nkMutableTy, # ``mutable T`` nkDistinctTy, # distinct type nkProcTy, # proc type + nkIteratorTy, # iterator type + nkSharedTy, # 'shared T' + # we use 'nkPostFix' for the 'not nil' addition nkEnumTy, # enum body nkEnumFieldDef, # `ident = expr` in an enumeration nkArgList, # argument list @@ -344,7 +347,7 @@ type nfSem # node has been checked for semantics TNodeFlags* = set[TNodeFlag] - TTypeFlag* = enum # keep below 17 for efficiency reasons (now: 16) + TTypeFlag* = enum # keep below 32 for efficiency reasons (now: 19) tfVarargs, # procedure has C styled varargs tfNoSideEffect, # procedure type does not allow side effects tfFinal, # is the object final? @@ -356,19 +359,22 @@ type tfFromGeneric, # type is an instantiation of a generic; this is needed # because for instantiations of objects, structural # type equality has to be used - tfInstantiated # XXX: used to mark generic params after instantiation. + tfInstantiated, # XXX: used to mark generic params after instantiation. # if the concrete type happens to be an implicit generic # this can lead to invalid proc signatures in the second # pass of semProcTypeNode performed after instantiation. # this won't be needed if we don't perform this redundant # second pass (stay tuned). - tfRetType # marks return types in proc (used to detect type classes + tfRetType, # marks return types in proc (used to detect type classes # used as return types for return type inference) tfAll, # type class requires all constraints to be met (default) tfAny, # type class requires any constraint to be met tfCapturesEnv, # whether proc really captures some environment tfByCopy, # pass object/tuple by copy (C backend) - tfByRef # pass object/tuple by reference (C backend) + tfByRef, # pass object/tuple by reference (C backend) + tfIterator, # type is really an iterator, not a tyProc + tfShared, # type is 'shared' + tfNotNil # type cannot be 'nil' TTypeFlags* = set[TTypeFlag] @@ -409,6 +415,9 @@ const skMacro, skTemplate} tfIncompleteStruct* = tfVarargs skError* = skUnknown + + # type flags that are essential for type equality: + eqTypeFlags* = {tfIterator, tfShared, tfNotNil} type TMagic* = enum # symbols that require compiler magic: @@ -726,7 +735,7 @@ const nkSymChoices* = {nkClosedSymChoice, nkOpenSymChoice} nkStrKinds* = {nkStrLit..nkTripleStrLit} - skLocalVars* = {skVar, skLet, skForVar, skParam} + skLocalVars* = {skVar, skLet, skForVar, skParam, skResult} # creator procs: diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index f031e72b0..57d06a988 100755 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -1671,7 +1671,7 @@ proc expr(p: BProc, e: PNode, d: var TLoc) = var sym = e.sym case sym.Kind of skMethod: - if sym.getBody.kind == nkEmpty: + if sym.getBody.kind == nkEmpty or sfDispatcher in sym.flags: # we cannot produce code for the dispatcher yet: fillProcLoc(sym) genProcPrototype(p.module, sym) diff --git a/compiler/commands.nim b/compiler/commands.nim index b6ef02fe1..50b4a1e6f 100755 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -268,6 +268,9 @@ proc processSwitch(switch, arg: string, pass: TCmdlinePass, info: TLineInfo) = of "forcebuild", "f": expectNoArg(switch, arg, pass, info) incl(gGlobalOptions, optForceFullMake) + of "project": + expectNoArg(switch, arg, pass, info) + gWholeProject = true of "gc": expectArg(switch, arg, pass, info) case arg.normalize diff --git a/compiler/docgen2.nim b/compiler/docgen2.nim index ba3f5d4ca..2d175adbf 100644 --- a/compiler/docgen2.nim +++ b/compiler/docgen2.nim @@ -23,11 +23,12 @@ type proc close(p: PPassContext, n: PNode): PNode = var g = PGen(p) let useWarning = sfMainModule notin g.module.flags - writeOutput(g.doc, g.filename, HtmlExt, useWarning) - try: - generateIndex(g.doc) - except EIO: - nil + if gWholeProject or sfMainModule in g.module.flags: + writeOutput(g.doc, g.filename, HtmlExt, useWarning) + try: + generateIndex(g.doc) + except EIO: + nil proc processNode(c: PPassContext, n: PNode): PNode = result = n diff --git a/compiler/lexer.nim b/compiler/lexer.nim index faa9fc672..abb25541b 100755 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -43,7 +43,7 @@ type tkLambda, tkLet, tkMacro, tkMethod, tkMixin, tkMod, tkNil, tkNot, tkNotin, tkObject, tkOf, tkOr, tkOut, - tkProc, tkPtr, tkRaise, tkRef, tkReturn, tkShl, tkShr, tkStatic, + tkProc, tkPtr, tkRaise, tkRef, tkReturn, tkShared, tkShl, tkShr, tkStatic, tkTemplate, tkTry, tkTuple, tkType, tkVar, tkWhen, tkWhile, tkWith, tkWithout, tkXor, tkYield, # end of keywords @@ -78,7 +78,8 @@ const "lambda", "let", "macro", "method", "mixin", "mod", "nil", "not", "notin", "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", "shl", "shr", "static", + "out", "proc", "ptr", "raise", "ref", "return", + "shared", "shl", "shr", "static", "template", "try", "tuple", "type", "var", "when", "while", "with", "without", "xor", "yield", @@ -679,6 +680,7 @@ proc scanComment(L: var TLexer, tok: var TToken) = inc(indent) if buf[pos] == '#' and (col == indent or lastBackslash > 0): tok.literal.add "\n" + col = indent else: if buf[pos] > ' ': L.indentAhead = indent diff --git a/compiler/main.nim b/compiler/main.nim index 26b3c9c4c..dabd5309b 100755 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -83,9 +83,19 @@ proc CompileModule(filename: string, flags: TSymFlags): PSym = result.id = getID() processModule(result, f, nil, rd) +proc `==^`(a, b: string): bool = + try: + result = sameFile(a, b) + except EOS: + result = false + proc CompileProject(projectFile = gProjectFull) = - discard CompileModule(options.libpath / "system", {sfSystemModule}) - discard CompileModule(projectFile, {sfMainModule}) + let systemFile = options.libpath / "system" + if projectFile.addFileExt(nimExt) ==^ systemFile.addFileExt(nimExt): + discard CompileModule(projectFile, {sfMainModule, sfSystemModule}) + else: + discard CompileModule(systemFile, {sfSystemModule}) + discard CompileModule(projectFile, {sfMainModule}) proc semanticPasses = registerPass(verbosePass()) @@ -249,6 +259,7 @@ proc MainCommand = gCmd = cmdDoc LoadConfigs(DocConfig) wantMainModule() + DefineSymbol("nimdoc") CommandDoc2() of "rst2html": gCmd = cmdRst2html diff --git a/compiler/msgs.nim b/compiler/msgs.nim index 45075cba8..0f795c07d 100755 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -104,7 +104,7 @@ type warnUnknownSubstitutionX, warnLanguageXNotSupported, warnCommentXIgnored, warnNilStatement, warnAnalysisLoophole, warnDifferentHeaps, warnWriteToForeignHeap, warnImplicitClosure, - warnEachIdentIsTuple, warnUser, + warnEachIdentIsTuple, warnShadowIdent, warnUser, hintSuccess, hintSuccessX, hintLineTooLong, hintXDeclaredButNotUsed, hintConvToBaseNotNeeded, hintConvFromXtoItselfNotNeeded, hintExprAlwaysX, hintQuitCalled, @@ -351,6 +351,7 @@ const warnWriteToForeignHeap: "write to foreign heap [WriteToForeignHeap]", warnImplicitClosure: "implicit closure convention: '$1' [ImplicitClosure]", warnEachIdentIsTuple: "each identifier is a tuple [EachIdentIsTuple]", + warnShadowIdent: "shadowed identifier: '$1' [ShadowIdent]", warnUser: "$1 [User]", hintSuccess: "operation successful [Success]", hintSuccessX: "operation successful ($# lines compiled; $# sec total; $#) [SuccessX]", @@ -370,14 +371,14 @@ const hintUser: "$1 [User]"] const - WarningsToStr*: array[0..18, string] = ["CannotOpenFile", "OctalEscape", + WarningsToStr*: array[0..19, string] = ["CannotOpenFile", "OctalEscape", "XIsNeverRead", "XmightNotBeenInit", "Deprecated", "ConfigDeprecated", "SmallLshouldNotBeUsed", "UnknownMagic", "RedefinitionOfLabel", "UnknownSubstitutionX", "LanguageXNotSupported", "CommentXIgnored", "NilStmt", "AnalysisLoophole", "DifferentHeaps", "WriteToForeignHeap", - "ImplicitClosure", "EachIdentIsTuple", "User"] + "ImplicitClosure", "EachIdentIsTuple", "ShadowIdent", "User"] HintsToStr*: array[0..15, string] = ["Success", "SuccessX", "LineTooLong", "XDeclaredButNotUsed", "ConvToBaseNotNeeded", "ConvFromXtoItselfNotNeeded", @@ -464,7 +465,7 @@ proc raiseRecoverableError*(msg: string) {.noinline, noreturn.} = raise newException(ERecoverableError, msg) var - gNotes*: TNoteKinds = {low(TNoteKind)..high(TNoteKind)} + gNotes*: TNoteKinds = {low(TNoteKind)..high(TNoteKind)} - {warnShadowIdent} gErrorCounter*: int = 0 # counts the number of errors gHintCounter*: int = 0 gWarnCounter*: int = 0 diff --git a/compiler/options.nim b/compiler/options.nim index 2051953ce..42fca1ad1 100755 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -95,6 +95,8 @@ var gVerbosity*: int # how verbose the compiler is gNumberOfProcessors*: int # number of processors + gWholeProject*: bool # for 'doc2': output any dependency + const genSubDir* = "nimcache" NimExt* = "nim" diff --git a/compiler/parser.nim b/compiler/parser.nim index 680279bcf..59f7934e0 100755 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -731,7 +731,8 @@ proc parseProcExpr(p: var TParser, isExpr: bool): PNode = proc isExprStart(p: TParser): bool = case p.tok.tokType - of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkProc, tkBind, + of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, + tkProc, tkIterator, tkBind, tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, tkTuple, tkType, tkWhen, tkCase: result = true @@ -811,6 +812,9 @@ proc primary(p: var TParser, skipSuffix = false): PNode = proc parseTypeDesc(p: var TParser): PNode = if p.tok.toktype == tkProc: result = parseProcExpr(p, false) + elif p.tok.toktype == tkIterator: + result = parseProcExpr(p, false) + result.kind = nkIteratorTy else: result = parseExpr(p) proc parseExprStmt(p: var TParser): PNode = diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index f874a0acf..8f06beecd 100755 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -262,11 +262,11 @@ proc processNote(c: PContext, n: PNode) = else: invalidPragma(n) -proc processOption(c: PContext, n: PNode) = - if n.kind != nkExprColonExpr: invalidPragma(n) +proc processOption(c: PContext, n: PNode): bool = + if n.kind != nkExprColonExpr: result = true elif n.sons[0].kind == nkBracketExpr: processNote(c, n) - elif n.sons[0].kind != nkIdent: invalidPragma(n) - else: + elif n.sons[0].kind != nkIdent: result = true + else: var sw = whichKeyword(n.sons[0].ident) case sw of wChecks: OnOff(c, n, checksOptions) @@ -307,9 +307,11 @@ proc processOption(c: PContext, n: PNode) = else: LocalError(n.info, errNoneSpeedOrSizeExpected) of wImplicitStatic: OnOff(c, n, {optImplicitStatic}) of wPatterns: OnOff(c, n, {optPatterns}) - else: LocalError(n.info, errOptionExpected) + else: result = true proc processPush(c: PContext, n: PNode, start: int) = + if n.sons[start-1].kind == nkExprColonExpr: + LocalError(n.info, errGenerated, "':' after 'push' not supported") var x = newOptionEntry() var y = POptionEntry(c.optionStack.tail) x.options = gOptions @@ -318,15 +320,18 @@ proc processPush(c: PContext, n: PNode, start: int) = x.notes = gNotes append(c.optionStack, x) for i in countup(start, sonsLen(n) - 1): - processOption(c, n.sons[i]) - #liMessage(n.info, warnUser, ropeToStr(optionsToStr(gOptions))); + if processOption(c, n.sons[i]): + # simply store it somehwere: + if x.otherPragmas.isNil: + x.otherPragmas = newNodeI(nkPragma, n.info) + x.otherPragmas.add n.sons[i] + #LocalError(n.info, errOptionExpected) proc processPop(c: PContext, n: PNode) = if c.optionStack.counter <= 1: LocalError(n.info, errAtPopWithoutPush) else: gOptions = POptionEntry(c.optionStack.tail).options - #liMessage(n.info, warnUser, ropeToStr(optionsToStr(gOptions))); gNotes = POptionEntry(c.optionStack.tail).notes remove(c.optionStack, c.optionStack.tail) @@ -481,227 +486,240 @@ proc pragmaRaisesOrTags(c: PContext, n: PNode) = else: invalidPragma(n) -proc pragma(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) = - if n == nil: return - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - var key = if it.kind == nkExprColonExpr: it.sons[0] else: it - if key.kind == nkIdent: - var userPragma = StrTableGet(c.userPragmas, key.ident) - if userPragma != nil: - inc c.InstCounter - if c.InstCounter > 100: - GlobalError(it.info, errRecursiveDependencyX, userPragma.name.s) - pragma(c, sym, userPragma.ast, validPragmas) - dec c.InstCounter - else: - var k = whichKeyword(key.ident) - if k in validPragmas: - case k - of wExportc: - makeExternExport(sym, getOptionalStr(c, it, sym.name.s)) - incl(sym.flags, sfUsed) # avoid wrong hints - of wImportc: makeExternImport(sym, getOptionalStr(c, it, sym.name.s)) - of wImportCompilerProc: - processImportCompilerProc(sym, getOptionalStr(c, it, sym.name.s)) - of wExtern: setExternName(sym, expectStrLit(c, it)) - of wImmediate: - if sym.kind in {skTemplate, skMacro}: incl(sym.flags, sfImmediate) - else: invalidPragma(it) - of wDirty: - if sym.kind == skTemplate: incl(sym.flags, sfDirty) - else: invalidPragma(it) - of wImportCpp: - processImportCpp(sym, getOptionalStr(c, it, sym.name.s)) - of wImportObjC: - processImportObjC(sym, getOptionalStr(c, it, sym.name.s)) - of wAlign: - if sym.typ == nil: invalidPragma(it) - var align = expectIntLit(c, it) - if not IsPowerOfTwo(align) and align != 0: - LocalError(it.info, errPowerOfTwoExpected) - else: - sym.typ.align = align - of wSize: - if sym.typ == nil: invalidPragma(it) - var size = expectIntLit(c, it) - if not IsPowerOfTwo(size) or size <= 0 or size > 8: - LocalError(it.info, errPowerOfTwoExpected) - else: - sym.typ.size = size - of wNodecl: - noVal(it) - incl(sym.loc.Flags, lfNoDecl) - of wPure, wNoStackFrame: - noVal(it) - if sym != nil: incl(sym.flags, sfPure) - of wVolatile: - noVal(it) - incl(sym.flags, sfVolatile) - of wRegister: - noVal(it) - incl(sym.flags, sfRegister) - of wThreadVar: - noVal(it) - incl(sym.flags, sfThread) - of wDeadCodeElim: pragmaDeadCodeElim(c, it) - of wMagic: processMagic(c, it, sym) - of wCompileTime: - noVal(it) - incl(sym.flags, sfCompileTime) - incl(sym.loc.Flags, lfNoDecl) - of wGlobal: - noVal(it) - incl(sym.flags, sfGlobal) - of wMerge: - noval(it) - incl(sym.flags, sfMerge) - of wHeader: - var lib = getLib(c, libHeader, getStrLitNode(c, it)) - addToLib(lib, sym) - incl(sym.flags, sfImportc) - incl(sym.loc.flags, lfHeader) - incl(sym.loc.Flags, lfNoDecl) - # implies nodecl, because otherwise header would not make sense - if sym.loc.r == nil: sym.loc.r = toRope(sym.name.s) - of wDestructor: - if sym.typ.sons.len == 2: - sym.flags.incl sfDestructor - else: - invalidPragma(it) - of wNosideeffect: - noVal(it) - incl(sym.flags, sfNoSideEffect) - if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) - of wSideEffect: - noVal(it) - incl(sym.flags, sfSideEffect) - of wNoReturn: - noVal(it) - incl(sym.flags, sfNoReturn) - of wDynLib: - processDynLib(c, it, sym) - of wCompilerProc: - noVal(it) # compilerproc may not get a string! - makeExternExport(sym, sym.name.s) - incl(sym.flags, sfCompilerProc) - incl(sym.flags, sfUsed) # suppress all those stupid warnings - registerCompilerProc(sym) - of wProcvar: - noVal(it) - incl(sym.flags, sfProcVar) - of wDeprecated: - noVal(it) - if sym != nil: incl(sym.flags, sfDeprecated) - else: incl(c.module.flags, sfDeprecated) - of wVarargs: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfVarargs) - of wBorrow: - noVal(it) - incl(sym.flags, sfBorrow) - of wFinal: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfFinal) - of wInheritable: - noVal(it) - if sym.typ == nil or tfFinal in sym.typ.flags: invalidPragma(it) - else: incl(sym.typ.flags, tfInheritable) - of wAcyclic: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfAcyclic) - of wShallow: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfShallow) - of wThread: - noVal(it) - incl(sym.flags, sfThread) - incl(sym.flags, sfProcVar) - if sym.typ != nil: incl(sym.typ.flags, tfThread) - of wHint: Message(it.info, hintUser, expectStrLit(c, it)) - of wWarning: Message(it.info, warnUser, expectStrLit(c, it)) - of wError: - if sym != nil and sym.isRoutine: - # This is subtle but correct: the error *statement* is only - # allowed for top level statements. Seems to be easier than - # distinguishing properly between - # ``proc p() {.error}`` and ``proc p() = {.error: "msg".}`` - noVal(it) - incl(sym.flags, sfError) - else: - LocalError(it.info, errUser, expectStrLit(c, it)) - of wFatal: Fatal(it.info, errUser, expectStrLit(c, it)) - of wDefine: processDefine(c, it) - of wUndef: processUndef(c, it) - of wCompile: processCompile(c, it) - of wLink: processCommonLink(c, it, linkNormal) - of wLinkSys: processCommonLink(c, it, linkSys) - of wPassL: extccomp.addLinkOption(expectStrLit(c, it)) - of wPassC: extccomp.addCompileOption(expectStrLit(c, it)) - of wBreakpoint: PragmaBreakpoint(c, it) - of wWatchpoint: PragmaWatchpoint(c, it) - of wPush: - processPush(c, n, i + 1) - break - of wPop: processPop(c, it) - of wPragma: - processPragma(c, n, i) - break - of wDiscardable: - noVal(it) - if sym != nil: incl(sym.flags, sfDiscardable) - of wNoInit: - noVal(it) - if sym != nil: incl(sym.flags, sfNoInit) - of wHoist: - noVal(it) - if sym != nil: incl(sym.flags, sfHoist) - of wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, - wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, - wLinedir, wStacktrace, wLinetrace, wOptimization, - wCallConv, - wDebugger, wProfiler, wFloatChecks, wNanChecks, wInfChecks, - wPatterns: - processOption(c, it) # calling conventions (boring...): - of firstCallConv..lastCallConv: - assert(sym != nil) - if sym.typ == nil: invalidPragma(it) - else: sym.typ.callConv = wordToCallConv(k) - of wEmit: PragmaEmit(c, it) - of wUnroll: PragmaUnroll(c, it) - of wLinearScanEnd: PragmaLinearScanEnd(c, it) - of wEffects: - # is later processed in effect analysis: - noVal(it) - of wIncompleteStruct: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfIncompleteStruct) - of wByRef: - noVal(it) - if sym == nil or sym.typ == nil: - processOption(c, it) - else: - incl(sym.typ.flags, tfByRef) - of wByCopy: - noVal(it) - if sym.kind != skType or sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfByCopy) - of wInject, wGenSym: - # We check for errors, but do nothing with these pragmas otherwise - # as they are handled directly in 'evalTemplate'. - noVal(it) - if sym == nil: invalidPragma(it) - of wLine: PragmaLine(c, it) - of wRaises, wTags: pragmaRaisesOrTags(c, it) +proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, + validPragmas: TSpecialWords): bool = + var it = n.sons[i] + var key = if it.kind == nkExprColonExpr: it.sons[0] else: it + if key.kind == nkIdent: + var userPragma = StrTableGet(c.userPragmas, key.ident) + if userPragma != nil: + inc c.InstCounter + if c.InstCounter > 100: + GlobalError(it.info, errRecursiveDependencyX, userPragma.name.s) + pragma(c, sym, userPragma.ast, validPragmas) + dec c.InstCounter + else: + var k = whichKeyword(key.ident) + if k in validPragmas: + case k + of wExportc: + makeExternExport(sym, getOptionalStr(c, it, sym.name.s)) + incl(sym.flags, sfUsed) # avoid wrong hints + of wImportc: makeExternImport(sym, getOptionalStr(c, it, sym.name.s)) + of wImportCompilerProc: + processImportCompilerProc(sym, getOptionalStr(c, it, sym.name.s)) + of wExtern: setExternName(sym, expectStrLit(c, it)) + of wImmediate: + if sym.kind in {skTemplate, skMacro}: incl(sym.flags, sfImmediate) + else: invalidPragma(it) + of wDirty: + if sym.kind == skTemplate: incl(sym.flags, sfDirty) else: invalidPragma(it) + of wImportCpp: + processImportCpp(sym, getOptionalStr(c, it, sym.name.s)) + of wImportObjC: + processImportObjC(sym, getOptionalStr(c, it, sym.name.s)) + of wAlign: + if sym.typ == nil: invalidPragma(it) + var align = expectIntLit(c, it) + if not IsPowerOfTwo(align) and align != 0: + LocalError(it.info, errPowerOfTwoExpected) + else: + sym.typ.align = align + of wSize: + if sym.typ == nil: invalidPragma(it) + var size = expectIntLit(c, it) + if not IsPowerOfTwo(size) or size <= 0 or size > 8: + LocalError(it.info, errPowerOfTwoExpected) + else: + sym.typ.size = size + of wNodecl: + noVal(it) + incl(sym.loc.Flags, lfNoDecl) + of wPure, wNoStackFrame: + noVal(it) + if sym != nil: incl(sym.flags, sfPure) + of wVolatile: + noVal(it) + incl(sym.flags, sfVolatile) + of wRegister: + noVal(it) + incl(sym.flags, sfRegister) + of wThreadVar: + noVal(it) + incl(sym.flags, sfThread) + of wDeadCodeElim: pragmaDeadCodeElim(c, it) + of wMagic: processMagic(c, it, sym) + of wCompileTime: + noVal(it) + incl(sym.flags, sfCompileTime) + incl(sym.loc.Flags, lfNoDecl) + of wGlobal: + noVal(it) + incl(sym.flags, sfGlobal) + of wMerge: + noval(it) + incl(sym.flags, sfMerge) + of wHeader: + var lib = getLib(c, libHeader, getStrLitNode(c, it)) + addToLib(lib, sym) + incl(sym.flags, sfImportc) + incl(sym.loc.flags, lfHeader) + incl(sym.loc.Flags, lfNoDecl) + # implies nodecl, because otherwise header would not make sense + if sym.loc.r == nil: sym.loc.r = toRope(sym.name.s) + of wDestructor: + if sym.typ.sons.len == 2: + sym.flags.incl sfDestructor + else: + invalidPragma(it) + of wNosideeffect: + noVal(it) + incl(sym.flags, sfNoSideEffect) + if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) + of wSideEffect: + noVal(it) + incl(sym.flags, sfSideEffect) + of wNoReturn: + noVal(it) + incl(sym.flags, sfNoReturn) + of wDynLib: + processDynLib(c, it, sym) + of wCompilerProc: + noVal(it) # compilerproc may not get a string! + makeExternExport(sym, sym.name.s) + incl(sym.flags, sfCompilerProc) + incl(sym.flags, sfUsed) # suppress all those stupid warnings + registerCompilerProc(sym) + of wProcvar: + noVal(it) + incl(sym.flags, sfProcVar) + of wDeprecated: + noVal(it) + if sym != nil: incl(sym.flags, sfDeprecated) + else: incl(c.module.flags, sfDeprecated) + of wVarargs: + noVal(it) + if sym.typ == nil: invalidPragma(it) + else: incl(sym.typ.flags, tfVarargs) + of wBorrow: + noVal(it) + incl(sym.flags, sfBorrow) + of wFinal: + noVal(it) + if sym.typ == nil: invalidPragma(it) + else: incl(sym.typ.flags, tfFinal) + of wInheritable: + noVal(it) + if sym.typ == nil or tfFinal in sym.typ.flags: invalidPragma(it) + else: incl(sym.typ.flags, tfInheritable) + of wAcyclic: + noVal(it) + if sym.typ == nil: invalidPragma(it) + else: incl(sym.typ.flags, tfAcyclic) + of wShallow: + noVal(it) + if sym.typ == nil: invalidPragma(it) + else: incl(sym.typ.flags, tfShallow) + of wThread: + noVal(it) + incl(sym.flags, sfThread) + incl(sym.flags, sfProcVar) + if sym.typ != nil: incl(sym.typ.flags, tfThread) + of wHint: Message(it.info, hintUser, expectStrLit(c, it)) + of wWarning: Message(it.info, warnUser, expectStrLit(c, it)) + of wError: + if sym != nil and sym.isRoutine: + # This is subtle but correct: the error *statement* is only + # allowed for top level statements. Seems to be easier than + # distinguishing properly between + # ``proc p() {.error}`` and ``proc p() = {.error: "msg".}`` + noVal(it) + incl(sym.flags, sfError) + else: + LocalError(it.info, errUser, expectStrLit(c, it)) + of wFatal: Fatal(it.info, errUser, expectStrLit(c, it)) + of wDefine: processDefine(c, it) + of wUndef: processUndef(c, it) + of wCompile: processCompile(c, it) + of wLink: processCommonLink(c, it, linkNormal) + of wLinkSys: processCommonLink(c, it, linkSys) + of wPassL: extccomp.addLinkOption(expectStrLit(c, it)) + of wPassC: extccomp.addCompileOption(expectStrLit(c, it)) + of wBreakpoint: PragmaBreakpoint(c, it) + of wWatchpoint: PragmaWatchpoint(c, it) + of wPush: + processPush(c, n, i + 1) + result = true + of wPop: processPop(c, it) + of wPragma: + processPragma(c, n, i) + result = true + of wDiscardable: + noVal(it) + if sym != nil: incl(sym.flags, sfDiscardable) + of wNoInit: + noVal(it) + if sym != nil: incl(sym.flags, sfNoInit) + of wHoist: + noVal(it) + if sym != nil: incl(sym.flags, sfHoist) + of wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, + wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, + wLinedir, wStacktrace, wLinetrace, wOptimization, + wCallConv, + wDebugger, wProfiler, wFloatChecks, wNanChecks, wInfChecks, + wPatterns: + if processOption(c, it): + # calling conventions (boring...): + LocalError(it.info, errOptionExpected) + of firstCallConv..lastCallConv: + assert(sym != nil) + if sym.typ == nil: invalidPragma(it) + else: sym.typ.callConv = wordToCallConv(k) + of wEmit: PragmaEmit(c, it) + of wUnroll: PragmaUnroll(c, it) + of wLinearScanEnd: PragmaLinearScanEnd(c, it) + of wEffects: + # is later processed in effect analysis: + noVal(it) + of wIncompleteStruct: + noVal(it) + if sym.typ == nil: invalidPragma(it) + else: incl(sym.typ.flags, tfIncompleteStruct) + of wByRef: + noVal(it) + if sym == nil or sym.typ == nil: + if processOption(c, it): LocalError(it.info, errOptionExpected) + else: + incl(sym.typ.flags, tfByRef) + of wByCopy: + noVal(it) + if sym.kind != skType or sym.typ == nil: invalidPragma(it) + else: incl(sym.typ.flags, tfByCopy) + of wInject, wGenSym: + # We check for errors, but do nothing with these pragmas otherwise + # as they are handled directly in 'evalTemplate'. + noVal(it) + if sym == nil: invalidPragma(it) + of wLine: PragmaLine(c, it) + of wRaises, wTags: pragmaRaisesOrTags(c, it) else: invalidPragma(it) - else: processNote(c, it) + else: invalidPragma(it) + else: processNote(c, it) + +proc implictPragmas*(c: PContext, sym: PSym, n: PNode, + validPragmas: TSpecialWords) = if sym != nil and sym.kind != skModule: + var it = POptionEntry(c.optionstack.head) + while it != nil: + let o = it.otherPragmas + if not o.isNil: + for i in countup(0, sonsLen(o) - 1): + if singlePragma(c, sym, o, i, validPragmas): + InternalError(n.info, "implicitPragmas") + it = it.next.POptionEntry + if lfExportLib in sym.loc.flags and sfExportc notin sym.flags: LocalError(n.info, errDynlibRequiresExportc) var lib = POptionEntry(c.optionstack.tail).dynlib @@ -710,4 +728,9 @@ proc pragma(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) = incl(sym.loc.flags, lfDynamicLib) addToLib(lib, sym) if sym.loc.r == nil: sym.loc.r = toRope(sym.name.s) - + +proc pragma(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) = + if n == nil: return + for i in countup(0, sonsLen(n) - 1): + if singlePragma(c, sym, n, i, validPragmas): break + implictPragmas(c, sym, n, validPragmas) diff --git a/compiler/renderer.nim b/compiler/renderer.nim index de642eccb..b9d522694 100755 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -425,6 +425,8 @@ proc lsub(n: PNode): int = of nkTypeDef: result = lsons(n) + 3 of nkOfInherit: result = lsub(n.sons[0]) + len("of_") of nkProcTy: result = lsons(n) + len("proc_") + of nkIteratorTy: result = lsons(n) + len("iterator_") + of nkSharedTy: result = lsons(n) + len("shared_") of nkEnumTy: if sonsLen(n) > 0: result = lsub(n.sons[0]) + lcomma(n, 1) + len("enum_") @@ -1025,7 +1027,20 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n.sons[1]) else: put(g, tkProc, "proc") - of nkEnumTy: + of nkIteratorTy: + if sonsLen(n) > 0: + putWithSpace(g, tkIterator, "iterator") + gsub(g, n.sons[0]) + gsub(g, n.sons[1]) + else: + put(g, tkIterator, "iterator") + of nkSharedTy: + if sonsLen(n) > 0: + putWithSpace(g, tkShared, "shared") + gsub(g, n.sons[0]) + else: + put(g, tkShared, "shared") + of nkEnumTy: if sonsLen(n) > 0: putWithSpace(g, tkEnum, "enum") gsub(g, n.sons[0]) diff --git a/compiler/semdata.nim b/compiler/semdata.nim index 57721bdc0..4ead9cf13 100755 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -22,6 +22,7 @@ type defaultCC*: TCallingConvention dynlib*: PLib Notes*: TNoteKinds + otherPragmas*: PNode # every pragma can be pushed POptionEntry* = ref TOptionEntry PProcCon* = ref TProcCon diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index c3e2ce8bc..bd8a3ba02 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -9,7 +9,7 @@ import intsets, ast, astalgo, msgs, renderer, magicsys, types, idents, trees, - wordrecg, strutils + wordrecg, strutils, options # Second semantic checking pass over the AST. Necessary because the old # way had some inherent problems. Performs: @@ -92,30 +92,44 @@ proc excType(n: PNode): PType = let t = if n.kind == nkEmpty: sysTypeFromName"E_Base" else: n.typ result = skipTypes(t, skipPtrs) +proc createRaise(n: PNode): PNode = + result = newNode(nkType) + result.typ = sysTypeFromName"E_Base" + if not n.isNil: result.info = n.info + +proc createTag(n: PNode): PNode = + result = newNode(nkType) + result.typ = sysTypeFromName"TEffect" + if not n.isNil: result.info = n.info + proc addEffect(a: PEffects, e: PNode, useLineInfo=true) = assert e.kind != nkRaiseStmt var aa = a.exc for i in a.bottom .. <aa.len: if sameType(aa[i].excType, e.excType): - if not useLineInfo: return + if not useLineInfo or gCmd == cmdDoc: return elif aa[i].info == e.info: return throws(a.exc, e) -proc mergeEffects(a: PEffects, b: PNode, useLineInfo: bool) = - if not b.isNil: - for effect in items(b): addEffect(a, effect, useLineInfo) - proc addTag(a: PEffects, e: PNode, useLineInfo=true) = var aa = a.tags for i in 0 .. <aa.len: if sameType(aa[i].typ.skipTypes(skipPtrs), e.typ.skipTypes(skipPtrs)): - if not useLineInfo: return + if not useLineInfo or gCmd == cmdDoc: return elif aa[i].info == e.info: return throws(a.tags, e) -proc mergeTags(a: PEffects, b: PNode, useLineInfo: bool) = - if not b.isNil: - for effect in items(b): addTag(a, effect, useLineInfo) +proc mergeEffects(a: PEffects, b, comesFrom: PNode) = + if b.isNil: + addEffect(a, createRaise(comesFrom)) + else: + for effect in items(b): addEffect(a, effect, useLineInfo=comesFrom != nil) + +proc mergeTags(a: PEffects, b, comesFrom: PNode) = + if b.isNil: + addTag(a, createTag(comesFrom)) + else: + for effect in items(b): addTag(a, effect, useLineInfo=comesFrom != nil) proc listEffects(a: PEffects) = for e in items(a.exc): Message(e.info, hintUser, typeToString(e.typ)) @@ -197,6 +211,8 @@ proc documentEffect(n, x: PNode, effectType: TSpecialWord, idx: int) = var t = typeToString(real[i].typ) if t.startsWith("ref "): t = substr(t, 4) effects.sons[i] = newIdentNode(getIdent(t), n.info) + # set the type so that the following analysis doesn't screw up: + effects.sons[i].typ = real[i].typ var pair = newNode(nkExprColonExpr, n.info, @[ newIdentNode(getIdent(specialWords[effectType]), n.info), effects]) @@ -208,34 +224,20 @@ proc documentEffect(n, x: PNode, effectType: TSpecialWord, idx: int) = proc documentRaises*(n: PNode) = if n.sons[namePos].kind != nkSym: return - - var x = n.sons[pragmasPos] - documentEffect(n, x, wRaises, exceptionEffects) - documentEffect(n, x, wTags, tagEffects) - -proc createRaise(n: PNode): PNode = - result = newNodeIT(nkType, n.info, sysTypeFromName"E_Base") - -proc createTag(n: PNode): PNode = - result = newNodeIT(nkType, n.info, sysTypeFromName"TEffect") + documentEffect(n, n.sons[pragmasPos], wRaises, exceptionEffects) + documentEffect(n, n.sons[pragmasPos], wTags, tagEffects) proc propagateEffects(tracked: PEffects, n: PNode, s: PSym) = let pragma = s.ast.sons[pragmasPos] let spec = effectSpec(pragma, wRaises) - if not isNil(spec): - mergeEffects(tracked, spec, useLineInfo=false) - else: - addEffect(tracked, createRaise(n)) + mergeEffects(tracked, spec, n) let tagSpec = effectSpec(pragma, wTags) - if not isNil(tagSpec): - mergeTags(tracked, tagSpec, useLineInfo=false) - else: - addTag(tracked, createTag(n)) + mergeTags(tracked, tagSpec, n) proc track(tracked: PEffects, n: PNode) = case n.kind - of nkRaiseStmt: + of nkRaiseStmt: n.sons[0].info = n.info throws(tracked.exc, n.sons[0]) of nkCallKinds: @@ -254,8 +256,8 @@ proc track(tracked: PEffects, n: PNode) = addEffect(tracked, createRaise(n)) addTag(tracked, createTag(n)) else: - mergeEffects(tracked, effectList.sons[exceptionEffects], true) - mergeTags(tracked, effectList.sons[tagEffects], true) + mergeEffects(tracked, effectList.sons[exceptionEffects], n) + mergeTags(tracked, effectList.sons[tagEffects], n) of nkTryStmt: trackTryStmt(tracked, n) return @@ -346,3 +348,4 @@ proc trackProc*(s: PSym, body: PNode) = hints=off) # after the check, use the formal spec: effects.sons[tagEffects] = tagsSpec + \ No newline at end of file diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index b0cef2df7..52d922b2d 100755 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -237,7 +237,9 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = if c.InUnrolledContext > 0: v.flags.incl(sfShadowed) else: let shadowed = findShadowedVar(c, v) - if shadowed != nil: shadowed.flags.incl(sfShadowed) + if shadowed != nil: + shadowed.flags.incl(sfShadowed) + Message(a.info, warnShadowIdent, v.name.s) if def != nil and def.kind != nkEmpty: # this is only needed for the evaluation pass: v.ast = def @@ -245,6 +247,9 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = if a.kind != nkVarTuple: v.typ = typ b = newNodeI(nkIdentDefs, a.info) + if gCmd == cmdDoc: + # keep documentation information: + b.comment = a.comment addSon(b, newSymNode(v)) addSon(b, a.sons[length-2]) # keep type desc for doc generator addSon(b, copyTree(def)) @@ -282,6 +287,7 @@ proc semConst(c: PContext, n: PNode): PNode = v.ast = def # no need to copy if sfGenSym notin v.flags: addInterfaceDecl(c, v) var b = newNodeI(nkConstDef, a.info) + if gCmd == cmdDoc: b.comment = a.comment addSon(b, newSymNode(v)) addSon(b, ast.emptyNode) # no type description addSon(b, copyTree(def)) @@ -752,6 +758,8 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, addInterfaceDeclAt(c, s, c.tab.tos - 2) if n.sons[pragmasPos].kind != nkEmpty: pragma(c, s, n.sons[pragmasPos], validPragmas) + else: + implictPragmas(c, s, n, validPragmas) else: if n.sons[pragmasPos].kind != nkEmpty: LocalError(n.sons[pragmasPos].info, errPragmaOnlyInHeaderOfProc) diff --git a/compiler/semthreads.nim b/compiler/semthreads.nim index 6c0259ef1..75621be79 100755 --- a/compiler/semthreads.nim +++ b/compiler/semthreads.nim @@ -184,8 +184,9 @@ proc analyseCall(c: PProcCtx, n: PNode): TThreadOwner = call.args[i-1] = analyse(c, n[i]) if not computed.hasKey(call): computed[call] = toUndefined # we are computing it - for i in 1..n.len-1: - var formal = skipTypes(prc.typ, abstractInst).n.sons[i].sym + let prctyp = skipTypes(prc.typ, abstractInst).n + for i in 1.. prctyp.len-1: + var formal = prctyp.sons[i].sym newCtx.mapping[formal.id] = call.args[i-1] pushInfoContext(n.info) result = analyse(newCtx, prc.getBody) @@ -226,7 +227,8 @@ proc analyseVarSection(c: PProcCtx, n: PNode): TThreadOwner = var a = n.sons[i] if a.kind == nkCommentStmt: continue if a.kind == nkIdentDefs: - assert(a.sons[0].kind == nkSym) + #assert(a.sons[0].kind == nkSym); also valid for after + # closure transformation: analyseSingleVar(c, a) else: analyseVarTuple(c, a) @@ -359,9 +361,11 @@ proc analyse(c: PProcCtx, n: PNode): TThreadOwner = of nkReturnStmt, nkDiscardStmt: if n.sons[0].kind != nkEmpty: result = analyse(c, n.sons[0]) else: result = toVoid + of nkLambdaKinds, nkClosure: + result = toMine of nkAsmStmt, nkPragma, nkIteratorDef, nkProcDef, nkMethodDef, - nkConverterDef, nkMacroDef, nkTemplateDef, nkLambdaKinds, nkClosure, - nkGotoState, nkState: + nkConverterDef, nkMacroDef, nkTemplateDef, + nkGotoState, nkState, nkBreakState, nkType: result = toVoid of nkExprColonExpr: result = analyse(c, n.sons[1]) diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index 6716693ca..ab80298de 100755 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -882,7 +882,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkPtrTy: result = semAnyRef(c, n, tyPtr, prev) of nkVarTy: result = semVarType(c, n, prev) of nkDistinctTy: result = semDistinct(c, n, prev) - of nkProcTy: + of nkProcTy, nkIteratorTy: if n.sonsLen == 0: return newConstraint(c, tyProc) checkSonsLen(n, 2) openScope(c.tab) diff --git a/compiler/transf.nim b/compiler/transf.nim index d28b9b21d..dfa4095b4 100755 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -150,6 +150,9 @@ proc transformVarSection(c: PTransf, v: PNode): PTransNode = newVar.owner = getCurrOwner(c) IdNodeTablePut(c.transCon.mapping, it.sons[0].sym, newSymNode(newVar)) var defs = newTransNode(nkIdentDefs, it.info, 3) + if gCmd == cmdDoc: + # keep documentation information: + pnode(defs).comment = it.comment defs[0] = newSymNode(newVar).PTransNode defs[1] = it.sons[1].PTransNode defs[2] = transform(c, it.sons[2]) @@ -659,6 +662,11 @@ proc transform(c: PTransf, n: PNode): PTransNode = result = transformSons(c, n) of nkBlockStmt, nkBlockExpr: result = transformBlock(c, n) + of nkIdentDefs, nkConstDef: + result = transformSons(c, n) + # XXX comment handling really sucks: + if gCmd == cmdDoc: + pnode(result).comment = n.comment else: result = transformSons(c, n) var cnst = getConstExpr(c.module, PNode(result)) diff --git a/compiler/treetab.nim b/compiler/treetab.nim index 66f7475f6..75e3fd20a 100755 --- a/compiler/treetab.nim +++ b/compiler/treetab.nim @@ -22,7 +22,7 @@ proc hashTree(n: PNode): THash = result = result !& n.ident.h of nkSym: result = result !& n.sym.name.h - of nkCharLit..nkInt64Lit: + of nkCharLit..nkUInt64Lit: if (n.intVal >= low(int)) and (n.intVal <= high(int)): result = result !& int(n.intVal) of nkFloatLit..nkFloat64Lit: @@ -42,7 +42,7 @@ proc TreesEquivalent(a, b: PNode): bool = of nkEmpty, nkNilLit, nkType: result = true of nkSym: result = a.sym.id == b.sym.id of nkIdent: result = a.ident.id == b.ident.id - of nkCharLit..nkInt64Lit: result = a.intVal == b.intVal + of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal else: diff --git a/compiler/types.nim b/compiler/types.nim index afc05d773..dbd03620c 100755 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -339,9 +339,11 @@ proc canFormAcycleAux(marker: var TIntSet, typ: PType, startId: int): bool = if t.n != nil: result = canFormAcycleNode(marker, t.n, startId) else: result = t.id == startId - if t.kind == tyObject and tfFinal notin t.flags: - # damn inheritance may introduce cycles: - result = true + # Inheritance can introduce cyclic types, however this is not relevant + # as the type that is passed to 'new' is statically known! + #if t.kind == tyObject and tfFinal notin t.flags: + # # damn inheritance may introduce cycles: + # result = true else: nil proc canFormAcycle(typ: PType): bool = @@ -410,7 +412,7 @@ proc TypeToString(typ: PType, prefer: TPreferedDesc = preferName): string = "float", "float32", "float64", "float128", "uint", "uint8", "uint16", "uint32", "uint64", "bignum", "const ", - "!", "varargs[$1]", "iter[$1]", "Error Type", "TypeClass" ] + "!", "varargs[$1]", "iter[$1]", "Error Type", "TypeClass"] var t = typ result = "" if t == nil: return @@ -476,8 +478,8 @@ proc TypeToString(typ: PType, prefer: TPreferedDesc = preferName): string = result = typeToStr[t.kind] & typeToString(t.sons[0]) of tyRange: result = "range " & rangeToStr(t.n) - of tyProc: - result = "proc (" + of tyProc: + result = if tfIterator in t.flags: "iterator (" else: "proc (" for i in countup(1, sonsLen(t) - 1): add(result, typeToString(t.sons[i])) if i < sonsLen(t) - 1: add(result, ", ") @@ -497,6 +499,8 @@ proc TypeToString(typ: PType, prefer: TPreferedDesc = preferName): string = result = typeToStr[t.kind] % typeToString(t.sons[0]) else: result = typeToStr[t.kind] + if tfShared in t.flags: result = "shared " & result + if tfNotNil in t.flags: result.add(" not nil") proc resultType(t: PType): PType = assert(t.kind == tyProc) diff --git a/compiler/wordrecg.nim b/compiler/wordrecg.nim index 1cc3269dd..3ad2f45ca 100755 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -30,7 +30,7 @@ type wInclude, wInterface, wIs, wIsnot, wIterator, wLambda, wLet, wMacro, wMethod, wMixin, wMod, wNil, wNot, wNotin, wObject, wOf, wOr, wOut, wProc, wPtr, wRaise, wRef, wReturn, - wShl, wShr, wStatic, wTemplate, wTry, wTuple, wType, wVar, + wShared, wShl, wShr, wStatic, wTemplate, wTry, wTuple, wType, wVar, wWhen, wWhile, wWith, wWithout, wXor, wYield, wColon, wColonColon, wEquals, wDot, wDotDot, @@ -108,7 +108,8 @@ const "lambda", "let", "macro", "method", "mixin", "mod", "nil", "not", "notin", "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", "shl", "shr", "static", + "out", "proc", "ptr", "raise", "ref", "return", + "shared", "shl", "shr", "static", "template", "try", "tuple", "type", "var", "when", "while", "with", "without", "xor", "yield", diff --git a/doc/advopt.txt b/doc/advopt.txt index dba0a009a..a6718572e 100755 --- a/doc/advopt.txt +++ b/doc/advopt.txt @@ -49,6 +49,7 @@ Advanced options: (you should omit platform-specific extensions) --genMapping generate a mapping file containing (Nimrod, mangled) identifier pairs + --project document the whole project (doc2) --lineDir:on|off generation of #line directive on|off --threadanalysis:on|off turn thread analysis on|off --tlsEmulation:on|off turn thread local storage emulation on|off diff --git a/doc/grammar.txt b/doc/grammar.txt index 1e54d1116..2474b584e 100755 --- a/doc/grammar.txt +++ b/doc/grammar.txt @@ -70,7 +70,8 @@ exprOrType ::= lowestExpr | 'tuple' tupleDesc expr ::= exprOrType - | 'proc' paramList [pragma] ['=' stmt] + | 'proc' paramList [pragma] ['=' stmt] + | 'iterator' paramList [pragma] ['=' stmt] exprList ::= [expr (comma expr)* [comma]] @@ -79,6 +80,7 @@ qualifiedIdent ::= symbol ['.' symbol] typeDesc ::= exprOrType | 'proc' paramList [pragma] + | 'iterator' paramList [pragma] macroStmt ::= ':' [stmt] ('of' [exprList] ':' stmt |'elif' expr ':' stmt @@ -146,7 +148,7 @@ param ::= symbol (comma symbol)* (':' typeDesc ['=' expr] | '=' expr) paramList ::= ['(' [param (comma|semicolon param)*] optPar ')'] [':' typeDesc] genericConstraint ::= 'object' | 'tuple' | 'enum' | 'proc' | 'ref' | 'ptr' - | 'var' | 'distinct' | primary + | 'var' | 'distinct' | 'iterator' | primary genericConstraints ::= genericConstraint ( '|' optInd genericConstraint )* genericParam ::= symbol [':' genericConstraints] ['=' expr] diff --git a/doc/keywords.txt b/doc/keywords.txt index 03e9cc6fd..2a775cd94 100755 --- a/doc/keywords.txt +++ b/doc/keywords.txt @@ -12,7 +12,7 @@ nil not notin object of or out proc ptr raise ref return -shl shr static +shared shl shr static template try tuple type var when while with without diff --git a/doc/nimrodc.txt b/doc/nimrodc.txt index 8e43ce32c..06a0f4500 100755 --- a/doc/nimrodc.txt +++ b/doc/nimrodc.txt @@ -36,6 +36,38 @@ Advanced command line switches are: .. include:: advopt.txt + + +List of warnings +---------------- + +Each warning can be activated individually with ``--warning[NAME]:on|off`` or +in a ``push`` pragma. + +========================== ============================================ +Name Description +========================== ============================================ +CannotOpenFile Some file not essential for the compiler's + working could not be opened. +OctalEscape The code contains an unsupported octal + sequence. +Deprecated The code uses a deprecated symbol. +ConfigDeprecated The project makes use of a deprecated config + file. +SmallLshouldNotBeUsed The letter 'l' should not be used as an + identifier. +AnalysisLoophole The thread analysis was incomplete due to + an indirect call. +DifferentHeaps The code mixes different local heaps in a + very dangerous way. +WriteToForeignHeap The code contains a threading error. +EachIdentIsTuple The code contains a confusing ``var`` + declaration. +ShadowIdent A local variable shadows another local + variable of an outer scope. +User Some user defined warning. +========================== ============================================ + Configuration files ------------------- diff --git a/lib/core/macros.nim b/lib/core/macros.nim index b80de27fa..966a21a1b 100755 --- a/lib/core/macros.nim +++ b/lib/core/macros.nim @@ -53,7 +53,10 @@ type nnkRefTy, nnkPtrTy, nnkVarTy, nnkConstTy, nnkMutableTy, nnkDistinctTy, - nnkProcTy, nnkEnumTy, + nnkProcTy, + nnkIteratorTy, # iterator type + nnkSharedTy, # 'shared T' + nnkEnumTy, nnkEnumFieldDef, nnkArglist, nnkPattern nnkReturnToken diff --git a/lib/core/typeinfo.nim b/lib/core/typeinfo.nim index 3032ccb19..26a14f444 100755 --- a/lib/core/typeinfo.nim +++ b/lib/core/typeinfo.nim @@ -198,6 +198,13 @@ proc len*(x: TAny): int = of tySequence: result = cast[PGenSeq](cast[ppointer](x.value)[]).len else: assert false + +proc base*(x: TAny): TAny = + ## returns base TAny (useful for inherited object types). + result.rawType = x.rawType.base + result.value = x.value + + proc isNil*(x: TAny): bool = ## `isNil` for an any `x` that represents a sequence, string, cstring, ## proc or some pointer type. diff --git a/lib/ecmas/dom.nim b/lib/ecmas/dom.nim index 1ee8f9ace..2fb2085b4 100755 --- a/lib/ecmas/dom.nim +++ b/lib/ecmas/dom.nim @@ -1,7 +1,7 @@ # # # Nimrod's Runtime Library -# (c) Copyright 2010 Andreas Rumpf +# (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,7 +9,7 @@ ## Declaration of the Document Object Model for the ECMAScript backend. -when not defined(ecmascript): +when not defined(ecmascript) and not defined(Nimdoc): {.error: "This module only works on the ECMAScript platform".} type diff --git a/lib/impure/db_mongo.nim b/lib/impure/db_mongo.nim index b7fb325f9..b11db78f8 100644 --- a/lib/impure/db_mongo.nim +++ b/lib/impure/db_mongo.nim @@ -34,8 +34,8 @@ type TDbConn* = TMongo ## a database connection; alias for ``TMongo`` FDb* = object of FIO ## effect that denotes a database operation - FReadDb* = object of FReadIO ## effect that denotes a read operation - FWriteDb* = object of FWriteIO ## effect that denotes a write operation + FReadDb* = object of FDB ## effect that denotes a read operation + FWriteDb* = object of FDB ## effect that denotes a write operation proc dbError*(db: TDbConn, msg: string) {.noreturn.} = ## raises an EDb exception with message `msg`. diff --git a/lib/impure/db_mysql.nim b/lib/impure/db_mysql.nim index 41b3dc3bc..91cf8a5eb 100755 --- a/lib/impure/db_mysql.nim +++ b/lib/impure/db_mysql.nim @@ -21,8 +21,8 @@ type TSqlQuery* = distinct string ## an SQL query string FDb* = object of FIO ## effect that denotes a database operation - FReadDb* = object of FReadIO ## effect that denotes a read operation - FWriteDb* = object of FWriteIO ## effect that denotes a write operation + FReadDb* = object of FDb ## effect that denotes a read operation + FWriteDb* = object of FDb ## effect that denotes a write operation proc dbError(db: TDbConn) {.noreturn.} = ## raises an EDb exception. diff --git a/lib/impure/db_postgres.nim b/lib/impure/db_postgres.nim index b8d21d795..2dd55e05f 100755 --- a/lib/impure/db_postgres.nim +++ b/lib/impure/db_postgres.nim @@ -21,8 +21,8 @@ type TSqlQuery* = distinct string ## an SQL query string FDb* = object of FIO ## effect that denotes a database operation - FReadDb* = object of FReadIO ## effect that denotes a read operation - FWriteDb* = object of FWriteIO ## effect that denotes a write operation + FReadDb* = object of FDB ## effect that denotes a read operation + FWriteDb* = object of FDB ## effect that denotes a write operation proc sql*(query: string): TSqlQuery {.noSideEffect, inline.} = ## constructs a TSqlQuery from the string `query`. This is supposed to be diff --git a/lib/impure/db_sqlite.nim b/lib/impure/db_sqlite.nim index 33b957a6b..693077553 100755 --- a/lib/impure/db_sqlite.nim +++ b/lib/impure/db_sqlite.nim @@ -21,8 +21,8 @@ type TSqlQuery* = distinct string ## an SQL query string FDb* = object of FIO ## effect that denotes a database operation - FReadDb* = object of FReadIO ## effect that denotes a read operation - FWriteDb* = object of FWriteIO ## effect that denotes a write operation + FReadDb* = object of FDB ## effect that denotes a read operation + FWriteDb* = object of FDB ## effect that denotes a write operation proc sql*(query: string): TSqlQuery {.noSideEffect, inline.} = ## constructs a TSqlQuery from the string `query`. This is supposed to be diff --git a/lib/nimbase.h b/lib/nimbase.h index 74dd931e6..7fb70a60c 100755 --- a/lib/nimbase.h +++ b/lib/nimbase.h @@ -143,7 +143,7 @@ __clang__ #define N_NOINLINE_PTR(rettype, name) rettype (*name) #if defined(__BORLANDC__) || defined(__WATCOMC__) || \ - defined(__POCC__) || defined(_MSC_VER) + defined(__POCC__) || defined(_MSC_VER) || defined(WIN32) || defined(_WIN32) /* these compilers have a fastcall so use it: */ # define N_NIMCALL(rettype, name) rettype __fastcall name # define N_NIMCALL_PTR(rettype, name) rettype (__fastcall *name) diff --git a/lib/pure/sockets.nim b/lib/pure/sockets.nim index 328f9cb9e..371641b06 100755 --- a/lib/pure/sockets.nim +++ b/lib/pure/sockets.nim @@ -473,7 +473,9 @@ proc acceptAddr*(server: TSocket, client: var TSocket, address: var string) {. else: SSLError("Unknown error") -proc setBlocking*(s: TSocket, blocking: bool) +proc setBlocking*(s: TSocket, blocking: bool) {.tags: [].} + ## sets blocking mode on socket + when defined(ssl): proc acceptAddrSSL*(server: TSocket, client: var TSocket, address: var string): TSSLAcceptResult {. @@ -762,7 +764,7 @@ proc connectAsync*(socket: TSocket, name: string, port = TPort(0), socket.sslNoHandshake = true when defined(ssl): - proc handshake*(socket: TSocket): bool {.tags: [FReadIO, RWriteIO].} = + proc handshake*(socket: TSocket): bool {.tags: [FReadIO, FWriteIO].} = ## This proc needs to be called on a socket after it connects. This is ## only applicable when using ``connectAsync``. ## This proc performs the SSL handshake. @@ -1297,6 +1299,8 @@ proc send*(socket: TSocket, data: pointer, size: int): int {. when defined(windows) or defined(macosx): result = send(socket.fd, data, size.cint, 0'i32) else: + when defined(solaris): + const MSG_NOSIGNAL = 0 result = send(socket.fd, data, size, int32(MSG_NOSIGNAL)) proc send*(socket: TSocket, data: string) {.tags: [FWriteIO].} = @@ -1392,8 +1396,7 @@ when defined(Windows): argptr: ptr clong): cint {. stdcall, importc:"ioctlsocket", dynlib: "ws2_32.dll".} -proc setBlocking*(s: TSocket, blocking: bool) = - ## sets blocking mode on socket +proc setBlocking(s: TSocket, blocking: bool) = when defined(Windows): var mode = clong(ord(not blocking)) # 1 for non-blocking, 0 for blocking if SOCKET_ERROR == ioctlsocket(TWinSocket(s.fd), FIONBIO, addr(mode)): diff --git a/lib/pure/times.nim b/lib/pure/times.nim index b0ce2454c..d84fbbb67 100755 --- a/lib/pure/times.nim +++ b/lib/pure/times.nim @@ -684,12 +684,14 @@ when isMainModule: " ss t tt y yy yyy yyyy yyyyy z zz zzz ZZZ") == "27 27 Mon Monday 4 04 16 16 6 06 1 01 Jan January 29 29 P PM 5 75 975 1975 01975 0 00 00:00 UTC" - var t3 = getGMTime(TTime(889067643645)) # Fri 7 Jun 19:20:45 BST 30143 - assert t3.format("d dd ddd dddd h hh H HH m mm M MM MMM MMMM s" & - " ss t tt y yy yyy yyyy yyyyy z zz zzz ZZZ") == - "7 07 Fri Friday 6 06 18 18 20 20 6 06 Jun June 45 45 P PM 3 43 143 0143 30143 0 00 00:00 UTC" + when sizeof(TTime) == 8: + var t3 = getGMTime(TTime(889067643645)) # Fri 7 Jun 19:20:45 BST 30143 + assert t3.format("d dd ddd dddd h hh H HH m mm M MM MMM MMMM s" & + " ss t tt y yy yyy yyyy yyyyy z zz zzz ZZZ") == + "7 07 Fri Friday 6 06 18 18 20 20 6 06 Jun June 45 45 P PM 3 43 143 0143 30143 0 00 00:00 UTC" + assert t3.format(":,[]()-/") == ":,[]()-/" var t4 = getGMTime(TTime(876124714)) # Mon 6 Oct 08:58:34 BST 1997 assert t4.format("M MM MMM MMMM") == "10 10 Oct October" - assert t3.format(":,[]()-/") == ":,[]()-/" \ No newline at end of file + \ No newline at end of file diff --git a/lib/system.nim b/lib/system.nim index d4c7aaf5e..9ad99fb79 100755 --- a/lib/system.nim +++ b/lib/system.nim @@ -246,7 +246,7 @@ type EInvalidLibrary* = object of EOS ## raised if a dynamic library ## could not be loaded. EResourceExhausted* = object of ESystem ## raised if a resource request - ## could not be fullfilled. + ## could not be fullfilled. EArithmetic* = object of ESynch ## raised if any kind of arithmetic ## error occured. EDivByZero* {.compilerproc.} = @@ -847,7 +847,12 @@ when taintMode: proc len*(s: TaintedString): int {.borrow.} else: - type TaintedString* = string + type TaintedString* = string ## a distinct string type that + ## is `tainted`:idx:. It is an alias for + ## ``string`` if the taint mode is not + ## turned on. Use the ``-d:taintMode`` + ## command line switch to turn the taint + ## mode on. when defined(profiler): proc nimProfile() {.compilerProc, noinline.} @@ -1817,8 +1822,7 @@ when not defined(EcmaScript) and not defined(NimrodVM): ## Returns true iff `f` is at the end. proc readChar*(f: TFile): char {.importc: "fgetc", nodecl, tags: [FReadIO].} - ## Reads a single character from the stream `f`. If the stream - ## has no more characters, `EEndOfFile` is raised. + ## Reads a single character from the stream `f`. proc FlushFile*(f: TFile) {.importc: "fflush", noDecl, tags: [FWriteIO].} ## Flushes `f`'s buffer. @@ -2317,10 +2321,11 @@ proc raiseAssert*(msg: string) {.noinline.} = raise newException(EAssertionFailed, msg) when true: - proc hiddenRaiseAssert(msg: string) {.raises: [].} = + proc hiddenRaiseAssert(msg: string) {.raises: [], tags: [].} = # trick the compiler to not list ``EAssertionFailed`` when called # by ``assert``. - type THide = proc (msg: string) {.noinline, raises: [], noSideEffect.} + type THide = proc (msg: string) {.noinline, raises: [], noSideEffect, + tags: [].} THide(raiseAssert)(msg) template assert*(cond: bool, msg = "") = diff --git a/lib/system/ansi_c.nim b/lib/system/ansi_c.nim index 486f5dd26..195bc2e60 100755 --- a/lib/system/ansi_c.nim +++ b/lib/system/ansi_c.nim @@ -35,12 +35,13 @@ var c_stderr {.importc: "stderr", noDecl.}: C_TextFileStar # constants faked as variables: -var - SIGINT {.importc: "SIGINT", nodecl.}: cint - SIGSEGV {.importc: "SIGSEGV", nodecl.}: cint - SIGABRT {.importc: "SIGABRT", nodecl.}: cint - SIGFPE {.importc: "SIGFPE", nodecl.}: cint - SIGILL {.importc: "SIGILL", nodecl.}: cint +when not defined(SIGINT): + var + SIGINT {.importc: "SIGINT", nodecl.}: cint + SIGSEGV {.importc: "SIGSEGV", nodecl.}: cint + SIGABRT {.importc: "SIGABRT", nodecl.}: cint + SIGFPE {.importc: "SIGFPE", nodecl.}: cint + SIGILL {.importc: "SIGILL", nodecl.}: cint when defined(macosx): var @@ -95,7 +96,8 @@ proc c_malloc(size: int): pointer {.importc: "malloc", nodecl.} proc c_free(p: pointer) {.importc: "free", nodecl.} proc c_realloc(p: pointer, newsize: int): pointer {.importc: "realloc", nodecl.} -var errno {.importc, header: "<errno.h>".}: cint ## error variable +when not defined(errno): + var errno {.importc, header: "<errno.h>".}: cint ## error variable proc strerror(errnum: cint): cstring {.importc, header: "<string.h>".} proc c_remove(filename: CString): cint {.importc: "remove", noDecl.} diff --git a/packages/docutils/rst.nim b/packages/docutils/rst.nim index 7507e1596..f594a39f5 100755 --- a/packages/docutils/rst.nim +++ b/packages/docutils/rst.nim @@ -672,7 +672,7 @@ when false: add(n, newLeaf(p)) inc(p.idx) add(father, n) - elif not verbatim and roSupportSmilies in p.shared.options: + elif not verbatim and roSupportSmilies in p.sharedState.options: let n = parseSmiley(p) if s != nil: add(father, n) diff --git a/tests/gc/cycleleak.nim b/tests/gc/cycleleak.nim new file mode 100644 index 000000000..0a0f2c540 --- /dev/null +++ b/tests/gc/cycleleak.nim @@ -0,0 +1,42 @@ +discard """ + outputsub: "no leak: " +""" + +type + Module = object + nodes*: seq[PNode] + + PModule = ref Module + + Node = object + owner*: PModule + data*: array[0..200, char] # some fat to drain memory faster + + PNode = ref Node + +proc newNode(owner: PModule): PNode = + new(result) + result.owner = owner + +proc compileModule: PModule = + new(result) + result.nodes = @[] + for i in 0..100: + result.nodes.add newNode(result) + +var gModuleCache: PModule + +proc loop = + for i in 0..10000: + gModuleCache = compileModule() + gModuleCache = nil + GC_fullCollect() + + if getOccupiedMem() > 300_000: + echo "still a leak! ", getOccupiedMem() + quit(1) + else: + echo "no leak: ", getOccupiedMem() + +loop() + diff --git a/tests/gc/stackrefleak.nim b/tests/gc/stackrefleak.nim new file mode 100644 index 000000000..2c652d6bf --- /dev/null +++ b/tests/gc/stackrefleak.nim @@ -0,0 +1,33 @@ +discard """ + outputsub: "no leak: " +""" + +type + Cyclic = object + sibling: PCyclic + data: array[0..200, char] + + PCyclic = ref Cyclic + +proc makePair: PCyclic = + new(result) + new(result.sibling) + result.sibling.sibling = result + +proc loop = + for i in 0..10000: + var x = makePair() + GC_fullCollect() + x = nil + GC_fullCollect() + + if getOccupiedMem() > 300_000: + echo "still a leak! ", getOccupiedMem() + quit(1) + else: + echo "no leak: ", getOccupiedMem() + +loop() + + + diff --git a/tests/run/tinterf.nim b/tests/run/tinterf.nim index 648873da0..726fac9f6 100644 --- a/tests/run/tinterf.nim +++ b/tests/run/tinterf.nim @@ -9,12 +9,12 @@ type getter2: proc(): int {.closure.}] proc getInterf(): ITest = - var shared, shared2: int + var shared1, shared2: int return (setter: proc (x: int) = - shared = x + shared1 = x shared2 = x + 10, - getter1: proc (): int = result = shared, + getter1: proc (): int = result = shared1, getter2: proc (): int = return shared2) var i = getInterf() diff --git a/tests/tester.nim b/tests/tester.nim index 259330805..8156dab7f 100755 --- a/tests/tester.nim +++ b/tests/tester.nim @@ -56,7 +56,8 @@ proc extractSpec(filename: string): string = var x = readFile(filename).string var a = x.find(tripleQuote) var b = x.find(tripleQuote, a+3) - if a >= 0 and b > a: + # look for """ only in the first section + if a >= 0 and b > a and a < 40: result = x.substr(a+3, b-1).replace("'''", tripleQuote) else: #echo "warning: file does not contain spec: " & filename diff --git a/todo.txt b/todo.txt index f31edfa39..9ee49b4f2 100755 --- a/todo.txt +++ b/todo.txt @@ -1,16 +1,11 @@ version 0.9.2 ============= - -- improve 'doc2': - * respect output directory - * write only 1 file unless requested 'whole project' - * make it work for the 'system' module - * the documentation system should default to 'doc2' + - test&finish first class iterators: + * tyIterator: implement nkIteratorTy, nkSharedTy * allow return in first class iterators * nested iterators * arglist as a type? - * tyIterator? - fix closure bug finally - overloading based on ASTs: 'constraint' should not be in PType but for the @@ -82,9 +77,7 @@ version 0.9.XX - macros need access to types and symbols (partially implemented) - document nimdoc properly finally - make 'clamp' a magic for the range stuff -- implement a warning message for shadowed 'result' variable - we need to support iteration of 2 different data structures in parallel -- implement proper coroutines - proc specialization in the code gen for write barrier specialization - tlastmod returns wrong results on BSD (Linux, MacOS X: works) - nested tuple unpacking; tuple unpacking in non-var-context @@ -152,7 +145,8 @@ Version 2 and beyond "stop the world". However, it may be worthwhile to generate explicit (or implicit) syncGC() calls in loops. Automatic loop injection seems troublesome, but maybe we can come up with a simple heuristic. (All procs - that `new` shared memory are syncGC() candidates...) + that `new` shared memory are syncGC() candidates... But then 'new' itself + calls syncGC() so that's pointless.) - const ptr/ref --> pointless because of aliasing; much better: 'writes: []' effect diff --git a/web/news.txt b/web/news.txt index b73a32268..5ea0dfde9 100755 --- a/web/news.txt +++ b/web/news.txt @@ -22,11 +22,17 @@ Library Additions Changes affecting backwards compatibility ----------------------------------------- +- ``shared`` is a keyword now. Compiler Additions ------------------ +- The ``doc2`` command does not generate output for the whole project anymore. + Use the new ``--project`` switch to enable this behaviour. +- The compiler can now warn about shadowed local variables. However, this needs + to be turned on explicitly via ``--warning[ShadowIdent]:on``. +- The compiler now supports almost every pragma in a ``push`` pragma. Language Additions diff --git a/web/nimrod.ini b/web/nimrod.ini index 047677ae5..0a26138a6 100755 --- a/web/nimrod.ini +++ b/web/nimrod.ini @@ -25,28 +25,28 @@ file: ticker doc: "endb;intern;apis;lib;manual;tut1;tut2;nimrodc;overview;filters;trmacros" doc: "tools;c2nim;niminst;nimgrep;gc;estp" pdf: "manual;lib;tut1;tut2;nimrodc;c2nim;niminst;gc" -srcdoc2: "impure/graphics;wrappers/sdl" -srcdoc: "core/macros;pure/marshal;core/typeinfo;core/unsigned" -srcdoc: "impure/re;pure/sockets" -srcdoc: "system.nim;system/threads.nim;system/channels.nim" -srcdoc: "pure/os;pure/strutils;pure/math;pure/matchers;pure/algorithm" -srcdoc: "pure/complex;pure/times;pure/osproc;pure/pegs;pure/dynlib" -srcdoc: "pure/parseopt;pure/hashes;pure/strtabs;pure/lexbase" -srcdoc: "pure/parsecfg;pure/parsexml;pure/parsecsv;pure/parsesql" -srcdoc: "pure/streams;pure/terminal;pure/cgi;impure/web;pure/unicode" -srcdoc: "impure/zipfiles;pure/htmlgen;pure/parseutils;pure/browsers" -srcdoc: "impure/db_postgres;impure/db_mysql;impure/db_sqlite;impure/db_mongo" -srcdoc: "pure/httpserver;pure/httpclient;pure/smtp;impure/ssl;pure/fsmonitor" -srcdoc: "pure/ropes;pure/unidecode/unidecode;pure/xmldom;pure/xmldomparser" -srcdoc: "pure/xmlparser;pure/htmlparser;pure/xmltree;pure/colors;pure/mimetypes" -srcdoc: "pure/json;pure/base64;pure/scgi;pure/redis;impure/graphics" -srcdoc: "impure/rdstdin;wrappers/zmq;wrappers/sphinx" -srcdoc: "pure/collections/tables;pure/collections/sets;pure/collections/lists" -srcdoc: "pure/collections/intsets;pure/collections/queues;pure/encodings" -srcdoc: "pure/events;pure/collections/sequtils;pure/irc;ecmas/dom;pure/cookies" -srcdoc: "pure/ftpclient;pure/memfiles;pure/subexes;pure/collections/critbits" -srcdoc: "pure/asyncio;pure/actors;core/locks;pure/oids;pure/endians;pure/uri" -srcdoc: "pure/nimprof" +srcdoc2: "system.nim;impure/graphics;wrappers/sdl" +srcdoc2: "core/macros;pure/marshal;core/typeinfo;core/unsigned" +srcdoc2: "impure/re;pure/sockets" +srcdoc: "system/threads.nim;system/channels.nim;ecmas/dom" +srcdoc2: "pure/os;pure/strutils;pure/math;pure/matchers;pure/algorithm" +srcdoc2: "pure/complex;pure/times;pure/osproc;pure/pegs;pure/dynlib" +srcdoc2: "pure/parseopt;pure/hashes;pure/strtabs;pure/lexbase" +srcdoc2: "pure/parsecfg;pure/parsexml;pure/parsecsv;pure/parsesql" +srcdoc2: "pure/streams;pure/terminal;pure/cgi;impure/web;pure/unicode" +srcdoc2: "impure/zipfiles;pure/htmlgen;pure/parseutils;pure/browsers" +srcdoc2: "impure/db_postgres;impure/db_mysql;impure/db_sqlite;impure/db_mongo" +srcdoc2: "pure/httpserver;pure/httpclient;pure/smtp;impure/ssl;pure/fsmonitor" +srcdoc2: "pure/ropes;pure/unidecode/unidecode;pure/xmldom;pure/xmldomparser" +srcdoc2: "pure/xmlparser;pure/htmlparser;pure/xmltree;pure/colors;pure/mimetypes" +srcdoc2: "pure/json;pure/base64;pure/scgi;pure/redis;impure/graphics" +srcdoc2: "impure/rdstdin;wrappers/zmq;wrappers/sphinx" +srcdoc2: "pure/collections/tables;pure/collections/sets;pure/collections/lists" +srcdoc2: "pure/collections/intsets;pure/collections/queues;pure/encodings" +srcdoc2: "pure/events;pure/collections/sequtils;pure/irc;pure/cookies" +srcdoc2: "pure/ftpclient;pure/memfiles;pure/subexes;pure/collections/critbits" +srcdoc2: "pure/asyncio;pure/actors;core/locks;pure/oids;pure/endians;pure/uri" +srcdoc2: "pure/nimprof" webdoc: "wrappers/libcurl;pure/md5;wrappers/mysql;wrappers/iup" webdoc: "wrappers/sqlite3;wrappers/postgres;wrappers/tinyc" diff --git a/web/question.txt b/web/question.txt index 8e301b6bd..ebdcc091c 100755 --- a/web/question.txt +++ b/web/question.txt @@ -72,7 +72,7 @@ statements. How fast is Nimrod? ------------------- Benchmarks show it to be comparable to C. Some language features (methods, -closures, RTTI) are not yet as optimized as they could and will be. +closures, message passing) are not yet as optimized as they could and will be. The only overhead Nimrod has over C is the GC which has been tuned for years but still needs some work. |