https://arxiv.org/abs/2509.20534

Well, using "hash consing" to eliminate common sub expression
is not a new idea, in fact, fricas is doing a better job via
Kernel than the authors described in their paper.
(Although they fail to realize that in section 5.3).

(Off topic a little: it seems that Reduce also has the notion
of Kernel, I wonder if this idea came from Reduce first,
or Scratchpad first, or both individually.)

Now, what is interesting to me from this paper is,
"weak-reference hash table".

If an entry in "weak-reference hash table" is not referenced
elsewhere, then garbage collector can recycle that.

I believe this can help to solve this issue for fricas:
we can't GC kernels from cache.  Once a kernel is entered and
cached into the system, it stays there forever.
So for a long computation session, the kernel cache keeps
growing, and can slowdown the following computation.
(For example, we compute a thousand integrals in one session.
We can work around that by issuing ")clear", but let GC
taking care of it automatically is better and the correct
thing to do.)

Luckily, SBCL provides :weakness to "make-hash-table".


Our current Kernel cache implementation, if I understand correctly,
it was a linear list at frist, then Waldek optimize to Array to
allow binary search, then Kurt and I find that there's no
well defined order so binary search is unsound, so linear search
is back.

So changing current Array implementation to Lisp hashtable
should not have much performance impact, if any, it should
be faster.


It surprises me how well the abstraction and encapsulation
is provided by fricas.  To change such a key component
is very quick and painless.  This is just a proof of concept,
the "keys" call should be optimized into "with-hash-table-iterator".
And 10 tests are failed, probably due to the order of
kernels/expression is not the same as before.


So with the patch in attachment, I can confirm that unused kernels
(for unused kernels, I mean stuff like [sin x for x in 1..1000])
can be recycled by GC, in *spad* code (compiler) but not in interpreter.
I've already disabled history by ")set history off".  I wonder
are there variables reference values computed in interpreter?

- Qian

-- 
You received this message because you are subscribed to the Google Groups 
"FriCAS - computer algebra system" group.
To unsubscribe from this group and stop receiving emails from it, send an email 
to [email protected].
To view this discussion visit 
https://groups.google.com/d/msgid/fricas-devel/4be7d5bd-422a-48e0-b690-e1f2a681bdb8%40gmail.com.
diff --git a/src/algebra/kl.spad b/src/algebra/kl.spad
index 0365b60f..e19f917a 100644
--- a/src/algebra/kl.spad
+++ b/src/algebra/kl.spad
@@ -28,6 +28,7 @@ SortedCache(S : CachableSet) : Exports == Implementation where
   Exports ==> with
     clearCache  : () -> Void
       ++ clearCache() empties the cache.
+    getCache : () -> HashTable(S, Boolean, "EQ")
     enterInCache : (S, S -> Boolean) -> S
       ++ enterInCache(x, f) enters x in the cache, calling \spad{f(y)} to
       ++ determine whether x is equal to y. It returns x with an integer
@@ -47,145 +48,26 @@ SortedCache(S : CachableSet) : Exports == Implementation where
       ++ if f(x, y) is 0 or "failed" if no such y exists.
 
   Implementation ==> add
-    shiftCache   : (N, N) -> Void
-    insertInCache : (N, S, N) -> S
-    expandCache : (S) -> Void
-    insertBefore : (N, S) -> Void
-
-    cache : PrimitiveArray S := empty()$(PrimitiveArray S)
-    cache_size : N := 0
-    cache_use : N := 0
-
-    expandCache(x) ==
-        if cache_size = cache_use then
-            ocache := cache
-            cache_size := 2*cache_size + 10
-            cache := new(cache_size, x)$(PrimitiveArray S)
-            for k in 0..(cache_use - 1) repeat
-                cache(k) := ocache(k)
-        void
-
-    insertBefore(l, x) ==
-        k : Integer
-        expandCache(x)
-        vscan := cache
-        for k in 0..(cache_use - l - 1) repeat
-            vscan(cache_use - k) := vscan(cache_use - k - 1)
-        vscan(l) := x
-        cache_use := cache_use + 1
-        void
-
-    shiftCache(l, n) ==
-        k : Integer
-        vscan := cache
-        for k in l..(cache_use - 1) repeat
-            x := vscan(k)
-            setPosition(x, n + position x)
-        void
-
-    clearCache() ==
-        k : Integer
-        vscan := cache
-        for k in 0..(cache_use - 1) repeat
-            x := vscan(k)
-            setPosition(x, 0)
-        cache := empty()$(PrimitiveArray S)
-        cache_size := 0
-        cache_use := 0
-        void
-
-    insertAtEnd(x : S) : Void ==
-        expandCache(x)
-        cache(cache_use) := x
-        cache_use := cache_use + 1
-        void
+    cache : HashTable(S, Boolean, "EQ") := MAKE_WEAK_HASHTABLE()$Lisp
+    i : NonNegativeInteger := 1
+
+    getCache () == cache
+    clearCache() == cache := MAKE_WEAK_HASHTABLE()$Lisp
 
     linearSearch(equal? : S -> Boolean) ==
