ORC: use =destroy instead of =dispose (#18440)

* ORC refactoring in preparation for further changes (=dispose must die)
* ORC: embrace =destroy, avoid =dispose
* ORC: no need for =dispose
* closes #18421

10 files changed, 205 insertions, 81 deletions

diff --git a/compiler/ast.nim b/compiler/ast.nim
index 2a2a84e76..26050426a 100644
--- a/compiler/ast.nim
+++ b/compiler/ast.nim
@@ -911,7 +911,6 @@ type
     attachedAsgn,
     attachedSink,
     attachedTrace,
-    attachedDispose,
     attachedDeepCopy
 
   TType* {.acyclic.} = object of TIdObj # \
@@ -1408,7 +1407,7 @@ const
   MaxLockLevel* = 1000'i16
   UnknownLockLevel* = TLockLevel(1001'i16)
   AttachedOpToStr*: array[TTypeAttachedOp, string] = [
-    "=destroy", "=copy", "=sink", "=trace", "=dispose", "=deepcopy"]
+    "=destroy", "=copy", "=sink", "=trace", "=deepcopy"]
 
 proc `$`*(x: TLockLevel): string =
   if x.ord == UnspecifiedLockLevel.ord: result = "<unspecified>"
diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim
index 6e5ffeaa4..67e701804 100644
--- a/compiler/ccgtypes.nim
+++ b/compiler/ccgtypes.nim
@@ -1328,14 +1328,13 @@ proc genTypeInfoV2Impl(m: BModule, t, origType: PType, name: Rope; info: TLineIn
   m.s[cfsData].addf("N_LIB_PRIVATE TNimTypeV2 $1;$n", [name])
   let destroyImpl = genHook(m, t, info, attachedDestructor)
   let traceImpl = genHook(m, t, info, attachedTrace)
-  let disposeImpl = genHook(m, t, info, attachedDispose)
 
   var flags = 0
   if not canFormAcycle(t): flags = flags or 1
 
-  addf(m.s[cfsTypeInit3], "$1.destructor = (void*)$2; $1.size = sizeof($3); $1.align = NIM_ALIGNOF($3); $1.name = $4;$n; $1.traceImpl = (void*)$5; $1.disposeImpl = (void*)$6; $1.flags = $7;", [
+  addf(m.s[cfsTypeInit3], "$1.destructor = (void*)$2; $1.size = sizeof($3); $1.align = NIM_ALIGNOF($3); $1.name = $4;$n; $1.traceImpl = (void*)$5; $1.flags = $6;", [
     name, destroyImpl, getTypeDesc(m, t), typeName,
-    traceImpl, disposeImpl, rope(flags)])
+    traceImpl, rope(flags)])
 
   if t.kind == tyObject and t.len > 0 and t[0] != nil and optEnableDeepCopy in m.config.globalOptions:
     discard genTypeInfoV1(m, t, info)
diff --git a/compiler/liftdestructors.nim b/compiler/liftdestructors.nim
index 43f87e179..1824557e6 100644
--- a/compiler/liftdestructors.nim
+++ b/compiler/liftdestructors.nim
@@ -421,11 +421,6 @@ proc considerUserDefinedOp(c: var TLiftCtx; t: PType; body, x, y: PNode): bool =
     result = considerAsgnOrSink(c, t, body, x, y, op)
     if op != nil:
       setAttachedOp(c.g, c.idgen.module, t, c.kind, op)
-  of attachedDispose:
-    var op = getAttachedOp(c.g, t, c.kind)
-    result = considerAsgnOrSink(c, t, body, x, nil, op)
-    if op != nil:
-      setAttachedOp(c.g, c.idgen.module, t, c.kind, op)
   of attachedDeepCopy:
     let op = getAttachedOp(c.g, t, attachedDeepCopy)
     if op != nil:
@@ -516,9 +511,6 @@ proc fillSeqOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
     if canFormAcycle(t.elemType):
       # follow all elements:
       forallElements(c, t, body, x, y)
-  of attachedDispose:
-    forallElements(c, t, body, x, y)
-    body.add genBuiltin(c, mDestroy, "destroy", x)
 
 proc useSeqOrStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   createTypeBoundOps(c.g, c.c, t, body.info, c.idgen)
@@ -556,11 +548,6 @@ proc useSeqOrStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
       if op == nil:
         return # protect from recursion
       body.add newHookCall(c, op, x, y)
-  of attachedDispose:
-    let op = getAttachedOp(c.g, t, c.kind)
-    if op == nil:
-      return # protect from recursion
-    body.add newHookCall(c, op, x, nil)
 
 proc fillStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   case c.kind
@@ -572,7 +559,7 @@ proc fillStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
     doAssert t.destructor != nil
     moveCall.add destructorCall(c, t.destructor, x)
     body.add moveCall
-  of attachedDestructor, attachedDispose:
+  of attachedDestructor:
     body.add genBuiltin(c, mDestroy, "destroy", x)
   of attachedTrace:
     discard "strings are atomic and have no inner elements that are to trace"
@@ -667,16 +654,6 @@ proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
         # If the ref is polymorphic we have to account for this
         body.add callCodegenProc(c.g, "nimTraceRefDyn", c.info, genAddrOf(x, c.idgen), y)
       #echo "can follow ", elemType, " static ", isFinal(elemType)
-  of attachedDispose:
-    # this is crucial! dispose is like =destroy but we don't follow refs
-    # as that is dealt within the cycle collector.
-    if not isCyclic:
-      body.add genIf(c, cond, actions)
-    when false:
-      let cond = copyTree(x)
-      cond.typ = getSysType(c.g, x.info, tyBool)
-      actions.add callCodegenProc(c.g, "nimRawDispose", c.info, x)
-      body.add genIf(c, cond, actions)
 
 proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   ## Closures are really like refs except they always use a virtual destructor
@@ -725,14 +702,6 @@ proc atomicClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   of attachedDeepCopy: assert(false, "cannot happen")
   of attachedTrace:
     body.add callCodegenProc(c.g, "nimTraceRefDyn", c.info, genAddrOf(xenv, c.idgen), y)
-  of attachedDispose:
-    # this is crucial! dispose is like =destroy but we don't follow refs
-    # as that is dealt within the cycle collector.
-    when false:
-      let cond = copyTree(xenv)
-      cond.typ = getSysType(c.g, xenv.info, tyBool)
-      actions.add callCodegenProc(c.g, "nimRawDispose", c.info, xenv)
-      body.add genIf(c, cond, actions)
 
 proc weakrefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   case c.kind
@@ -756,7 +725,7 @@ proc weakrefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
     else:
       body.sons.insert(des, 0)
   of attachedDeepCopy: assert(false, "cannot happen")
-  of attachedTrace, attachedDispose: discard
+  of attachedTrace: discard
 
 proc ownedRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   var actions = newNodeI(nkStmtList, c.info)
@@ -781,7 +750,7 @@ proc ownedRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   of attachedDestructor:
     body.add genIf(c, x, actions)
   of attachedDeepCopy: assert(false, "cannot happen")
-  of attachedTrace, attachedDispose: discard
+  of attachedTrace: discard
 
 proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   if c.kind == attachedDeepCopy:
@@ -815,7 +784,7 @@ proc closureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
       else:
         body.sons.insert(des, 0)
     of attachedDeepCopy: assert(false, "cannot happen")
-    of attachedTrace, attachedDispose: discard
+    of attachedTrace: discard
 
 proc ownedClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   let xx = genBuiltin(c, mAccessEnv, "accessEnv", x)
@@ -830,7 +799,7 @@ proc ownedClosureOp(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   of attachedDestructor:
     body.add genIf(c, xx, actions)
   of attachedDeepCopy: assert(false, "cannot happen")
-  of attachedTrace, attachedDispose: discard
+  of attachedTrace: discard
 
 proc fillBody(c: var TLiftCtx; t: PType; body, x, y: PNode) =
   case t.kind
@@ -946,7 +915,7 @@ proc symPrototype(g: ModuleGraph; typ: PType; owner: PSym; kind: TTypeAttachedOp
 
   result.typ = newProcType(info, nextTypeId(idgen), owner)
   result.typ.addParam dest
-  if kind notin {attachedDestructor, attachedDispose}:
+  if kind != attachedDestructor:
     result.typ.addParam src
 
   if kind == attachedAsgn and g.config.selectedGC == gcOrc and
@@ -980,7 +949,7 @@ proc produceSym(g: ModuleGraph; c: PContext; typ: PType; kind: TTypeAttachedOp;
 
   let dest = result.typ.n[1].sym
   let d = newDeref(newSymNode(dest))
-  let src = if kind in {attachedDestructor, attachedDispose}: newNodeIT(nkSym, info, getSysType(g, info, tyPointer))
+  let src = if kind == attachedDestructor: newNodeIT(nkSym, info, getSysType(g, info, tyPointer))
             else: newSymNode(result.typ.n[2].sym)
 
   # register this operation already:
@@ -1098,13 +1067,13 @@ proc createTypeBoundOps(g: ModuleGraph; c: PContext; orig: PType; info: TLineInf
 
   # we do not generate '=trace' nor '=dispose' procs if we
   # have the cycle detection disabled, saves code size.
-  let lastAttached = if g.config.selectedGC == gcOrc: attachedDispose
+  let lastAttached = if g.config.selectedGC == gcOrc: attachedTrace
                      else: attachedSink
 
   # bug #15122: We need to produce all prototypes before entering the
   # mind boggling recursion. Hacks like these imply we should rewrite
   # this module.
-  var generics: array[attachedDestructor..attachedDispose, bool]
+  var generics: array[attachedDestructor..attachedTrace, bool]
   for k in attachedDestructor..lastAttached:
     generics[k] = getAttachedOp(g, canon, k) != nil
     if not generics[k]:
diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim
index 2907d5172..c3402aee3 100644
--- a/compiler/semstmts.nim
+++ b/compiler/semstmts.nim
@@ -1753,8 +1753,6 @@ proc semOverride(c: PContext, s: PSym, n: PNode) =
                 "signature for '" & s.name.s & "' must be proc[T: object](x: var T; y: T)")
   of "=trace":
     bindTypeHook(c, s, n, attachedTrace)
-  of "=dispose":
-    bindTypeHook(c, s, n, attachedDispose)
   else:
     if sfOverriden in s.flags:
       localError(c.config, n.info, errGenerated,
diff --git a/doc/manual.rst b/doc/manual.rst
index a99c4b5af..9ddf02009 100644
--- a/doc/manual.rst
+++ b/doc/manual.rst
@@ -3841,7 +3841,7 @@ the operator is in scope (including if it is private).
   doAssert witness == 3
 
 Type bound operators currently include:
-`=destroy`, `=copy`, `=sink`, `=trace`, `=dispose`, `=deepcopy`
+`=destroy`, `=copy`, `=sink`, `=trace`, `=deepcopy`
 (some of which are still implementation defined and not yet documented).
 
 For more details on some of those procs, see
diff --git a/lib/system.nim b/lib/system.nim
index a4608997a..090ab309e 100644
--- a/lib/system.nim
+++ b/lib/system.nim
@@ -1779,7 +1779,6 @@ when not defined(js) and defined(nimV2):
       align: int
       name: cstring
       traceImpl: pointer
-      disposeImpl: pointer
       typeInfoV1: pointer # for backwards compat, usually nil
       flags: int
     PNimTypeV2 = ptr TNimTypeV2
diff --git a/lib/system/cellseqs_v2.nim b/lib/system/cellseqs_v2.nim
index 59cf67dcd..27be48d78 100644
--- a/lib/system/cellseqs_v2.nim
+++ b/lib/system/cellseqs_v2.nim
@@ -10,20 +10,20 @@
 # Cell seqs for cyclebreaker and cyclicrefs_v2.
 
 type
-  CellTuple = (PT, PNimTypeV2)
-  CellArray = ptr UncheckedArray[CellTuple]
-  CellSeq = object
+  CellTuple[T] = (T, PNimTypeV2)
+  CellArray[T] = ptr UncheckedArray[CellTuple[T]]
+  CellSeq[T] = object
     len, cap: int
-    d: CellArray
+    d: CellArray[T]
 
-proc add(s: var CellSeq, c: PT; t: PNimTypeV2) {.inline.} =
+proc add[T](s: var CellSeq[T], c: T; t: PNimTypeV2) {.inline.} =
   if s.len >= s.cap:
     s.cap = s.cap * 3 div 2
     when compileOption("threads"):
-      var d = cast[CellArray](allocShared(uint(s.cap * sizeof(CellTuple))))
+      var d = cast[CellArray[T]](allocShared(uint(s.cap * sizeof(CellTuple[T]))))
     else:
-      var d = cast[CellArray](alloc(s.cap * sizeof(CellTuple)))
-    copyMem(d, s.d, s.len * sizeof(CellTuple))
+      var d = cast[CellArray[T]](alloc(s.cap * sizeof(CellTuple[T])))
+    copyMem(d, s.d, s.len * sizeof(CellTuple[T]))
     when compileOption("threads"):
       deallocShared(s.d)
     else:
@@ -33,15 +33,15 @@ proc add(s: var CellSeq, c: PT; t: PNimTypeV2) {.inline.} =
   s.d[s.len] = (c, t)
   inc(s.len)
 
-proc init(s: var CellSeq, cap: int = 1024) =
+proc init[T](s: var CellSeq[T], cap: int = 1024) =
   s.len = 0
   s.cap = cap
   when compileOption("threads"):
-    s.d = cast[CellArray](allocShared(uint(s.cap * sizeof(CellTuple))))
+    s.d = cast[CellArray[T]](allocShared(uint(s.cap * sizeof(CellTuple[T]))))
   else:
-    s.d = cast[CellArray](alloc(s.cap * sizeof(CellTuple)))
+    s.d = cast[CellArray[T]](alloc(s.cap * sizeof(CellTuple[T])))
 
-proc deinit(s: var CellSeq) =
+proc deinit[T](s: var CellSeq[T]) =
   if s.d != nil:
     when compileOption("threads"):
       deallocShared(s.d)
@@ -51,6 +51,6 @@ proc deinit(s: var CellSeq) =
   s.len = 0
   s.cap = 0
 
-proc pop(s: var CellSeq): (PT, PNimTypeV2) =
+proc pop[T](s: var CellSeq[T]): (T, PNimTypeV2) =
   result = s.d[s.len-1]
   dec s.len
diff --git a/lib/system/cyclebreaker.nim b/lib/system/cyclebreaker.nim
index a3159f95c..6ec0f01f7 100644
--- a/lib/system/cyclebreaker.nim
+++ b/lib/system/cyclebreaker.nim
@@ -53,7 +53,6 @@ depth-first traversal suffices.
 
 ]#
 
-type PT = ptr pointer
 include cellseqs_v2
 
 const
@@ -78,7 +77,7 @@ proc nimMarkCyclic(p: pointer) {.compilerRtl, inl.} = discard
 
 type
   GcEnv = object
-    traceStack: CellSeq
+    traceStack: CellSeq[ptr pointer]
 
 proc trace(p: pointer; desc: PNimTypeV2; j: var GcEnv) {.inline.} =
   when false:
diff --git a/lib/system/orc.nim b/lib/system/orc.nim
index df81afcf1..6273e1a21 100644
--- a/lib/system/orc.nim
+++ b/lib/system/orc.nim
@@ -14,7 +14,6 @@
 # R.D. Lins / Information Processing Letters 109 (2008) 71–78
 #
 
-type PT = Cell
 include cellseqs_v2
 
 const
@@ -68,10 +67,10 @@ const
 
 type
   GcEnv = object
-    traceStack: CellSeq
+    traceStack: CellSeq[ptr pointer]
     when useJumpStack:
-      jumpStack: CellSeq   # Lins' jump stack in order to speed up traversals
-    toFree: CellSeq
+      jumpStack: CellSeq[ptr pointer]   # Lins' jump stack in order to speed up traversals
+    toFree: CellSeq[Cell]
     freed, touched, edges, rcSum: int
     keepThreshold: bool
 
@@ -92,13 +91,13 @@ proc free(s: Cell; desc: PNimTypeV2) {.inline.} =
 
   when logOrc: writeCell("free", s, desc)
 
-  if desc.disposeImpl != nil:
-    cast[DisposeProc](desc.disposeImpl)(p)
+  if desc.destructor != nil:
+    cast[DestructorProc](desc.destructor)(p)
 
   when false:
     cstderr.rawWrite desc.name
     cstderr.rawWrite " "
-    if desc.disposeImpl == nil:
+    if desc.destructor == nil:
       cstderr.rawWrite "lacks dispose"
       if desc.traceImpl != nil:
         cstderr.rawWrite ", but has trace\n"
@@ -125,16 +124,16 @@ proc nimTraceRef(q: pointer; desc: PNimTypeV2; env: pointer) {.compilerRtl, inli
     orcAssert strstr(desc.name, "TType") == nil, "following a TType but it's acyclic!"
 
     var j = cast[ptr GcEnv](env)
-    j.traceStack.add(head p[], desc)
+    j.traceStack.add(p, desc)
 
 proc nimTraceRefDyn(q: pointer; env: pointer) {.compilerRtl, inline.} =
   let p = cast[ptr pointer](q)
   if p[] != nil:
     var j = cast[ptr GcEnv](env)
-    j.traceStack.add(head p[], cast[ptr PNimTypeV2](p[])[])
+    j.traceStack.add(p, cast[ptr PNimTypeV2](p[])[])
 
 var
-  roots {.threadvar.}: CellSeq
+  roots {.threadvar.}: CellSeq[Cell]
 
 proc unregisterCycle(s: Cell) =
   # swap with the last element. O(1)
@@ -162,7 +161,8 @@ proc scanBlack(s: Cell; desc: PNimTypeV2; j: var GcEnv) =
   trace(s, desc, j)
   when logOrc: writeCell("root still alive", s, desc)
   while j.traceStack.len > until:
-    let (t, desc) = j.traceStack.pop()
+    let (entry, desc) = j.traceStack.pop()
+    let t = head entry[]
     inc t.rc, rcIncrement
     if t.color != colBlack:
       t.setColor colBlack
@@ -187,7 +187,8 @@ proc markGray(s: Cell; desc: PNimTypeV2; j: var GcEnv) =
     orcAssert(j.traceStack.len == 0, "markGray: trace stack not empty")
     trace(s, desc, j)
     while j.traceStack.len > 0:
-      let (t, desc) = j.traceStack.pop()
+      let (entry, desc) = j.traceStack.pop()
+      let t = head entry[]
       dec t.rc, rcIncrement
       inc j.edges
       when useJumpStack:
@@ -195,7 +196,7 @@ proc markGray(s: Cell; desc: PNimTypeV2; j: var GcEnv) =
           t.rc = t.rc or jumpStackFlag
           when traceCollector:
             cprintf("[Now in jumpstack] %p %ld color %ld in jumpstack %ld\n", t, t.rc shr rcShift, t.color, t.rc and jumpStackFlag)
-          j.jumpStack.add(t, desc)
+          j.jumpStack.add(entry, desc)
       if t.color != colGray:
         t.setColor colGray
         inc j.touched
@@ -225,7 +226,8 @@ proc scan(s: Cell; desc: PNimTypeV2; j: var GcEnv) =
         # that are still alive; we also need to mark what they
         # refer to as alive:
         while j.jumpStack.len > 0:
-          let (t, desc) = j.jumpStack.pop
+          let (entry, desc) = j.jumpStack.pop
+          let t = head entry[]
           # not in jump stack anymore!
           t.rc = t.rc and not jumpStackFlag
           if t.color == colGray and (t.rc shr rcShift) >= 0:
@@ -239,7 +241,8 @@ proc scan(s: Cell; desc: PNimTypeV2; j: var GcEnv) =
       s.setColor(colWhite)
       trace(s, desc, j)
       while j.traceStack.len > 0:
-        let (t, desc) = j.traceStack.pop()
+        let (entry, desc) = j.traceStack.pop()
+        let t = head entry[]
         if t.color == colGray:
           if (t.rc shr rcShift) >= 0:
             scanBlack(t, desc, j)
@@ -249,7 +252,8 @@ proc scan(s: Cell; desc: PNimTypeV2; j: var GcEnv) =
               # that are still alive; we also need to mark what they
               # refer to as alive:
               while j.jumpStack.len > 0:
-                let (t, desc) = j.jumpStack.pop
+                let (entry, desc) = j.jumpStack.pop
+                let t = head entry[]
                 # not in jump stack anymore!
                 t.rc = t.rc and not jumpStackFlag
                 if t.color == colGray and (t.rc shr rcShift) >= 0:
@@ -285,7 +289,9 @@ proc collectColor(s: Cell; desc: PNimTypeV2; col: int; j: var GcEnv) =
     j.toFree.add(s, desc)
     trace(s, desc, j)
     while j.traceStack.len > 0:
-      let (t, desc) = j.traceStack.pop()
+      let (entry, desc) = j.traceStack.pop()
+      let t = head entry[]
+      entry[] = nil # ensure that the destructor does touch moribund objects!
       if t.color == col and t.rootIdx == 0:
         j.toFree.add(t, desc)
         t.setColor(colBlack)
diff --git a/tests/arc/thamming_orc.nim b/tests/arc/thamming_orc.nim
new file mode 100644
index 000000000..463f7117e
--- /dev/null
+++ b/tests/arc/thamming_orc.nim
@@ -0,0 +1,155 @@
+discard """
+  output: '''(allocCount: 1114, deallocCount: 1112)
+created 439 destroyed 402'''
+  cmd: "nim c --gc:orc -d:nimAllocStats $file"
+"""
+
+# bug #18421
+
+# test Nim Hamming Number Lazy List algo with reference counts and not...
+# compile with "-d:release -d:danger" and test with various
+# memory managment GC's, allocators, threading, etc.
+# it should be guaranteed to work with zero memory leaks with `--gc:orc`...
+
+# compile with `-d:trace20` to trace creation and destruction of first 20 values.
+
+from math import log2
+
+# implement our own basic BigInt so the bigints library isn't necessary...
+type
+  BigInt = object
+    digits: seq[uint32]
+let zeroBigInt = BigInt(digits: @[ 0'u32 ])
+let oneBigInt = BigInt(digits: @[ 1'u32 ])
+
+proc shladd(bi: var BigInt; n: int; a: BigInt) =
+  # assume that both `bi` and `a` are sized correctly with
+  # msuint32 for both not containing a zero
+  let alen = a.digits.len
+  let mx = max(bi.digits.len, a.digits.len)
+  for i in bi.digits.len ..< mx: bi.digits.add 0'u32
+  var cry = 0'u64
+  for i in 0 ..< alen:
+    cry += (bi.digits[i].uint64 shl n) + a.digits[i].uint64
+    bi.digits[i] = cry.uint32; cry = cry shr 32
+  for i in alen ..< mx:
+    cry += bi.digits[i].uint64 shl n
+    bi.digits[i] = cry.uint32; cry = cry shr 32
+  if cry > 0'u64:
+    bi.digits.add cry.uint32
+
+proc `$`(x: BigInt): string =
+  if x.digits.len == 0 or (x.digits.len == 1 and x.digits[0] == 0'u32):
+    return "0"
+  result = ""; var n = x; var msd = n.digits.high
+  while msd >= 0:
+    if n.digits[msd] == 0'u32: msd.dec; continue
+    var brw = 0.uint64
+    for i in countdown(msd, 0):
+      let dvdnd = n.digits[i].uint64 + (brw shl 32)
+      let q = dvdnd div 10'u64; brw = dvdnd - q * 10'u64
+      n.digits[i] = q.uint32
+    result &= $brw
+  for i in 0 .. result.high shr 1: # reverse result string in place
+    let tmp = result[^(i + 1)]
+    result[^(i + 1)] = result[i]
+    result[i] = tmp
+
+type TriVal = (uint32, uint32, uint32)
+type LogRep = (float64, TriVal)
+type LogRepf = proc(x: LogRep): LogRep
+const one: LogRep = (0.0'f64, (0'u32, 0'u32, 0'u32))
+proc `<`(me: LogRep, othr: LogRep): bool = me[0] < othr[0]
+
+proc convertTriVal2BigInt(tpl: TriVal): BigInt =
+  result = oneBigInt
+  let (x2, x3, x5) = tpl
+  for _ in 1 .. x2: result.shladd 1, zeroBigInt
+  for _ in 1 .. x3: result.shladd 1, result
+  for _ in 1 .. x5: result.shladd 2, result
+
+const lb2 = 1.0'f64
+const lb3 = 3.0'f64.log2
+const lb5 = 5.0'f64.log2
+
+proc mul2(me: LogRep): LogRep =
+  let (lr, tpl) = me; let (x2, x3, x5) = tpl
+  (lr + lb2, (x2 + 1, x3, x5))
+
+proc mul3(me: LogRep): LogRep =
+  let (lr, tpl) = me; let (x2, x3, x5) = tpl
+  (lr + lb3, (x2, x3 + 1, x5))
+
+proc mul5(me: LogRep): LogRep =
+  let (lr, tpl) = me; let (x2, x3, x5) = tpl
+  (lr + lb5, (x2, x3, x5 + 1))
+
+type
+  LazyListObj = object
+    hd: LogRep
+    tlf: proc(): LazyList {.closure.}
+    tl: LazyList
+  LazyList = ref LazyListObj
+
+var destroyed = 0
+
+proc `=destroy`(ll: var LazyListObj) =
+  if ll.tlf == nil and ll.tl == nil: return
+  destroyed += 1
+
+  when defined(trace20):
+    echo "destroying:  ", (destroyed, ll.hd[1].convertTriVal2BigInt)
+  if ll.tlf != nil: ll.tlf.`=destroy`
+  if ll.tl != nil: ll.tl.`=destroy`
+  #wasMoved(ll)
+
+proc rest(ll: LazyList): LazyList = # not thread-safe; needs lock on thunk
+  if ll.tlf != nil: ll.tl = ll.tlf(); ll.tlf = nil
+  ll.tl
+
+var created = 0
+iterator hammings(until: int): TriVal =
+  proc merge(x, y: LazyList): LazyList =
+    let xh = x.hd; let yh = y.hd; created += 1
+    when defined(trace20):
+      echo "merge create:  ", (created - 1, (if xh < yh: xh else: yh)[1].convertTriVal2BigInt)
+    if xh < yh: LazyList(hd: xh, tlf: proc(): auto = merge x.rest, y)
+    else: LazyList(hd: yh, tlf: proc(): auto = merge x, y.rest)
+  proc smult(mltf: LogRepf; s: LazyList): LazyList =
+    proc smults(ss: LazyList): LazyList =
+      when defined(trace20):
+        echo "mult create:  ", (created, ss.hd.mltf[1].convertTriVal2BigInt)
+      created += 1; LazyList(hd: ss.hd.mltf, tlf: proc(): auto = ss.rest.smults)
+    s.smults
+  proc unnsm(s: LazyList, mltf: LogRepf): LazyList =
+    var r: LazyList = nil
+    when defined(trace20):
+      echo "first create:  ", (created, one[1].convertTriVal2BigInt)
+    let frst = LazyList(hd: one, tlf: proc(): LazyList = r); created += 1
+    r = if s == nil: smult(mltf, frst) else: s.merge smult(mltf, frst)
+    r
+  yield one[1]
+  var hmpll: LazyList = ((nil.unnsm mul5).unnsm mul3).unnsm mul2
+  for _ in 2 .. until:
+    yield hmpll.hd[1]; hmpll = hmpll.rest # almost forever
+
+proc main =
+  var s = ""
+  for h in hammings(20): s &= $h.convertTrival2BigInt & " "
+  doAssert s == "1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30 32 36 ",
+           "Algorithmic error finding first 20 Hamming numbers!!!"
+
+  when not defined(trace20):
+    var lsth: TriVal; created = 0; destroyed = 0
+    for h in hammings(200): lsth = h
+    doAssert $lsth.convertTriVal2BigInt == "16200",
+             "Algorithmic error finding 200th Hamming number!!!"
+
+let mem = getOccupiedMem()
+main()
+GC_FullCollect()
+let mb = getOccupiedMem() - mem
+#doAssert mb == 0, "Found memory leak of " & $mb & " bytes!!!"
+
+echo getAllocStats()
+echo "created ", created, " destroyed ", destroyed