diff --git a/src/discrimination_tree.ml b/src/discrimination_tree.ml index 42b0d4185..5d4fb879b 100644 --- a/src/discrimination_tree.ml +++ b/src/discrimination_tree.ml @@ -48,37 +48,35 @@ module type DiscriminationTree = sig end let arity_bits = 4 -let arity_mask = (1 lsl arity_bits) - 1 -let encode c a = (c lsl arity_bits) lor a +let k_bits = 2 + +(* value , arity, k *) +let kConstant = 0 (* (constant << arity_bits) lor arity *) +let kPrimitive = 1 (*Elpi_util.Util.CData.t hash *) +let kVariable = 2 +let kOther = 3 + +let k_mask = (1 lsl k_bits) - 1 +let arity_mask = ((1 lsl arity_bits) lsl k_bits) - 1 +let k_of n = n land k_mask + +let arity_of n = + let k = k_of n in + if k == kConstant then (n land arity_mask) lsr k_bits + else 0 +let encode k c a = ((c lsl arity_bits) lsl k_bits) lor (a lsl k_bits) lor k let mask_low n = n land arity_mask -type cell = - | Constant of int (* (constant << arity_bits) lor arity *) - | Primitive of int (*Elpi_util.Util.CData.t hash *) - | Variable - | Other -[@@deriving show] - -let mkConstant c a = Constant (encode c a) -let mkVariable = Variable -let mkOther = Other -let mkPrimitive c = Primitive (Elpi_util.Util.CData.hash c) - -let arity_of = function - | Constant n -> mask_low n - | Variable | Other | Primitive _ -> 0 +let mkConstant c a = encode kConstant c a +let mkVariable = kVariable +let mkOther = kOther +let mkPrimitive c = (Elpi_util.Util.CData.hash c lsl k_bits) lor kPrimitive +type cell = int [@@deriving show] type path = cell list [@@deriving show] -let compare x y = - match (x, y) with - | Constant x, Constant y -> x - y - | Variable, Variable -> 0 - | Other, Other -> 0 - | Primitive x, Primitive y -> x - y - | _, _ -> compare x y - +let compare x y = x - y let skip (path : path) : path = let rec aux arity path = @@ -92,14 +90,6 @@ let skip (path : path) : path = | [] -> Elpi_util.Util.anomaly "Skipping empty path is not possible" | hd :: tl -> aux (arity_of hd) tl -module OrderedPathStringElement = struct - type t = cell - - let show = show_cell - let pp = pp_cell - let compare = compare -end - module PSMap = Elpi_util.Util.Map.Make (OrderedPathStringElement) module Trie = Trie.Make (PSMap) @@ -136,7 +126,7 @@ let rec merge (l1 : ('a * int) list) l2 = | ((_, tx) as x) :: xs, (_, ty) :: _ when tx > ty -> x :: merge xs l2 | _, y :: ys -> y :: merge l1 ys -let to_unify v unif = v == Other || (v == Variable && unif) +let to_unify v unif = v == kOther || (v == kVariable && unif) (* to_unify returns if a key should be unified with all the values of @@ -159,7 +149,7 @@ and retrieve unif path tree = merge (merge *) - if (not unif) && Variable == node then [] + if (not unif) && kVariable == node then [] else let subtree = try PSMap.find node map with Not_found -> Node ([], PSMap.empty)