Fuzion Logo
flang.dev — The Fuzion Language Portal
JavaScript seems to be disabled. Functionality is limited.

ctrie.fz


# This file is part of the Fuzion language implementation.
#
# The Fuzion language implementation is free software: you can redistribute it
# and/or modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation, version 3 of the License.
#
# The Fuzion language implementation is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
# License for more details.
#
# You should have received a copy of the GNU General Public License along with The
# Fuzion language implementation.  If not, see <https://www.gnu.org/licenses/>.


# -----------------------------------------------------------------------
#
#  Tokiwa Software GmbH, Germany
#
#  Source code of Fuzion standard library feature CTrie
#
#  Author: Michael Lill (michael.lill@tokiwa.software)
#
# -----------------------------------------------------------------------

# A Fuzion implementation of CTrie invented by Aleksandar Prokopec
# CTrie is a non-blocking concurrent hash trie
#
# reference paper: Concurrent Tries with Efficient Non-Blocking Snapshots
# https://aleksandar-prokopec.com/resources/docs/ctries-snapshot.pdf
#
# reference implementation in Scala: https://github.com/axel22/Ctries/
# on wikipedia: https://en.wikipedia.org/wiki/Ctrie
#
# Complexity (according to the paper):
# insert, lookup, remove                     : O(log n)
# snapshot, amortized size retrieval, clear  : O(1)
#
# NYI (atomic) CAS
# NYI insertif
#
# glossary:
# CTK => ctrie key
# CTV => ctrie value
# k   => key
# v   => value
# gen => generation
# lev => level
# bmp => bitmap
# idx => index
# W   => 2^W-way branching factor
#


# a tomb node
# "a T-node is the last value assigned to an I-node"
private TNode(CTK (hasHash CTK).type, CTV type, sn SNode CTK CTV) is
  redef asString => "TNode($sn)"

  asList => sn.asList


# a singleton node
# the node type containing actual data
private SNode(CTK (hasHash CTK).type, CTV type, k CTK, v CTV) is
  redef asString => "SNode($k, $v)"

  asList => [(k,v)].asList


# an indirection or a singleton node
private Branch(CTK (hasHash CTK).type, CTV type) : choice (INode CTK CTV) (SNode CTK CTV) is
  redef asString =>
    match Branch.this
      iNode INode => "$iNode"
      sNode SNode => "$sNode"

  asList =>
    match Branch.this
      iNode INode => iNode.asList
      sNode SNode => sNode.asList


# a container node
# consists of a bitmap of filled spaces and an array of child nodes
private CNode(CTK (hasHash CTK).type, CTV type, bmp u32, array array (Branch CTK CTV)) is

  # update a child node and return a new cnode
  updated(pos u32, node Branch CTK CTV) =>
    CNode bmp (array.put pos.as_i32 node)

  # insert a child node and return a new cnode
  inserted(pos, flag u32, sn SNode CTK CTV) =>
    CNode (bmp | flag) (array.insert pos.as_i32 sn).asArray

  # remove a child node and return a new cnode
  removed(pos, flag u32) =>
    # NYI delete/remove should be in stdlib
    tmp := array.take pos.as_i32 ++ array.drop (pos + 1).as_i32
    CNode (bmp ^ flag) tmp.asArray


  # create copy of this cnode and children
  renewed(new_gen i32, ct ref CTrie CTK CTV) =>
    copy := array.map (Branch CTK CTV) x->
                     match x
                       i INode => i.copy_to_gen new_gen ct
                       sn SNode => sn
                 .asArray
    CNode bmp copy


  redef asString => "CNode($bmp, [{array.map string x->x.asString
                                        .fold (strings.concat ", ")}])"

  asList => array.flatMapSequence (tuple CTK CTV) (b -> b.asList)
                 .asList


# a container, T or linked list node
# NYI should probably inhert from choice but nesting of choices leads to bugs currently, see: https://github.com/tokiwa-software/fuzion/issues/213
private MainNode(CTK (hasHash CTK).type, CTV type, data choice (CNode CTK CTV) (TNode CTK CTV) (LNode CTK CTV), gen i32) ref : hasEquals (MainNode CTK CTV) is
  redef asString =>
    match data
      cNode CNode => "$cNode"
      tNode TNode => "$tNode"
      lNode LNode => "$lNode"

  # NYI
  infix = (o MainNode CTK CTV) bool is
    MainNode.this.hashCode = o.hashCode

  asList
  pre match prev
    nil => true
    * => false
   =>
    match data
      cNode CNode => cNode.asList
      tNode TNode => tNode.asList
      lNode LNode => lNode.mapSequence (sn -> (sn.k, sn.v))


  # a previous node that gets set during a generational aware compare and set
  prev choice (FNode CTK CTV) (MainNode CTK CTV) nil := nil
  set_prev(m MainNode CTK CTV) unit
  pre match prev
        nil => true
        * => false
  is
    set prev := m

  # compare and set `prev`
  CAS_PREV(o,n choice (FNode CTK CTV) (MainNode CTK CTV) nil) =>
    # NYI
    match n
      f FNode =>
        set prev := f
      * =>
        set prev := nil
    true


