aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-05-01 02:27:52 +0000
committerdos-reis <gdr@axiomatics.org>2012-05-01 02:27:52 +0000
commite37c877a8ad003972fc6c0206dc6220e266f0a8b (patch)
tree6a4dafe69f35f013172cdbf7b646064328380986 /src
parent52d8ccbf25a71457f923860824696742328bdb35 (diff)
downloadopen-axiom-e37c877a8ad003972fc6c0206dc6220e266f0a8b.tar.gz
* algebra/integer.spad.pamphlet (Integer): Use %iaddmod, %isubmod,
%imulmod. * algebra/si.spad.pamphlet (SingleInteger): Likewise. * interp/c-util.boot (devaluate): Use # in lieu of QVSIZE. * interp/g-opt.boot: %ilfshift and %irshift are now builtin side-effect free operations. * interp/lisp-backend.boot: Translate them. * interp/g-util.boot (mergeSort): Avoid QSDIFFERENCE. * interp/slam.boot: Likewise. * interp/sys-macros.lisp: Likewise. * interp/macros.lisp: Avoid QVMAXINDEX. * interp/vmlisp.lisp (QSDIFFERENCE): Remove. (QSGREATERP): Likewise. (QSLEFTSHIFT): Likewise. (QSLESSP): Likewise. (QSMAX): Likewise. (QSMIN): Likewise. (QSMINUS): Likewise. (QSMINUSP): Likewise. (QSODDP): Likewise. (QSABSVAL): Likewise. (QSPLUS): Likewise. (QSZEROP): Likewise. (QVMAXINDEX): Likewise. (QVSIZE): Likewise. (ZERO?): Likewise.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog31
-rw-r--r--src/algebra/integer.spad.pamphlet18
-rw-r--r--src/algebra/si.spad.pamphlet13
-rw-r--r--src/interp/c-util.boot2
-rw-r--r--src/interp/g-opt.boot1
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/lisp-backend.boot2
-rw-r--r--src/interp/macros.lisp4
-rw-r--r--src/interp/slam.boot4
-rw-r--r--src/interp/sys-macros.lisp16
-rw-r--r--src/interp/vmlisp.lisp45
11 files changed, 60 insertions, 78 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index ae85c0e4..6a1fff0b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,8 +1,37 @@
2012-04-30 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * algebra/integer.spad.pamphlet (Integer): Use %iaddmod, %isubmod,
+ %imulmod.
+ * algebra/si.spad.pamphlet (SingleInteger): Likewise.
+ * interp/c-util.boot (devaluate): Use # in lieu of QVSIZE.
+ * interp/g-opt.boot: %ilfshift and %irshift are now builtin
+ side-effect free operations.
+ * interp/lisp-backend.boot: Translate them.
+ * interp/g-util.boot (mergeSort): Avoid QSDIFFERENCE.
+ * interp/slam.boot: Likewise.
+ * interp/sys-macros.lisp: Likewise.
+ * interp/macros.lisp: Avoid QVMAXINDEX.
+ * interp/vmlisp.lisp (QSDIFFERENCE): Remove.
+ (QSGREATERP): Likewise.
+ (QSLEFTSHIFT): Likewise.
+ (QSLESSP): Likewise.
+ (QSMAX): Likewise.
+ (QSMIN): Likewise.
+ (QSMINUS): Likewise.
+ (QSMINUSP): Likewise.
+ (QSODDP): Likewise.
+ (QSABSVAL): Likewise.
+ (QSPLUS): Likewise.
+ (QSZEROP): Likewise.
+ (QVMAXINDEX): Likewise.
+ (QVSIZE): Likewise.
+ (ZERO?): Likewise.
+
+2012-04-30 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* algebra/si.spad.pamphlet (SingleInteger): Use %iaddmod,
%isubmod, and %imulmod.
- * interp/g-opt.boot: These are now builtin side-effect operators.
+ * interp/g-opt.boot: These are now builtin side-effect free operators.
(optIaddmod): New optimizer. Register.
(optIsubmod): Likewise.
(optImulmod): Likewise.
diff --git a/src/algebra/integer.spad.pamphlet b/src/algebra/integer.spad.pamphlet
index e7de9302..5806c706 100644
--- a/src/algebra/integer.spad.pamphlet
+++ b/src/algebra/integer.spad.pamphlet
@@ -89,10 +89,14 @@ Integer: IntegerNumberSystem with
import %ieven?: % -> Boolean from Foreign Builtin
import %hash: % -> SingleInteger from Foreign Builtin
import %iadd: (%,%) -> % from Foreign Builtin
+ import %iaddmod: (%,%,%) -> % from Foreign Builtin
import %isub: (%,%) -> % from Foreign Builtin
+ import %isubmod: (%,%,%) -> % from Foreign Builtin
import %imul: (%,%) -> % from Foreign Builtin
+ import %imulmod: (%,%,%) -> % from Foreign Builtin
import %irem: (%,%) -> % from Foreign Builtin
import %iquo: (%,%) -> % from Foreign Builtin
+ import %ilshift: (%,%) -> % from Foreign Builtin
import %imax: (%,%) -> % from Foreign Builtin
import %imin: (%,%) -> % from Foreign Builtin
import %igcd: (%,%) -> % from Foreign Builtin
@@ -123,15 +127,9 @@ Integer: IntegerNumberSystem with
coerce(m:Integer):% == m pretend %
convert(x:%):Integer == x pretend Integer
length a == %ilength a
- addmod(a, b, p) ==
- c := %iadd(a,b)
- c >= p => c - p
- c
- submod(a, b, p) ==
- c := %isub(a,b)
- negative? c => c + p
- c
- mulmod(a, b, p) == %imul(a,b) rem p
+ addmod(a, b, p) == %iaddmod(a,b,p)
+ submod(a, b, p) == %isubmod(a,b,p)
+ mulmod(a, b, p) == %imulmod(a,b,p)
convert(x:%):Float == coerce(x)$Float
convert(x:%):DoubleFloat == coerce(x)$DoubleFloat
convert(x:%):InputForm == convert(x)$InputForm
@@ -175,7 +173,7 @@ Integer: IntegerNumberSystem with
divide(x,y) == %idivide(x,y)$Foreign(Builtin)
x quo y == %iquo(x,y)
x rem y == %irem(x,y)
- shift(x, y) == ASH(x,y)$Lisp
+ shift(x, y) == %ilshift(x,y)
recip(x) == if one? x or x=-1 then x else "failed"
gcd(x,y) == %igcd(x,y)
UCA ==> Record(unit:%,canonical:%,associate:%)
diff --git a/src/algebra/si.spad.pamphlet b/src/algebra/si.spad.pamphlet
index d982c432..795a75ed 100644
--- a/src/algebra/si.spad.pamphlet
+++ b/src/algebra/si.spad.pamphlet
@@ -179,10 +179,6 @@ IntegerNumberSystem(): Category ==
-- MODULUS, MULTIPLIER (random number generator constants)
--- Lisp dependencies
--- QSLEFTSHIFT
-
-
SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic) with
canonical
++ \spad{canonical} means that mathematical equality is implied by data structure equality.
@@ -204,11 +200,12 @@ SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic) with
import %iadd: (%,%) -> % from Foreign Builtin
import %iaddmod: (%,%,%) -> % from Foreign Builtin
import %isub: (%,%) -> % from Foreign Builtin
- import %isubmod: (%,%) -> % from Foreign Builtin
+ import %isubmod: (%,%,%) -> % from Foreign Builtin
import %imul: (%,%) -> % from Foreign Builtin
import %imulmod: (%,%,%) -> % from Foreign Builtin
import %irem: (%,%) -> % from Foreign Builtin
import %iquo: (%,%) -> % from Foreign Builtin
+ import %ilshift: (%,%) -> % from Foreign Builtin
import %ineg: % -> % from Foreign Builtin
import %iinc: % -> % from Foreign Builtin
import %idec: % -> % from Foreign Builtin
@@ -273,10 +270,10 @@ SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic) with
min(x,y) == %imin(x,y)
hash(x) == %hash x
length(x) == %ilength x
- shift(x,n) == QSLEFTSHIFT(x,n)$Lisp
+ shift(x,n) == %ilshift(x,n)
mulmod(a,b,p) == %imulmod(a,b,p)
- addmod(a,b,p) == %iaddmod(a,b,p)$Lisp
- submod(a,b,p) == %isubmod(a,b,p)$Lisp
+ addmod(a,b,p) == %iaddmod(a,b,p)
+ submod(a,b,p) == %isubmod(a,b,p)
negative?(x) == %ilt(x,%icst0)
size() ==
(%icstmax - %icstmin + %icst1) pretend NonNegativeInteger
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index d0c24e38..38a24387 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -345,7 +345,7 @@ declareUnusedParameters x == (augment x; x) where
devaluate d ==
not vector? d => d
categoryObject? d => canonicalForm d
- QVSIZE d > 0 =>
+ #d > 0 =>
d' := canonicalForm d
isFunctor d' => d'
d
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index fedbc988..775b3b8a 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -640,6 +640,7 @@ $VMsideEffectFreeOperators ==
%ilength %ibit %icst0 %icst1 %icstmin %icstmax
%imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc
%idec %irem %iquo %idivide %idec %irandom %imulmod %iaddmod %isubmod
+ %ilshift %irshift
%feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float?
%fpowi %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc
%fsqrt %fpowf %flog %flog2 %flog10 %fmanexp %fNaN? %fdecode
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 9ed9468b..6d8d41d7 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -830,7 +830,7 @@ mergeSort(f,g,p,n) ==
q := rest t
t.rest := nil
p := mergeSort(f,g,p,l)
- q := mergeSort(f,g,q,QSDIFFERENCE(n,l))
+ q := mergeSort(f,g,q,n-l)
mergeInPlace(f,g,p,q)
--% Throwing with glorious highlighting (maybe)
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index 684810ca..4ad86732 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -535,6 +535,8 @@ for x in [
['%imul, :"*"],
['%imulf, :"*"], -- integer * float
['%irem, :'REM],
+ ['%ilshift, :'ASH],
+ ['%irshift, :'ASH],
['%iquo, :'TRUNCATE],
['%ipow, :'EXPT],
['%isub, :"-"],
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 8f59e445..227533d5 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -147,7 +147,7 @@
(declare (simple-vector vec))
(let ((n (position 0 vec :from-end t :test-not #'eql)))
(cond ((null n) (vector))
- ((eql n (qvmaxindex vec)) vec)
+ ((eql n (maxindex vec)) vec)
(t (subseq vec 0 (+ n 1))))))
; 14 SEQUENCES
@@ -441,7 +441,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size
((EQL |l| 0) NIL)
('T (SPADLET |n| 0) (SPADLET |word| '||)
(SPADLET |inWord| NIL)
- (DO ((|i| 0 (1+ |i|))) ((QSGREATERP |i| |l|) NIL)
+ (DO ((|i| 0 (1+ |i|))) ((> |i| |l|) NIL)
(declare (fixnum |i|))
(SEQ (EXIT (COND
((eql (aref |str| |i|) #\space)
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 28a74f08..159be089 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -335,10 +335,10 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
phrase1:= [['%and,["%LET",max,["ELT",stateVar,0]],['%ige,sharpArg,max]],
[auxfn,:argl,stateVar]]
phrase2:= [['%igt,sharpArg,['%store,max,["DIFFERENCE",max,k]]],
- ["ELT",stateVar,['%iinc,["QSDIFFERENCE",k,["DIFFERENCE",sharpArg,max]]]]]
+ ["ELT",stateVar,['%iinc,["%isub",k,["DIFFERENCE",sharpArg,max]]]]]
phrase3:= [['%igt,sharpArg,n],[auxfn,:argl,['%list,n,:initCode]]]
phrase4:= [['%igt,sharpArg,n-k],
- ["ELT",['%list,:initCode],["QSDIFFERENCE",n,sharpArg]]]
+ ["ELT",['%list,:initCode],["%isub",n,sharpArg]]]
phrase5:= ['%otherwise,['recurrenceError,MKQ op,sharpArg]]
['PROGN,:preset,['%when,phrase1,phrase2,phrase3,phrase4,phrase5]]
if $verbose then
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 8e949642..39d0385e 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -512,7 +512,7 @@
(defun MKQSADD1 (X)
(COND ((ATOM X)
`(1+ ,X))
- ((AND (member (CAR X) '(-DIFFERENCE QSDIFFERENCE -) :test #'eq)
+ ((AND (member (CAR X) '(-DIFFERENCE |%isub| -) :test #'eq)
(EQL 1 (CADDR X)))
(CADR X))
(`(1+ ,X))))
@@ -605,19 +605,19 @@
;; If CADDDR U is not an atom, only compute the value once
(PUSH
(if (INTEGERP INC)
- (LIST (if (QSMINUSP INC)
- 'QSLESSP
- 'QSGREATERP)
+ (LIST (if (MINUSP INC)
+ '<
+ '>)
(CAR U)
FINAL)
- `(if (QSMINUSP ,INC)
- (QSLESSP ,(CAR U) ,FINAL)
- (QSGREATERP ,(CAR U) ,FINAL)))
+ `(if (MINUSP ,INC)
+ (< ,(CAR U) ,FINAL)
+ (> ,(CAR U) ,FINAL)))
XCL)))
(PUSH (LIST (CAR U) (CADR U)
(COND ((|member| INC '(1 (|One|)))
(MKQSADD1 (CAR U)))
- ((LIST 'QSPLUS (CAR U) INC)) ))
+ ((LIST '+ (CAR U) INC)) ))
IL))
(ON
(PUSH (LIST 'ATOM (CAR U)) XCL)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 322ce4ae..b124403f 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -217,48 +217,6 @@
`(,(rcqexp pattern) ,exp)
(macro-invalidargs 'qrplq form "form must be updateable.")))
-(defmacro qsdifference (x y)
- `(the fixnum (- (the fixnum ,x) (the fixnum ,y))))
-
-(defmacro qsgreaterp (a b)
- `(> (the fixnum ,a) (the fixnum ,b)))
-
-(defmacro qsleftshift (a b)
- `(the fixnum (ash (the fixnum ,a) (the fixnum ,b))))
-
-(defmacro qslessp (a b)
- `(< (the fixnum ,a) (the fixnum ,b)))
-
-(defmacro qsmax (x y)
- `(the fixnum (max (the fixnum ,x) (the fixnum ,y))))
-
-(defmacro qsmin (x y)
- `(the fixnum (min (the fixnum ,x) (the fixnum ,y))))
-
-(defmacro qsminus (x)
- `(the fixnum (minus (the fixnum ,x))))
-
-(defmacro qsminusp (x)
- `(minusp (the fixnum ,x)))
-
-(defmacro qsoddp (x)
- `(oddp (the fixnum ,x)))
-
-(defmacro qsabsval (x)
- `(the fixnum (abs (the fixnum ,x))))
-
-(defmacro qsplus (x y)
- `(the fixnum (+ (the fixnum ,x) (the fixnum ,y))))
-
-(defmacro qszerop (x)
- `(zerop (the fixnum ,x)))
-
-(defmacro qvmaxindex (x)
- `(the fixnum (1- (the fixnum (length (the simple-vector ,x))))))
-
-(defmacro qvsize (x)
- `(the fixnum (length (the simple-vector ,x))))
-
(defmacro resetq (a b)
`(prog1 ,a (setq ,a ,b)))
@@ -295,9 +253,6 @@
(defmacro times (&rest args)
`(* ,@args))
-(defmacro zero? (x)
- `(and (typep ,x 'fixnum) (zerop (the fixnum ,x))))
-
;; defuns
(define-function 'tempus-fugit #'get-internal-run-time)