implemented 'tags' pragma

9 files changed, 193 insertions, 88 deletions

diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim
index 65574e80e..f874a0acf 100755
--- a/compiler/pragmas.nim
+++ b/compiler/pragmas.nim
@@ -24,7 +24,7 @@ const
     wCompilerProc, wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, 
     wBorrow, wExtern, wImportCompilerProc, wThread, wImportCpp, wImportObjC,
     wNoStackFrame, wError, wDiscardable, wNoInit, wDestructor, wHoist,
-    wGenSym, wInject, wRaises}
+    wGenSym, wInject, wRaises, wTags}
   converterPragmas* = procPragmas
   methodPragmas* = procPragmas
   templatePragmas* = {wImmediate, wDeprecated, wError, wGenSym, wInject, wDirty}
@@ -33,7 +33,8 @@ const
     wImportcpp, wImportobjc, wError, wDiscardable, wGenSym, wInject}
   iteratorPragmas* = {FirstCallConv..LastCallConv, wNosideEffect, wSideEffect, 
     wImportc, wExportc, wNodecl, wMagic, wDeprecated, wBorrow, wExtern,
-    wImportcpp, wImportobjc, wError, wDiscardable, wGenSym, wInject, wRaises}
+    wImportcpp, wImportobjc, wError, wDiscardable, wGenSym, wInject, wRaises,
+    wTags}
   exprPragmas* = {wLine}
   stmtPragmas* = {wChecks, wObjChecks, wFieldChecks, wRangechecks,
     wBoundchecks, wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints,
@@ -45,7 +46,7 @@ const
   lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, 
     wNosideEffect, wSideEffect, wNoreturn, wDynLib, wHeader, 
     wDeprecated, wExtern, wThread, wImportcpp, wImportobjc, wNoStackFrame,
-    wRaises}
+    wRaises, wTags}
   typePragmas* = {wImportc, wExportc, wDeprecated, wMagic, wAcyclic, wNodecl, 
     wPure, wHeader, wCompilerProc, wFinal, wSize, wExtern, wShallow, 
     wImportcpp, wImportobjc, wError, wIncompleteStruct, wByCopy, wByRef,
@@ -60,7 +61,7 @@ const
     wExtern, wImportcpp, wImportobjc, wError, wGenSym, wInject}
   letPragmas* = varPragmas
   procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNosideEffect,
-                      wThread, wRaises}
+                      wThread, wRaises, wTags}
   allRoutinePragmas* = procPragmas + iteratorPragmas + lambdaPragmas
 
 proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords)
@@ -464,11 +465,11 @@ proc processPragma(c: PContext, n: PNode, i: int) =
   userPragma.ast = body
   StrTableAdd(c.userPragmas, userPragma)
 
-proc pragmaRaises(c: PContext, n: PNode) =
+proc pragmaRaisesOrTags(c: PContext, n: PNode) =
   proc processExc(c: PContext, x: PNode) =
     var t = skipTypes(c.semTypeNode(c, x, nil), skipPtrs)
     if t.kind != tyObject:
-      localError(x.info, errGenerated, "invalid exception type")
+      localError(x.info, errGenerated, "invalid type for raises/tags list")
     x.typ = t
     
   if n.kind == nkExprColonExpr:
@@ -696,7 +697,7 @@ proc pragma(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) =
             noVal(it)
             if sym == nil: invalidPragma(it)
           of wLine: PragmaLine(c, it)
-          of wRaises: pragmaRaises(c, it)
+          of wRaises, wTags: pragmaRaisesOrTags(c, it)
           else: invalidPragma(it)
         else: invalidPragma(it)
     else: processNote(c, it)
diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim
index 422eb4475..59ae26385 100644
--- a/compiler/sempass2.nim
+++ b/compiler/sempass2.nim
@@ -53,7 +53,7 @@ when false:
     assert n.kind == nkSym
   
   
-# ------------------------ exception tracking -------------------------------
+# ------------------------ exception and tag tracking -------------------------
 
 discard """
   exception tracking:
@@ -79,15 +79,15 @@ discard """
 type
   TEffects = object
     exc: PNode  # stack of exceptions
+    tags: PNode # list of tags
     bottom: int
   
   PEffects = var TEffects
 
-proc throws(tracked: PEffects, n: PNode) =
-  if n.typ == nil or n.typ.kind != tyError: tracked.exc.add n
+proc throws(tracked, n: PNode) =
+  if n.typ == nil or n.typ.kind != tyError: tracked.add n
   
 proc excType(n: PNode): PType =