# a failed node where the previous indirection node contains a main node
private FNode(CTK (hasHash CTK).type, CTV type, prev MainNode CTK CTV) is

# an indirection node
private INode(CTK (hasHash CTK).type, CTV type, data MainNode CTK CTV) ref : hasEquals (INode CTK CTV) is

  # compare and set
  private CAS(old_n, new_n MainNode CTK CTV) bool is
    # NYI this must be atomic
    # if(main.hash != old_n.hash)
    #   false
    # else
    set data := new_n
    true

  # completes the generation sensitive compare and set
  private GCAS_Commit(m MainNode CTK CTV, ct ref CTrie CTK CTV) MainNode CTK CTV is
    # abortably read root and get the current gen
    gen := (ct.RDCSS_READ_ROOT true).data.gen
    match m.prev
      nil => m
      fn FNode =>
        if CAS m fn.prev
          fn.prev
        else
          GCAS_Commit data ct
      n MainNode =>
        if gen = m.gen && !ct.read_only
          if m.CAS_PREV n nil
            m
          else
            GCAS_Commit m ct
        else
          m.CAS_PREV n (FNode n)
          GCAS_Commit data ct

  # read `data`, if prev is set commit first
  private GCAS_READ(ct ref CTrie CTK CTV) MainNode CTK CTV is
    m := data
    match m.prev
      nil => m
      * => (GCAS_Commit m ct)

  # generation aware compare and set
  GCAS(o MainNode CTK CTV, n MainNode CTK CTV, ct ref CTrie CTK CTV) choice RESTART OK is
    n.set_prev o
    if(CAS o n)
      GCAS_Commit n ct
      match n.prev
        nil => OK
        * => RESTART
    else
      RESTART


  # copy this node to a new generation
  private copy_to_gen(new_gen i32, ct ref CTrie CTK CTV) INode CTK CTV is
    m := GCAS_READ ct
    # increase the generation of node by one
    INode (MainNode m.data new_gen)

  # NYI
  infix = (o INode CTK CTV) bool is
    INode.this.hashCode = o.hashCode

  redef asString => "INode($data)"

  asList list (tuple CTK CTV)
  pre match data.prev
    nil => true
    * => false
  is data.asList


# a linked list node
# NYI instead of Sequence we should use something like the original implementation ListMap(Scala).
private LNode(CTK (hasHash CTK).type, CTV type, from Sequence (SNode CTK CTV)) : Sequence (SNode CTK CTV)
pre from ∀ (sn -> (from.filter (snn -> sn.k.hash = snn.k.hash)).count = 1)
is
  redef asList => from.asList

private RESTART is
private OK is

