bugfixes; field discriminant checks; linearScanEnd, unroll, shallow pragmas

lib/pure/gentabs.nim

@@ -0,0 +1,192 @@
+#
+#
+#            Nimrod's Runtime Library
+#        (c) Copyright 2010 Andreas Rumpf
+#
+#    See the file "copying.txt", included in this
+#    distribution, for details about the copyright.
+#
+
+## The ``gentabs`` module implements an efficient hash table that is a
+## key-value mapping. The keys are required to be strings, but the values
+## may be any Nimrod or user defined type. This module supports matching 
+## of keys in case-sensitive, case-insensitive and style-insensitive modes.
+
+import
+  os, hashes, strutils
+
+type
+  TGenTableMode* = enum    ## describes the table's key matching mode
+    modeCaseSensitive,     ## case sensitive matching of keys
+    modeCaseInsensitive,   ## case insensitive matching of keys
+    modeStyleInsensitive   ## style sensitive matching of keys
+    
+  TGenKeyValuePair[T] = tuple[key: string, val: T]
+  TGenKeyValuePairSeq[T] = seq[TGenKeyValuePair[T]]
+  TGenTable*[T] = object of TObject
+    counter: int
+    data: TGenKeyValuePairSeq[T]
+    mode: TGenTableMode
+
+  PGenTable*[T] = ref TGenTable[T]     ## use this type to declare hash tables
+
+
+const
+  growthFactor = 2
+  startSize = 64
+
+
+proc len*[T](tbl: PGenTable[T]): int {.inline.} =
+  ## returns the number of keys in `tbl`.
+  result = tbl.counter
+
+iterator pairs*[T](tbl: PGenTable[T]): tuple[key: string, value: T] =
+  ## iterates over any (key, value) pair in the table `tbl`.
+  for h in 0..high(tbl.data):
+    if not isNil(tbl.data[h].key):
+      yield (tbl.data[h].key, tbl.data[h].val)
+
+proc myhash[T](tbl: PGenTable[T], key: string): THash =
+  case tbl.mode
+  of modeCaseSensitive: result = hashes.hash(key)
+  of modeCaseInsensitive: result = hashes.hashIgnoreCase(key)
+  of modeStyleInsensitive: result = hashes.hashIgnoreStyle(key)
+
+proc myCmp[T](tbl: PGenTable[T], a, b: string): bool =
+  case tbl.mode
+  of modeCaseSensitive: result = cmp(a, b) == 0
+  of modeCaseInsensitive: result = cmpIgnoreCase(a, b) == 0
+  of modeStyleInsensitive: result = cmpIgnoreStyle(a, b) == 0
+
+proc mustRehash(length, counter: int): bool =
+  assert(length > counter)
+  result = (length * 2 < counter * 3) or (length - counter < 4)
+
+proc newGenTable*[T](mode: TGenTableMode): PGenTable[T] =
+  ## creates a new generic hash table that is empty.
+  new(result)
+  result.mode = mode
+  result.counter = 0
+  newSeq(result.data, startSize)
+
+proc nextTry(h, maxHash: THash): THash {.inline.} =
+  result = ((5 * h) + 1) and maxHash
+
+proc RawGet[T](tbl: PGenTable[T], key: string): int =
+  var h: THash
+  h = myhash(tbl, key) and high(tbl.data) # start with real hash value
+  while not isNil(tbl.data[h].key):
+    if mycmp(tbl, tbl.data[h].key, key):
+      return h
+    h = nextTry(h, high(tbl.data))
+  result = - 1
+
+proc RawInsert[T](tbl: PGenTable[T], data: var TGenKeyValuePairSeq[T], 
+                  key: string, val: T) =
+  var h: THash
+  h = myhash(tbl, key) and high(data)
+  while not isNil(data[h].key):
+    h = nextTry(h, high(data))
+  data[h].key = key
+  data[h].val = val
+
+proc Enlarge[T](tbl: PGenTable[T]) =
+  var n: TGenKeyValuePairSeq[T]
+  newSeq(n, len(tbl.data) * growthFactor)
+  for i in countup(0, high(tbl.data)):
+    if not isNil(tbl.data[i].key): 
+      RawInsert[T](tbl, n, tbl.data[i].key, tbl.data[i].val)
+  swap(tbl.data, n)
+
+proc hasKey*[T](tbl: PGenTable[T], key: string): bool =
+  ## returns true iff `key` is in the table `tbl`.
+  result = rawGet(tbl, key) >= 0
+
+proc `[]`*[T](tbl: PGenTable[T], key: string): T =
+  ## retrieves the value at ``tbl[key]``. If `key` is not in `tbl`,
+  ## "" is returned and no exception is raised. One can check
+  ## with ``hasKey`` whether the key exists.
+  var index: int
+  index = RawGet(tbl, key)
+  if index >= 0: result = tbl.data[index].val
+  #else: result = ""   ### Not sure what to do here
+
+proc `[]=`*[T](tbl: PGenTable[T], key: string, val: T) =
+  ## puts a (key, value)-pair into `tbl`.
+  var index = RawGet(tbl, key)
+  if index >= 0:
+    tbl.data[index].val = val
+  else:
+    if mustRehash(len(tbl.data), tbl.counter): Enlarge(tbl)
+    RawInsert(tbl, tbl.data, key, val)
+    inc(tbl.counter)
+
+
+when isMainModule:
+  #
+  # Verify tables of integer values (string keys)
+  #
+  var x = newGenTable[int](modeCaseInsensitive)
+  x["one"]   = 1
+  x["two"]   = 2
+  x["three"] = 3
+  x["four"]  = 4
+  x["five"]  = 5
+  assert(len(x) == 5)             # length procedure works
+  assert(x["one"] == 1)           # case-sensitive lookup works
+  assert(x["ONE"] == 1)           # case-insensitive should work for this table
+  assert(x["one"]+x["two"] == 3)  # make sure we're getting back ints
+  assert(x.hasKey("one"))         # hasKey should return 'true' for a key
+                                  # of "one"...
+  assert(not x.hasKey("NOPE"))    # ...but key "NOPE" is not in the table.
+  for k,v in pairs(x):            # make sure the 'pairs' iterator works
+    assert(x[k]==v)
+  echo()
+  
+  
+  #
+  # Verify a table of user-defined types
+  #
+  type
+    TMyType = tuple[first, second: string] # a pair of strings
+  
+  var y = newGenTable[TMyType](modeCaseInsensitive) # hash table where each
+                                                    # value is TMyType tuple
+  
+  #var junk: TMyType = ("OK", "Here")
+  y["Hello"] = ("Hello", "World")
+  y["Goodbye"] = ("Goodbye", "Everyone")
+  #y["Hello"] = TMyType( ("Hello", "World") )
+  #y["Goodbye"] = TMyType( ("Goodbye", "Everyone") )
+
+  assert( y["Hello"].first == "Hello" )
+  assert( y["Hello"].second == "World" )
+  
+  
+  #
+  # Verify table of tables
+  #
+  var z: PGenTable[ PGenTable[int] ] # hash table where each value is 
+                                     # a hash table of ints
+  
+  z = newGenTable[PGenTable[int]](modeCaseInsensitive)
+  z["first"] = newGenTable[int](modeCaseInsensitive)
+  z["first"]["one"] = 1
+  z["first"]["two"] = 2
+  z["first"]["three"] = 3
+  
+  z["second"] = newGenTable[int](modeCaseInsensitive)
+  z["second"]["red"] = 10
+  z["second"]["blue"] = 20
+  
+  assert(len(z) == 2)               # length of outer table
+  assert(len(z["first"]) == 3)      # length of "first" table
+  assert(len(z["second"]) == 2)     # length of "second" table
+  assert( z["first"]["one"] == 1)   # retrieve from first inner table
+  assert( z["second"]["red"] == 10) # retrieve from second inner table
+  
+  for k,v in pairs(z):
+    echo( "$# ($#) ->" % [k,$len(v)] )
+    #for k2,v2 in pairs(v):
+    #  echo( "   $# <-> $#" % [k2,$v2] )
+  echo()