-  assert n.kind != nkRaiseStmt
   # reraise is like raising E_Base:
   let t = if n.kind == nkEmpty: sysTypeFromName"E_Base" else: n.typ
   result = skipTypes(t, skipPtrs)
@@ -99,15 +99,25 @@ proc addEffect(a: PEffects, e: PNode, useLineInfo=true) =
     if sameType(aa[i].excType, e.excType):
       if not useLineInfo: return
       elif aa[i].info == e.info: return
-  throws(a, e)
+  throws(a.exc, e)
 
-proc mergeEffects(a: PEffects, b: PNode, useLineInfo) =
+proc mergeEffects(a: PEffects, b: PNode, useLineInfo: bool) =
   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
+      elif aa[i].info == e.info: return
+  throws(a.tags, e)
+
+proc mergeTags(a: PEffects, b: PNode, useLineInfo: bool) =
+  for effect in items(b): addTag(a, effect, useLineInfo)
+
 proc listEffects(a: PEffects) =
-  var aa = a.exc
-  for e in items(aa):
-    Message(e.info, hintUser, typeToString(e.typ))
+  for e in items(a.exc):  Message(e.info, hintUser, typeToString(e.typ))
+  for e in items(a.tags): Message(e.info, hintUser, typeToString(e.typ))
 
 proc catches(tracked: PEffects, e: PType) =
   let e = skipTypes(e, skipPtrs)
@@ -159,27 +169,25 @@ proc trackPragmaStmt(tracked: PEffects, n: PNode) =
       # list the computed effects up to here:
       listEffects(tracked)
       
-proc raisesSpec*(n: PNode): PNode =
+proc effectSpec(n: PNode, effectType = wRaises): PNode =
   for i in countup(0, sonsLen(n) - 1):
     var it = n.sons[i]
-    if it.kind == nkExprColonExpr and whichPragma(it) == wRaises:
+    if it.kind == nkExprColonExpr and whichPragma(it) == effectType:
       result = it.sons[1]
       if result.kind notin {nkCurly, nkBracket}:
         result = newNodeI(nkCurly, result.info)
         result.add(it.sons[1])
       return
 
-proc documentRaises*(n: PNode) =
-  if n.sons[namePos].kind != nkSym: return
-
-  var x = n.sons[pragmasPos]
-  let spec = raisesSpec(x)
+proc documentEffect(n, x: PNode, effectType: TSpecialWord, idx: int) =
+  var x = x
+  let spec = effectSpec(x, effectType)
   if isNil(spec):
     let s = n.sons[namePos].sym
     
     let actual = s.typ.n.sons[0]
     if actual.len != effectListLen: return
-    let real = actual.sons[exceptionEffects]
+    let real = actual.sons[idx]
     
     # warning: hack ahead: 
     var effects = newNodeI(nkBracket, n.info, real.len)
@@ -189,21 +197,45 @@ proc documentRaises*(n: PNode) =
       effects.sons[i] = newIdentNode(getIdent(t), n.info)
 
     var pair = newNode(nkExprColonExpr, n.info, @[
-      newIdentNode(getIdent"raises", n.info), effects])
+      newIdentNode(getIdent(specialWords[effectType]), n.info), effects])
     
     if x.kind == nkEmpty:
       x = newNodeI(nkPragma, n.info)
       n.sons[pragmasPos] = x
     x.add(pair)
 
+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")
+
+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))
+  
+  let tagSpec = effectSpec(pragma, wTags)
+  if not isNil(tagSpec):
+    mergeTags(tracked, tagSpec, useLineInfo=false)
+  else:
+    addTag(tracked, createTag(n))
+
 proc track(tracked: PEffects, n: PNode) =
   case n.kind
   of nkRaiseStmt: 
     n.sons[0].info = n.info
-    throws(tracked, n.sons[0])
+    throws(tracked.exc, n.sons[0])
   of nkCallKinds:
     # p's effects are ours too:
     let a = n.sons[0]
@@ -212,23 +244,16 @@ proc track(tracked: PEffects, n: PNode) =
       InternalAssert op.n.sons[0].kind == nkEffectList
       var effectList = op.n.sons[0]
       if a.kind == nkSym and a.sym.kind == skMethod:
-        let spec = raisesSpec(a.sym.ast.sons[pragmasPos])
-        if not isNil(spec):
-          mergeEffects(tracked, spec, useLineInfo=false)
-        else:
-          addEffect(tracked, createRaise(n))
+        propagateEffects(tracked, n, a.sym)
       elif effectList.len == 0:
         if isForwardedProc(a):