# the ctrie
# NYI marking ctrie as ref see issue https://github.com/tokiwa-software/fuzion/issues/304
private CTrie(CTK (hasHash CTK).type, CTV type, root choice (INode CTK CTV) RDCSS_Descriptor, read_only bool) ref : map CTK CTV
is

  private CAS_ROOT(ov, nv choice (INode CTK CTV) RDCSS_Descriptor) =>
    # NYI CAS
    set root := nv
    true

  private RDCSS_Complete(abort bool) INode CTK CTV
  is
    match root
      n INode => n
      desc RDCSS_Descriptor =>
        if abort
          if CAS_ROOT desc desc.ov
            desc.ov
          else
            RDCSS_Complete abort
        else
          old_main := desc.ov.GCAS_READ CTrie.this
          if old_main = desc.exp
            if CAS_ROOT desc desc.nv
              desc.nv
            else
              RDCSS_Complete abort
          else
            if CAS_ROOT desc desc.ov
              desc.ov
            else
              RDCSS_Complete abort

  # read root
  # if root is currently a descriptor commit the descriptor first
  private RDCSS_READ_ROOT(abort bool) INode CTK CTV
  is
    match root
      n INode => n
      d RDCSS_Descriptor => RDCSS_Complete abort

  private RDCSS_READ_ROOT() => RDCSS_READ_ROOT false

  private RDCSS_Descriptor(ov INode CTK CTV, exp MainNode CTK CTV, nv INode CTK CTV) is

  private RDCSS_ROOT(desc RDCSS_Descriptor) =>
    if CAS_ROOT desc.ov desc
      RDCSS_Complete false
      true
    else
      false

  NOTFOUND is
    redef asString => "not found"


  # the width of the branching factor, 2^5 = 32
  private W := u32 5


  # convert u64 hash to u32 hash
  private hash(h u64) u32 is
    h.low32bits


  # returns flag and the position in the CNode for given params
  private flagpos(hash u32, lev u32, bmp u32) tuple u32 u32 is
    idx := (hash >> lev) & 0x1F
    flag := u32 1 << idx
    mask := flag -° 1
    pos := (bmp & mask).onesCount.as_u32
    (flag, pos)


  # compress a container node
  private compress(cn CNode CTK CTV, lev u32, gen i32) =>
    narr := cn.array.map (Branch CTK CTV) (n -> match n
                                                  m INode =>
                                                    match m.GCAS_READ(CTrie.this).data
                                                      // resurrect
                                                      tn TNode CTK CTV => tn.sn
                                                      * => m
                                                  sn SNode => sn)
    contract (CNode CTK CTV cn.bmp narr) lev gen


  # contract a container node
  private contract(cn CNode CTK CTV, lev u32, gen i32) MainNode CTK CTV is
    if (lev > 0) & (cn.array.length = 1)
      match cn.array[0]
        sn SNode => MainNode (TNode sn) gen
        i INode => MainNode cn gen
    else
      MainNode cn gen


  # clean an indirection node:
  # compress contained container node
  private clean(nd option (INode CTK CTV), lev u32, gen i32) =>
    if nd??
      m := nd.get.GCAS_READ(CTrie.this)
      match m.data
        c CNode CTK CTV => nd.get.GCAS m (compress c lev gen) CTrie.this
        * =>
    unit


  # turns this: CNode -> INode -> TNode -> SNode
  # into  this: CNode -> SNode
  private clean_parent(parent option (INode CTK CTV), i INode CTK CTV, hash, lev u32, gen i32) =>
    parent >>= (p ->
      m := p.GCAS_READ CTrie.this
      match m.data
        cn CNode CTK CTV =>
          (flag, pos) := flagpos hash lev cn.bmp
          if (cn.bmp & flag) != 0
            sub := cn.array[pos.as_i32]
            match sub
              iNode INode CTK CTV =>
                if iNode = i
                  match i.GCAS_READ(CTrie.this).data
                    tn TNode CTK CTV =>
                      ncn := cn.updated pos tn.sn
                      match (p.GCAS m (contract ncn lev gen) CTrie.this)
                        RESTART => clean_parent p i hash lev gen
                        OK =>
                    * =>
              * =>
        * =>
      nil
      )


  # takes two single nodes and returns either
  # MainNode -> CNode -> SNodes
  # or
  # MainNode -> LNode -> SNodes
  # or recurse
  # MainNode -> CNode -> INode -> dual x y
  private dual(x, y SNode CTK CTV, lev u32, gen i32) MainNode CTK CTV is
    # NYI why 35??
    if lev < 35
      xidx := ((hash x.k.hash) >> lev) & 0x1f
      yidx := ((hash y.k.hash) >> lev) & 0x1f
      bmp := (u32 1 << xidx) | (u32 1 << yidx)
      if xidx = yidx
        subinode := INode CTK CTV (dual x y (lev + W) gen)
        MainNode (CNode CTK CTV bmp [subinode]) gen
      else
        if (xidx < yidx)
          MainNode (CNode CTK CTV bmp [x, y]) gen
        else
          MainNode (CNode CTK CTV bmp [y, x]) gen
    else
      MainNode (LNode [(SNode x.k x.v), (SNode y.k y.v)]) gen


  # lookup key k
  lookup(k CTK) option CTV is
    r := RDCSS_READ_ROOT
    res := ilookup r k 0 nil r.data.gen
    match res
      r RESTART =>
        lookup k
      NOTFOUND =>
        nil
      v CTV =>
        v


  private ilookup(i INode CTK CTV, k CTK, lev u32, parent option (INode CTK CTV), gen i32) choice RESTART NOTFOUND CTV is
    m := i.GCAS_READ CTrie.this
    match m.data
      cn CNode CTK CTV =>
        (flag, pos) := flagpos (hash k.hash) lev cn.bmp
        if (cn.bmp & flag) = 0
          NOTFOUND
        else
          match cn.array[pos.as_i32]
            sin INode =>
              if read_only || gen = sin.data.gen
                ilookup sin k (lev + W) i gen
              else
                match i.GCAS m (MainNode (cn.renewed gen CTrie.this) gen) CTrie.this
                  OK => ilookup i k lev parent gen
                  RESTART => RESTART
            sn SNode =>
              if sn.k = k
                sn.v
              else
                NOTFOUND
      tn TNode CTK CTV =>
        clean parent (lev - W) gen
        RESTART
      ln LNode CTK CTV => find ln k


  # find k in linked nodes
  private find(ln LNode CTK CTV, k CTK) choice RESTART NOTFOUND CTV is
    match ln.dropWhile(sn -> sn.k /= k).head
          nil => NOTFOUND
          sn SNode => sn.v


  # add key value
  # if key is already present value is updated
  add(k CTK, v CTV) unit is
    r := RDCSS_READ_ROOT
    match iinsert r k v 0 nil r.data.gen
      r RESTART =>
        add k v
      OK =>
        unit


  private iinsert(i INode CTK CTV, k CTK, v CTV, lev u32, parent option (INode CTK CTV), gen i32) choice RESTART OK is
    m := i.GCAS_READ CTrie.this
    match m.data
      cn CNode CTK CTV =>
        (flag, pos) := flagpos (hash k.hash) lev cn.bmp
        if (cn.bmp & flag) = 0
          ncn := (if m.gen = gen then cn else cn.renewed gen CTrie.this).inserted pos flag (SNode k v)
          i.GCAS m (MainNode ncn gen) CTrie.this
        else
          match cn.array[pos.as_i32]
            sin INode =>
              if m.gen = gen
                iinsert sin k v (lev+W) i gen
              else
                match (i.GCAS m (MainNode (cn.renewed gen CTrie.this) gen) CTrie.this)
                  OK => iinsert i k v lev parent gen
                  RESTART => RESTART
            sn SNode =>
              if sn.k /= k
                nin := INode (dual sn (SNode k v) (lev + W) i.data.gen)
                ncn := (if m.gen = gen then cn else cn.renewed gen CTrie.this).updated pos nin
                i.GCAS m (MainNode ncn gen) CTrie.this
              else
                ncn := cn.updated pos (SNode k v)
                i.GCAS m (MainNode ncn gen) CTrie.this
      tn TNode =>
        clean parent (lev - W) gen
        RESTART
      ln LNode =>
        i.GCAS m (MainNode (LNode ([SNode k v] ++ (ln.filter (sn -> sn.k /= k)))) i.data.gen) CTrie.this


  # remove key from ctrie
  # calls iremove which does the actual removal
  remove(k CTK) choice NOTFOUND CTV is
    r := RDCSS_READ_ROOT
    match iremove r k 0 nil r.data.gen
      r RESTART => remove k
      n NOTFOUND => n
      v CTV => v

  private iremove(i INode CTK CTV, k CTK, lev u32, parent option (INode CTK CTV), gen i32) choice RESTART NOTFOUND CTV is
    m := i.GCAS_READ CTrie.this
    match m.data
      cn CNode =>
        (flag, pos) := flagpos (hash k.hash) lev cn.bmp
        if (cn.bmp & flag) = 0
          NOTFOUND
        else
          res choice RESTART NOTFOUND CTV := match cn.array[pos.as_i32]
            sin INode =>
              if sin.data.gen = gen
                iremove sin k (lev + W) i gen
              else
                match (i.GCAS m (MainNode (cn.renewed gen CTrie.this) gen) CTrie.this)
                  OK => iremove i k lev parent gen
                  RESTART => RESTART
            sn SNode =>
              if sn.k /= k
                NOTFOUND
              else
                ncn  := cn.removed pos flag
                cntr := contract ncn lev gen
                match (i.GCAS m cntr CTrie.this)
                  OK => sn.v
                  RESTART => RESTART
          match res
            v CTV =>
              match (i.GCAS_READ(CTrie.this)).data
                t TNode => clean_parent parent i hash(k.hash) (lev - W) gen
                * =>
            * =>
          res
      tn TNode =>
        clean parent (lev - W) gen
        RESTART
      ln LNode =>
        fln := LNode ln.filter(sn -> sn.k /= k)
        nln MainNode CTK CTV := if fln.count = 1 then MainNode (TNode fln.first) i.data.gen else MainNode fln i.data.gen
        match (i.GCAS m nln CTrie.this)
          OK => find ln k
          RESTART => RESTART


  # the size of the ctrie
  redef size i32 is
    items.count


  # lookup an element with bracket syntax
  redef index [] (k CTK) option CTV is
    lookup k

  # take a snapshot of the ctrie
  snapshot(read_only bool) CTrie CTK CTV is
    r := RDCSS_READ_ROOT
    expmain := r.GCAS_READ CTrie.this
    if(RDCSS_ROOT (RDCSS_Descriptor r expmain (r.copy_to_gen (r.data.gen +° 1) CTrie.this)))
      # new ctrie by increasing gen of root by one
      CTrie CTK CTV (r.copy_to_gen (r.data.gen +° 1) CTrie.this) read_only
    else
      snapshot read_only


  # a snapshot of the ctrie as sequence auf key-value tuples
  redef items Sequence (tuple CTK CTV) is
    (snapshot true)
      .RDCSS_READ_ROOT
      .asList

# initialize a new ctrie
CTrie(CTK (hasHash CTK).type, CTV type) =>
  CTrie CTK CTV (INode (MainNode (CNode CTK CTV 0 []) 0)) false