lib/pure/os.nim

@@ -708,7 +708,7 @@ else:
     # environ is needed, the _NSGetEnviron() routine, defined in
     # <crt_externs.h>, can be used to retrieve the address of environ
     # at runtime.
-    proc NSGetEnviron(): cstringArray {.
+    proc NSGetEnviron(): ptr cstringArray {.
       importc: "_NSGetEnviron", header: "<crt_externs.h>".}
   else:
     var gEnv {.importc: "environ".}: cstringArray
@@ -717,7 +717,7 @@ else:
     # retrieves the variables of char** env of C's main proc
     if not envComputed:
       when defined(macosx):
-        var gEnv = NSGetEnviron()
+        var gEnv = NSGetEnviron()^
       var i = 0
       while True:
         if gEnv[i] == nil: break

lib/pure/pegs.nim

@@ -75,7 +75,7 @@ type
     col: int                      ## column the symbol has been declared/used in
     flags: set[TNonTerminalFlag]  ## the nonterminal's flags
     rule: TNode                   ## the rule that the symbol refers to
-  TNode {.final.} = object
+  TNode {.final, shallow.} = object
     case kind: TPegKind
     of pkEmpty..pkWhitespace: nil
     of pkTerminal, pkTerminalIgnoreCase, pkTerminalIgnoreStyle: term: string
@@ -128,10 +128,12 @@ proc add(d: var TPeg, s: TPeg) {.inline.} = add(d.sons, s)
 proc addChoice(dest: var TPeg, elem: TPeg) =
   var L = dest.len-1
   if L >= 0 and dest.sons[L].kind == pkCharChoice: 
+    # caution! Do not introduce false aliasing here!
     case elem.kind
     of pkCharChoice:
-      dest.sons[L].charChoice^ = dest.sons[L].charChoice^ + elem.charChoice^
-    of pkChar: incl(dest.sons[L].charChoice^, elem.ch)
+      dest.sons[L] = charSet(dest.sons[L].charChoice^ + elem.charChoice^)
+    of pkChar: 
+      dest.sons[L] = charSet(dest.sons[L].charChoice^ + {elem.ch})
     else: add(dest, elem)
   else: add(dest, elem)
 
@@ -155,9 +157,12 @@ proc `/`*(a: openArray[TPeg]): TPeg {.
 proc addSequence(dest: var TPeg, elem: TPeg) =
   var L = dest.len-1
   if L >= 0 and dest.sons[L].kind == pkTerminal: 
+    # caution! Do not introduce false aliasing here!
     case elem.kind
-    of pkTerminal: add(dest.sons[L].term, elem.term)
-    of pkChar: add(dest.sons[L].term, elem.ch)
+    of pkTerminal: 
+      dest.sons[L] = term(dest.sons[L].term & elem.term)
+    of pkChar: 
+      dest.sons[L] = term(dest.sons[L].term & elem.ch)
     else: add(dest, elem)
   else: add(dest, elem)
 

lib/system/assign.nim

@@ -1,14 +1,14 @@
 #
 #
 #            Nimrod's Runtime Library
-#        (c) Copyright 2009 Andreas Rumpf
+#        (c) Copyright 2011 Andreas Rumpf
 #
 #    See the file "copying.txt", included in this
 #    distribution, for details about the copyright.
 #
 
-proc genericAssignAux(dest, src: Pointer, mt: PNimType)
-proc genericAssignAux(dest, src: Pointer, n: ptr TNimNode) =
+proc genericAssignAux(dest, src: Pointer, mt: PNimType, shallow: bool)
+proc genericAssignAux(dest, src: Pointer, n: ptr TNimNode, shallow: bool) =
   var
     d = cast[TAddress](dest)
     s = cast[TAddress](src)
@@ -16,66 +16,69 @@ proc genericAssignAux(dest, src: Pointer, n: ptr TNimNode) =
   of nkNone: assert(false)
   of nkSlot:
     genericAssignAux(cast[pointer](d +% n.offset), cast[pointer](s +% n.offset),
-                     n.typ)
+                     n.typ, shallow)
   of nkList:
     for i in 0..n.len-1:
-      genericAssignAux(dest, src, n.sons[i])
+      genericAssignAux(dest, src, n.sons[i], shallow)
   of nkCase:
     copyMem(cast[pointer](d +% n.offset), cast[pointer](s +% n.offset),
             n.typ.size)
     var m = selectBranch(src, n)
-    if m != nil: genericAssignAux(dest, src, m)
+    if m != nil: genericAssignAux(dest, src, m, shallow)
 
-proc genericAssignAux(dest, src: Pointer, mt: PNimType) =
+proc genericAssignAux(dest, src: Pointer, mt: PNimType, shallow: bool) =
   var
     d = cast[TAddress](dest)
     s = cast[TAddress](src)
-
   assert(mt != nil)
   case mt.Kind
+  of tyString:
+    var x = cast[ppointer](dest)
+    var s2 = cast[ppointer](s)^
+    if s2 == nil or shallow:
+      unsureAsgnRef(x, s2)
+    else:
+      unsureAsgnRef(x, copyString(cast[NimString](s2)))
   of tySequence:
     var s2 = cast[ppointer](src)^
-    var seq = cast[PGenericSeq](s2)
-    if s2 == nil:  # this can happen! nil sequences are allowed
-      var x = cast[ppointer](dest)
-      x^ = nil
+    var seq = cast[PGenericSeq](s2)      
+    var x = cast[ppointer](dest)
+    if s2 == nil or shallow:
+      # this can happen! nil sequences are allowed
+      unsureAsgnRef(x, s2)
       return
     assert(dest != nil)
-    unsureAsgnRef(cast[ppointer](dest),
-                  newObj(mt, seq.len * mt.base.size + GenericSeqSize))
+    unsureAsgnRef(x, newObj(mt, seq.len * mt.base.size + GenericSeqSize))
     var dst = cast[taddress](cast[ppointer](dest)^)
     for i in 0..seq.len-1:
       genericAssignAux(
         cast[pointer](dst +% i*% mt.base.size +% GenericSeqSize),
         cast[pointer](cast[taddress](s2) +% i *% mt.base.size +%
                      GenericSeqSize),
-        mt.Base)
+        mt.Base, shallow)
     var dstseq = cast[PGenericSeq](dst)
     dstseq.len = seq.len
     dstseq.space = seq.len
   of tyObject, tyTuple, tyPureObject:
     # we don't need to copy m_type field for tyObject, as they are equal anyway
