mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixed error in SOFT-DELTA-CMPR

Browse Source 
Must be L-CMPR instead of F-CMPR, since CDR returns a list.
This commit is contained in:
gheber 2015-07-08 06:42:31 -05:00
parent 911a74de68
commit b82a5e6884
1 changed files with 241 additions and 242 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
src/delta.lisp
View File

@ -10,13 +10,10 @@
(format stream "~A" (hyphenize-list (dlop-int-ext cdr)))
(cons car cdr))
(DEFUN SOFT-DELTA-CMPR (gmsm1 gmsm2)
(f-cmpr (cdr gmsm1) (cdr gmsm2)))
#|
()
(soft-delta-cmpr (d 12) (d 23))
|#
(DEFUN SOFT-DELTA-CMPR (gmsm1 gmsm2)
(l-cmpr (cdr gmsm1) (cdr gmsm2)))
(DEFUN DELTA-FACE (indx dmns gmsm)
(declare
@ -121,7 +118,8 @@
(with-term (cffc tnpr) term
(with-tnpr (degr1 gmsm1 degr2 gmsm2) tnpr
(term cffc
(tnpr degr1 (d gmsm1) degr2 (d gmsm2))))))
(tnpr degr1 (d gmsm1)
degr2 (d gmsm2))))))
(cmbn-list (delta-dgnl dmns (cdr gmsm))))))
#|
@ -274,28 +272,28 @@
|#
#| For comparison with EAT.
In
(setf delta (delta-infinity))
(setf d (bndr delta))
(setf s14 (mask 15))
(cmbn-? d (gnrt-? d 14 s14))
(defun t1 (n)
In
(setf delta (delta-infinity))
(setf d (bndr delta))
(setf s14 (mask 15))
(cmbn-? d (gnrt-? d 14 s14))
(defun t1 (n)
(time (dotimes (i n) (cmbn-? d (gnrt-? d 14 s14)))))
(compile 't1)
(t1 500)
(setf +too-much-time+ -1)
(t1 500)
(compile 't1)
(t1 500)
(setf +too-much-time+ -1)
(t1 500)
|#
#|
In EAT:
(setf delta *delta*)
(setf d (cc-d (ss-cc delta)))
(setf s14 (<a-b> 0 14))
(??? d (? d 14 s14))
(defun t1 (n)
In EAT:
(setf delta *delta*)
(setf d (cc-d (ss-cc delta)))
(setf s14 (<a-b> 0 14))
(??? d (? d 14 s14))
(defun t1 (n)
(time (dotimes (i n) (??? d (? d 14 s14)))))
(compile 't1)
(t1 500)
(compile 't1)
(t1 500)
|#
(DEFUN DELTAB-CMPR (gmsm1 gmsm2)
@ -354,7 +352,8 @@
(when (logbitp indx gmsm)
(push (term 1 (tnpr
ldegr (logand gmsm (mask (1+ indx)))
(- dmns ldegr) (logandc2 gmsm (mask indx))))
(- dmns ldegr)
(logandc2 gmsm (mask indx))))
rslt)
(when (minusp (decf ldegr))
(setf rslt (delete 1 rslt :key #'caaddr))
@ -390,8 +389,8 @@
(setf sign (- sign))))))))
#|
(deltab-bndr 1 5)
(deltab-bndr 3 15)
(deltab-bndr 1 5)
(deltab-bndr 3 15)
|#
(DEFUN DELTAB ()