-          let spec = raisesSpec(a.sym.ast.sons[pragmasPos])
-          if not isNil(spec):
-            mergeEffects(tracked, spec, useLineInfo=false)
-          else:
-            addEffect(tracked, createRaise(n))
+          propagateEffects(tracked, n, a.sym)
         elif isIndirectCall(a):
           addEffect(tracked, createRaise(n))
+          addTag(tracked, createTag(n))
       else:
-        effectList = effectList.sons[exceptionEffects]
-        mergeEffects(tracked, effectList, useLineInfo=true)
+        mergeEffects(tracked, effectList.sons[exceptionEffects], true)
+        mergeTags(tracked, effectList.sons[tagEffects], true)
   of nkTryStmt:
     trackTryStmt(tracked, n)
     return
@@ -240,7 +265,7 @@ proc track(tracked: PEffects, n: PNode) =
   for i in 0 .. <safeLen(n):
     track(tracked, n.sons[i])
 
-proc checkRaisesSpec(spec, real: PNode) =
+proc checkRaisesSpec(spec, real: PNode, msg: string, hints: bool) =
   # check that any real exception is listed in 'spec'; mark those as used;
   # report any unused exception
   var used = initIntSet()
@@ -252,41 +277,43 @@ proc checkRaisesSpec(spec, real: PNode) =
           break search
       # XXX call graph analysis would be nice here!
       pushInfoContext(spec.info)
-      localError(r.info, errGenerated, "can raise an unlisted exception: " &
-        typeToString(r.typ))
+      localError(r.info, errGenerated, msg & typeToString(r.typ))
       popInfoContext()
   # hint about unnecessarily listed exception types:
-  for s in 0 .. <spec.len:
-    if not used.contains(s):
-      Message(spec[s].info, hintXDeclaredButNotUsed, renderTree(spec[s]))
+  if hints:
+    for s in 0 .. <spec.len:
+      if not used.contains(s):
+        Message(spec[s].info, hintXDeclaredButNotUsed, renderTree(spec[s]))
 
 proc checkMethodEffects*(disp, branch: PSym) =
   ## checks for consistent effects for multi methods.
-  let spec = raisesSpec(disp.ast.sons[pragmasPos])
-  if not isNil(spec):
-    let actual = branch.typ.n.sons[0]
-    if actual.len != effectListLen: return
-    let real = actual.sons[exceptionEffects]
-    
-    for r in items(real):
-      block search:
-        for s in 0 .. <spec.len:
-          if inheritanceDiff(r.excType, spec[s].typ) <= 0:
-            break search
-        pushInfoContext(branch.info)
-        localError(r.info, errGenerated, "can raise an unlisted exception: " &
-          typeToString(r.typ))
-        popInfoContext()
+  let actual = branch.typ.n.sons[0]
+  if actual.len != effectListLen: return
+
+  let p = disp.ast.sons[pragmasPos]
+  let raisesSpec = effectSpec(p, wRaises)
+  if not isNil(raisesSpec):
+    checkRaisesSpec(raisesSpec, actual.sons[exceptionEffects],
+      "can raise an unlisted exception: ", hints=off)
+  let tagsSpec = effectSpec(p, wTags)
+  if not isNil(tagsSpec):
+    checkRaisesSpec(tagsSpec, actual.sons[tagEffects],
+      "can have an unlisted effect: ", hints=off)
 
 proc setEffectsForProcType*(t: PType, n: PNode) =
   var effects = t.n.sons[0]
   InternalAssert t.kind == tyProc and effects.kind == nkEffectList
 
-  let spec = raisesSpec(n)
-  if not isNil(spec):
+  let
+    raisesSpec = effectSpec(n, wRaises)
+    tagsSpec = effectSpec(n, wTags)
+  if not isNil(raisesSpec) or not isNil(tagsSpec):
     InternalAssert effects.len == 0
     newSeq(effects.sons, effectListLen)
-    effects.sons[exceptionEffects] = spec
+    if not isNil(raisesSpec):
+      effects.sons[exceptionEffects] = raisesSpec
+    if not isNil(tagsSpec):
+      effects.sons[tagEffects] = tagsSpec
 
 proc trackProc*(s: PSym, body: PNode) =
   var effects = s.typ.n.sons[0]
@@ -296,11 +323,24 @@ proc trackProc*(s: PSym, body: PNode) =
   if effects.len == effectListLen: return
   newSeq(effects.sons, effectListLen)
   effects.sons[exceptionEffects] = newNodeI(nkArgList, body.info)
+  effects.sons[tagEffects] = newNodeI(nkArgList, body.info)
   
   var t: TEffects
   t.exc = effects.sons[exceptionEffects]
+  t.tags = effects.sons[tagEffects]
   track(t, body)
   