-    genericAssignAux(dest, src, mt.node)
+    genericAssignAux(dest, src, mt.node, shallow)
   of tyArray, tyArrayConstr:
     for i in 0..(mt.size div mt.base.size)-1:
       genericAssignAux(cast[pointer](d +% i*% mt.base.size),
-                       cast[pointer](s +% i*% mt.base.size), mt.base)
-  of tyString: # a leaf
-    var s2 = cast[ppointer](s)^
-    if s2 != nil: # nil strings are possible!
-      unsureAsgnRef(cast[ppointer](dest), copyString(cast[NimString](s2)))
-    else:
-      var x = cast[ppointer](dest)
-      x^ = nil
-      return
-  of tyRef:  # BUGFIX: a long time this has been forgotten!
+                       cast[pointer](s +% i*% mt.base.size), mt.base, shallow)
+  of tyRef:
     unsureAsgnRef(cast[ppointer](dest), cast[ppointer](s)^)
   else:
     copyMem(dest, src, mt.size) # copy raw bits
 
 proc genericAssign(dest, src: Pointer, mt: PNimType) {.compilerProc.} =
   GC_disable()
-  genericAssignAux(dest, src, mt)
+  genericAssignAux(dest, src, mt, false)
+  GC_enable()
+
+proc genericShallowAssign(dest, src: Pointer, mt: PNimType) {.compilerProc.} =
+  GC_disable()
+  genericAssignAux(dest, src, mt, true)
   GC_enable()
 
 proc genericSeqAssign(dest, src: Pointer, mt: PNimType) {.compilerProc.} =
@@ -152,3 +155,19 @@ proc genericReset(dest: Pointer, mt: PNimType) =
   else:
     zeroMem(dest, mt.size) # set raw bits to zero
 
+proc selectBranch(discVal, L: int, 
+                  a: ptr array [0..0x7fff, ptr TNimNode]): ptr TNimNode =
+  result = a[L] # a[L] contains the ``else`` part (but may be nil)
+  if discVal <% L:
+    var x = a[discVal]
+    if x != nil: result = x
+  
+proc FieldDiscriminantCheck(oldDiscVal, newDiscVal: int, 
+                            a: ptr array [0..0x7fff, ptr TNimNode], 
+                            L: int) {.compilerProc.} =
+  var oldBranch = selectBranch(oldDiscVal, L, a)
+  var newBranch = selectBranch(newDiscVal, L, a)
+  if newBranch != oldBranch and oldDiscVal != 0:
+    raise newException(EInvalidField, 
+                       "assignment to discriminant changes object branch")
+