-        k : Integer := 0
-        -- Can not use for loop because equal? can insert new elements
-        -- and change cache_use
-        while k < cache_use repeat
-            vscan := cache
-            y := vscan(k)
-            equal?(y) => return y
-            vscan := cache
-            -- skip over elements possibly inserted by equal?
-            while not(EQ(y, vscan(k))$Lisp) repeat k := k + 1
-            k := k + 1
-        return "failed"
+        res := select(equal?, keys(cache))
+        empty? res => "failed"
+        first res
 
     enterInCache(x : S, equal? : S -> Boolean) ==
         (res := linearSearch(equal?)) case S => res
-        setPosition(x, 1 + cache_use)
-        insertAtEnd(x)
+        setPosition(x, i); i := i + 1
+        setelt!(cache, x, true)
         x
 
-    search_body ==>
-        vscan := cache
-        l : Integer := -1
-        m : Integer := cache_use
-        m0 := m
-        while (l + 1) < m repeat
-            vl : S
-            vm : S
-            m0 := cache_use
-            if not(l < 0) then
-                vl := qelt(vscan, l)
-            has_vm := false
-            if m < m0 then
-                vm := qelt(vscan, m)
-                has_vm := true
-            i := shift(l + m, -1)
-            cp := triage(x, y := qelt(vscan, i))
-            zero?(cp) => return y
-            vscan := cache
-            if not(l < 0) then
-                if not(EQ(vl, qelt(vscan, l))$Lisp) then
-                    l0 := l
-                    while not(EQ(vl, qelt(vscan, l))$Lisp) repeat
-                        l := l + 1
-                    i := i + l - l0
-                    m := m + l - l0
-            if not(EQ(y, qelt(vscan, i))$Lisp) then
-                i0 := i
-                while not(EQ(y, qelt(vscan, i))$Lisp) repeat
-                    i := i + 1
-                m := m + i - i0
-            if has_vm then
-                if not(EQ(vm, qelt(vscan, m))$Lisp) then
-                    while not(EQ(vm, qelt(vscan, m))$Lisp) repeat
-                        m := m + 1
-            if cp < 0 then
-                m := i
-            else
-                l := i
-
-    binarySearch(x : S, triage : (S, S) -> Integer) ==
-        zero?(cache_use) => "failed"
-        search_body
-        "failed"
-
     enterInCache(x : S, triage : (S, S) -> Integer) ==
-        zero?(cache_use) =>
-            setPosition(x, DIFF)
-            insertAtEnd(x)
-            return x
-        search_body
-        m = cache_use =>
-            setPosition(x, (position qelt(vscan, m - 1)) + DIFF)
-            insertAtEnd(x)
-            return x
-        pos : N :=
-                l < 0 => 0
-                position qelt(vscan, l)
-        insertInCache((l+1)::N, x, pos)
-
-    insertInCache(before, x, pos) ==
-        y := cache(before)
-        if ((pos+1) = position y) then shiftCache(before, DIFF)
-        setPosition(x, pos + (((position y) - pos)::N quo 2))
-        insertBefore(before, x)
-        x
+        eqfun : S -> Boolean := y +-> triage(x,y)=0
+        enterInCache(x, eqfun)
 
 )abbrev domain MKCHSET MakeCachableSet
 ++ Make a cachable set from any set
@@ -324,7 +206,6 @@ Kernel(S : Comparable) : Exports == Implementation where
         triage(k1, k2) = 0
 
     kernelEnterInCache(k : %) : % ==
-        (res := binarySearch(k, triage)) case % => res
         if (f0 := property(operator k, SPECIALEQUAL)) case None then
             f1 := (f0@None) pretend ((%, %) -> Boolean)
             (res := linearSearch(y +-> kerEqual(k, y, f1))) case % =>
diff --git a/src/lisp/primitives.lisp b/src/lisp/primitives.lisp
index 65783b28..99b21312 100644
--- a/src/lisp/primitives.lisp
+++ b/src/lisp/primitives.lisp
@@ -597,6 +597,9 @@
          (t (error "bad arg to MAKE_HASHTABLE")))
 )
 
+(defun MAKE_WEAK_HASHTABLE ()
+    (make-hash-table :test 'eq :weakness :key))
+
 ; Misc operations
 
 (defmacro |qset_first|(l x) `(SETF (CAR (the cons ,l)) ,x))

Reply via email to