-  let spec = raisesSpec(s.ast.sons[pragmasPos])
-  if not isNil(spec):
-    checkRaisesSpec(spec, t.exc)
+  let p = s.ast.sons[pragmasPos]
+  let raisesSpec = effectSpec(p, wRaises)
+  if not isNil(raisesSpec):
+    checkRaisesSpec(raisesSpec, t.exc, "can raise an unlisted exception: ",
+                    hints=on)
+    # after the check, use the formal spec:
+    effects.sons[exceptionEffects] = raisesSpec
+
+  let tagsSpec = effectSpec(p, wTags)
+  if not isNil(tagsSpec):
+    checkRaisesSpec(tagsSpec, t.tags, "can have an unlisted effect: ",
+                    hints=on)
+    # after the check, use the formal spec:
+    effects.sons[tagEffects] = tagsSpec
diff --git a/compiler/types.nim b/compiler/types.nim
index 7ee69a59a..c994e0dd8 100755
--- a/compiler/types.nim
+++ b/compiler/types.nim
@@ -1190,6 +1190,16 @@ proc baseOfDistinct*(t: PType): PType =
       internalAssert parent != nil
       parent.sons[0] = it.sons[0]
 
+proc compatibleEffectsAux(se, re: PNode): bool =
+  if re.isNil: return false
+  for r in items(re):
+    block search:
+      for s in items(se):
+        if inheritanceDiff(r.typ, s.typ) <= 0:
+          break search
+      return false
+  result = true
+ 
 proc compatibleEffects*(formal, actual: PType): bool =
   # for proc type compatibility checking:
   assert formal.kind == tyProc and actual.kind == tyProc
@@ -1197,18 +1207,23 @@ proc compatibleEffects*(formal, actual: PType): bool =
   InternalAssert actual.n.sons[0].kind == nkEffectList
   
   var spec = formal.n.sons[0]
-  # if 'spec.sons[0].kind == nkArgList' it is no formal type really, but a
-  # computed effect and as such no spec:
-  # 'r.msgHandler = if isNil(msgHandler): defaultMsgHandler else: msgHandler'
-  if spec.len != 0 and spec.sons[0].kind != nkArgList:
+  if spec.len != 0:
     var real = actual.n.sons[0]
-    if real.len == 0: 
-      # we don't know anything about 'real' ...
-      return false
-    for r in items(real):
-      block search:
-        for s in items(spec):
-          if inheritanceDiff(r.typ, s.typ) <= 0:
-            break search
-        return false
+
+    let se = spec.sons[exceptionEffects]
+    # if 'se.kind == nkArgList' it is no formal type really, but a
+    # computed effect and as such no spec:
+    # 'r.msgHandler = if isNil(msgHandler): defaultMsgHandler else: msgHandler'
+    if not IsNil(se) and se.kind != nkArgList:
+      # spec requires some exception or tag, but we don't know anything:
+      if real.len == 0: return false
+      result = compatibleEffectsAux(se, real.sons[exceptionEffects])
+      if not result: return
+
+    let st = spec.sons[tagEffects]
+    if not isNil(st) and st.kind != nkArgList:
+      # spec requires some exception or tag, but we don't know anything:
+      if real.len == 0: return false
+      result = compatibleEffectsAux(st, real.sons[tagEffects])
+      if not result: return
   result = true
diff --git a/compiler/wordrecg.nim b/compiler/wordrecg.nim
index e45b78c6d..1cc3269dd 100755
--- a/compiler/wordrecg.nim
+++ b/compiler/wordrecg.nim
@@ -52,7 +52,7 @@ type
     wBoundchecks, wOverflowchecks, wNilchecks,
     wFloatchecks, wNanChecks, wInfChecks,
     wAssertions, wPatterns, wWarnings,
-    wHints, wOptimization, wRaises, wWrites, wReads, wSize, wEffects,
+    wHints, wOptimization, wRaises, wWrites, wReads, wSize, wEffects, wTags,
     wDeadCodeElim, wSafecode, 
     wPragma,
     wCompileTime, wNoInit,
