diff options
author | dos-reis <gdr@axiomatics.org> | 2012-05-01 02:27:52 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2012-05-01 02:27:52 +0000 |
commit | e37c877a8ad003972fc6c0206dc6220e266f0a8b (patch) | |
tree | 6a4dafe69f35f013172cdbf7b646064328380986 /src | |
parent | 52d8ccbf25a71457f923860824696742328bdb35 (diff) | |
download | open-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/ChangeLog | 31 | ||||
-rw-r--r-- | src/algebra/integer.spad.pamphlet | 18 | ||||
-rw-r--r-- | src/algebra/si.spad.pamphlet | 13 | ||||
-rw-r--r-- | src/interp/c-util.boot | 2 | ||||
-rw-r--r-- | src/interp/g-opt.boot | 1 | ||||
-rw-r--r-- | src/interp/g-util.boot | 2 | ||||
-rw-r--r-- | src/interp/lisp-backend.boot | 2 | ||||
-rw-r--r-- | src/interp/macros.lisp | 4 | ||||
-rw-r--r-- | src/interp/slam.boot | 4 | ||||
-rw-r--r-- | src/interp/sys-macros.lisp | 16 | ||||
-rw-r--r-- | src/interp/vmlisp.lisp | 45 |
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) |