Simplified the code a bit more. See attachment.
- 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/1266e47c-3cb6-4154-875e-cc6cdb60f0c2%40gmail.com.
diff --git a/src/algebra/kl.spad b/src/algebra/kl.spad
index 0365b60f..e5027a90 100644
--- a/src/algebra/kl.spad
+++ b/src/algebra/kl.spad
@@ -28,6 +28,9 @@ SortedCache(S : CachableSet) : Exports == Implementation where
Exports ==> with
clearCache : () -> Void
++ clearCache() empties the cache.
+ getCache : () -> PrimitiveArray S
+ compactCache : () -> Void
+ setExpandCacheThreshold : PositiveInteger -> PositiveInteger
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
@@ -55,11 +58,25 @@ SortedCache(S : CachableSet) : Exports == Implementation where
cache : PrimitiveArray S := empty()$(PrimitiveArray S)
cache_size : N := 0
cache_use : N := 0
+ ExpandCacheThreshold : PositiveInteger := 300
+
+ getCache() == cache
+
+ setExpandCacheThreshold n ==
+ old := ExpandCacheThreshold
+ ExpandCacheThreshold :=n
+ old
+
+ compactCache() ==
+ cache_size = 0 => void()
+ cache_use := COMPACT_WEAK_ARRAY(cache, cache_use, cache.0)$Lisp
+ void()
expandCache(x) ==
if cache_size = cache_use then
+ compactCache()
ocache := cache
- cache_size := 2*cache_size + 10
+ cache_size := cache_use + ExpandCacheThreshold
cache := new(cache_size, x)$(PrimitiveArray S)
for k in 0..(cache_use - 1) repeat
cache(k) := ocache(k)
@@ -67,7 +84,6 @@ SortedCache(S : CachableSet) : Exports == Implementation where
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)
@@ -95,7 +111,6 @@ SortedCache(S : CachableSet) : Exports == Implementation where
void
insertAtEnd(x : S) : Void ==
- expandCache(x)
cache(cache_use) := x
cache_use := cache_use + 1
void
@@ -116,6 +131,7 @@ SortedCache(S : CachableSet) : Exports == Implementation where
enterInCache(x : S, equal? : S -> Boolean) ==
(res := linearSearch(equal?)) case S => res
+ expandCache(x)
setPosition(x, 1 + cache_use)
insertAtEnd(x)
x
@@ -166,6 +182,7 @@ SortedCache(S : CachableSet) : Exports == Implementation where
"failed"
enterInCache(x : S, triage : (S, S) -> Integer) ==
+ expandCache(x)
zero?(cache_use) =>
setPosition(x, DIFF)
insertAtEnd(x)
diff --git a/src/lisp/primitives.lisp b/src/lisp/primitives.lisp
index 65783b28..4b941e2f 100644
--- a/src/lisp/primitives.lisp
+++ b/src/lisp/primitives.lisp
@@ -892,3 +892,41 @@
`(let ((|$BreakMode| '|trapSpadErrors|))
(declare (special |$BreakMode|))
(CATCH '|trapSpadErrors| ,form)))
+
+(defun fullgc ()
+ #+:cmu
+ (ext:gc :full t)
+ #+:sbcl
+ (sb-ext:gc :full t)
+ #-(or :cmu :sbcl)
+ (reclaim))
+
+(defun make-weak-pointer (object)
+ #+(or :clisp :cmu :ecl)
+ (ext:make-weak-pointer object)
+ #+:sbcl
+ (sb-ext:make-weak-pointer object))
+
+(defun weak-pointer-value (weak-pointer)
+ #+(or :clisp :cmu :ecl)
+ (ext:weak-pointer-value weak-pointer)
+ #+:sbcl
+ (sb-ext:weak-pointer-value weak-pointer))
+
+(defun COMPACT_WEAK_ARRAY (array size default_element)
+ ;; return the size of array after compact
+ #+(or :clisp :cmu :ecl :sbcl)
+ (progn
+ (dotimes (i size)
+ (setf (aref array i) (make-weak-pointer (aref array i))))
+ (fullgc)
+ (do ((i 0 (1+ i)) (j 0))
+ ((= i size) j)
+ (multiple-value-bind (value valid)
+ (weak-pointer-value (aref array i))
+ (if valid (progn (setf (aref array j) value)
+ (setq j (1+ j))))
+ (if (> i j) (setf (aref array i) default_element)))))
+
+ #-(or :clisp :cmu :ecl :sbcl)
+ size)