@@ -94,7 +94,7 @@ const
   
   cppNimSharedKeywords* = {
     wAsm, wBreak, wCase, wConst, wContinue, wDo, wElse, wEnum, wExport,
-    wFor, wIf, wReturn, wStatic, wTemplate, wTry, wWhile }
+    wFor, wIf, wReturn, wStatic, wTemplate, wTry, wWhile}
 
   specialWords*: array[low(TSpecialWord)..high(TSpecialWord), string] = ["", 
     
@@ -133,7 +133,7 @@ const
     "floatchecks", "nanchecks", "infchecks",
 
     "assertions", "patterns", "warnings", "hints", 
-    "optimization", "raises", "writes", "reads", "size", "effects",
+    "optimization", "raises", "writes", "reads", "size", "effects", "tags",
     "deadcodeelim", "safecode", 
     "pragma",
     "compiletime", "noinit",
diff --git a/doc/manual.txt b/doc/manual.txt
index 414c43874..c97e4ef5c 100755
--- a/doc/manual.txt
+++ b/doc/manual.txt
@@ -2850,11 +2850,9 @@ possibly raised exceptions; the algorithm operates on ``p``'s call graph:
 Tag tracking
 ~~~~~~~~~~~~
 
-**Note**: Tag tracking is not yet implemented!
-
 The exception tracking is part of Nimrod's `effect system`:idx:. Raising an
 exception is an *effect*. Other effects can also be defined. A user defined 
-effect is a means to *tag* a routine and perform checks against this tag:
+effect is a means to *tag* a routine and to perform checks against this tag:
 
 .. code-block:: nimrod
   type IO = object ## input/output effect
@@ -3093,8 +3091,6 @@ To be written.
 Return Type Inference
 ~~~~~~~~~~~~~~~~~~~~~
 
-**Note**: ``auto`` is not yet implemented.
-
 If a type class is used as the return type of a proc and it won't be bound to
 a concrete type by some of the proc params, Nimrod will infer the return type
 from the proc body. This is usually used with the ``auto`` type class:
diff --git a/lib/system.nim b/lib/system.nim
index b4e552701..5a4c491e1 100755
--- a/lib/system.nim
+++ b/lib/system.nim
@@ -209,6 +209,16 @@ type
            ## objects that have no ancestor are allowed.
   PObject* = ref TObject ## reference to TObject
 
+  TEffect* {.compilerproc.} = object of TObject ## \
+    ## base effect class; each effect should
+    ## inherit from `TEffect` unless you know what
+    ## you doing.
+  FTime* = object of TEffect   ## Time effect.
+  FIO* = object of TEffect     ## IO effect.
+  FReadIO* = object of FIO     ## Effect describing a read IO operation.
+  FWriteIO* = object of FIO    ## Effect describing a write IO operation.
+  FExecIO* = object of FIO     ## Effect describing an executing IO operation.
+
   E_Base* {.compilerproc.} = object of TObject ## base exception class;
                                                ## each exception has to
                                                ## inherit from `E_Base`.
diff --git a/tests/reject/teffects3.nim b/tests/reject/teffects3.nim
new file mode 100644
index 000000000..aeee029a6
--- /dev/null
+++ b/tests/reject/teffects3.nim
@@ -0,0 +1,19 @@
+discard """
+  line: 18
+  errormsg: "type mismatch"
+"""
+
+type
+  TObj = object {.pure, inheritable.}
+  TObjB = object of TObj
+    a, b, c: string
+    fn: proc (): int {.tags: [].}
+  
+  EIO2 = ref object of EIO
+  
+proc raiser(): int {.tags: [TObj].} =
+  writeln stdout, "arg"
+
+var o: TObjB
+o.fn = raiser
+
diff --git a/tests/reject/teffects4.nim b/tests/reject/teffects4.nim
new file mode 100644
index 000000000..4584e6dc8
--- /dev/null
+++ b/tests/reject/teffects4.nim
@@ -0,0 +1,24 @@
+discard """
+  line: 23
+  errormsg: "type mismatch"
+"""
+
+type
+  TObj = object {.pure, inheritable.}
+  TObjB = object of TObj
+    a, b, c: string
+    fn: proc (): int {.tags: [FReadIO].}
+  
+  EIO2 = ref object of EIO
+
+proc q() {.tags: [FIO].} =
+  nil
+  
+proc raiser(): int =
+  writeln stdout, "arg"
+  if true:
+    q()
+
+var o: TObjB
+o.fn = raiser
+
diff --git a/web/news.txt b/web/news.txt
index 9101f8974..c7f3077e1 100755
--- a/web/news.txt
+++ b/web/news.txt
@@ -38,13 +38,13 @@ Language Additions
 - Added a ``mixin`` declaration to affect symbol binding rules in generics.
 - Exception tracking has been added and the ``doc2`` command annotates possible
   exceptions for you.
+- User defined effects ("tags") tracking has been added and the ``doc2`` 
+  command annotates possible tags for you.
 
 
 2012-09-23 Version 0.9.0 released
 =================================
 
-Version 0.9.0 has been released! Get it `here <download.html>`_. 
-
 Summary
 -------