diff options
-rw-r--r-- | src/ChangeLog | 6 | ||||
-rw-r--r-- | src/algebra/si.spad.pamphlet | 14 | ||||
-rw-r--r-- | src/algebra/strap/SINT.lsp | 8 | ||||
-rw-r--r-- | src/interp/clam.boot | 8 | ||||
-rw-r--r-- | src/interp/compiler.boot | 4 | ||||
-rw-r--r-- | src/interp/define.boot | 1 | ||||
-rw-r--r-- | src/interp/g-opt.boot | 2 | ||||
-rw-r--r-- | src/interp/g-util.boot | 1 | ||||
-rw-r--r-- | src/interp/macros.lisp | 2 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 1 | ||||
-rw-r--r-- | src/interp/nrunfast.boot | 2 | ||||
-rw-r--r-- | src/interp/slam.boot | 2 | ||||
-rw-r--r-- | src/interp/vmlisp.lisp | 26 |
13 files changed, 30 insertions, 47 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 2a257a72..cc64b761 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-01-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/vmlisp.lisp: Remove QREFELT, QSDEC1, QSETREFV, QSETVELT, + QSETVELT-1, QSINC1, QVELT, QVELT-1. + * algebra/si.spad.pamphlet: Use %iinc and %idec forms. + 2011-01-27 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/nruncomp.boot (NRTputInHead): Tidy. diff --git a/src/algebra/si.spad.pamphlet b/src/algebra/si.spad.pamphlet index 51bd9748..9c248a18 100644 --- a/src/algebra/si.spad.pamphlet +++ b/src/algebra/si.spad.pamphlet @@ -181,8 +181,8 @@ IntegerNumberSystem(): Category == -- Lisp dependencies --- EQ, ABSVAL, TIMES, INTEGER-LENGTH, HASHEQ, --- QSLESSP, QSGREATERP, QSADD1, QSSUB1, QSMINUS, QSPLUS, QSDIFFERENCE +-- ABSVAL, TIMES, INTEGER-LENGTH, +-- QSLESSP, QSGREATERP, QSMINUS, QSPLUS, QSDIFFERENCE -- QSTIMES,, QSODDP, QSZEROP, QSMAX, QSMIN, QSNOT, QSAND -- QSOR, QSXOR, QSLEFTSHIFT, QSADDMOD, QSDIFMOD, QSMULTMOD @@ -218,6 +218,8 @@ SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic,Logic,OpenM import %irem: (%,%) -> % from Foreign Builtin import %iquo: (%,%) -> % from Foreign Builtin import %ineg: % -> % from Foreign Builtin + import %iinc: % -> % from Foreign Builtin + import %idec: % -> % from Foreign Builtin import %iabs: % -> % from Foreign Builtin import %imax: (%,%) -> % from Foreign Builtin import %imin: (%,%) -> % from Foreign Builtin @@ -306,8 +308,8 @@ SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic,Logic,OpenM x > y == %igt(x,y) x <= y == %ile(x,y) x >= y == %ige(x,y) - inc x == QSADD1(x)$Lisp - dec x == QSSUB1(x)$Lisp + inc x == %iinc x + dec x == %idec x - x == %ineg x x + y == %iadd(x,y) x:% - y:% == %isub(x,y) @@ -331,10 +333,10 @@ SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic,Logic,OpenM addmod(a,b,p) == QSADDMOD(a,b,p)$Lisp submod(a,b,p) == QSDIFMOD(a,b,p)$Lisp negative?(x) == QSMINUSP$Lisp x - size() == (MAXINT -$Lisp MININT +$Lisp 1$Lisp) pretend NonNegativeInteger + size() == (MAXINT -$Lisp MININT +$Lisp %icst1) pretend NonNegativeInteger index i == per(i + MININT - 1$Lisp) lookup x == - (x -$Lisp MININT +$Lisp 1$Lisp) pretend PositiveInteger + (x -$Lisp MININT +$Lisp %icst1) pretend PositiveInteger reducedSystem(m: Matrix %, v: Vector %) == diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp index 4f8af7d9..a3c55e19 100644 --- a/src/algebra/strap/SINT.lsp +++ b/src/algebra/strap/SINT.lsp @@ -131,12 +131,12 @@ (DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) |SINT;inc;2$;30|)) -(PUT '|SINT;inc;2$;30| '|SPADreplace| 'QSADD1) +(PUT '|SINT;inc;2$;30| '|SPADreplace| '|%iinc|) (DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) |SINT;dec;2$;31|)) -(PUT '|SINT;dec;2$;31| '|SPADreplace| 'QSSUB1) +(PUT '|SINT;dec;2$;31| '|SPADreplace| '|%idec|) (DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) |SINT;-;2$;32|)) @@ -398,9 +398,9 @@ (DECLARE (IGNORE $)) (NOT (< |x| |y|))) -(DEFUN |SINT;inc;2$;30| (|x| $) (DECLARE (IGNORE $)) (QSADD1 |x|)) +(DEFUN |SINT;inc;2$;30| (|x| $) (DECLARE (IGNORE $)) (1+ |x|)) -(DEFUN |SINT;dec;2$;31| (|x| $) (DECLARE (IGNORE $)) (QSSUB1 |x|)) +(DEFUN |SINT;dec;2$;31| (|x| $) (DECLARE (IGNORE $)) (1- |x|)) (DEFUN |SINT;-;2$;32| (|x| $) (DECLARE (IGNORE $)) (- |x|)) diff --git a/src/interp/clam.boot b/src/interp/clam.boot index a4b2f8b9..b4c45112 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -608,10 +608,10 @@ hputNewProp(ht,op,argList,val) == listTruncate(l,n) == u:= l - n:= QSSUB1 n + n:= n - 1 while n ~= 0 and cons? u repeat - n:= QSSUB1 n - u:= rest u + n := n - 1 + u := rest u if cons? u then if cons? rest u and $reportInstantiations = true then recordInstantiation($op,CAADR u,true) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index a4067f8d..ae9671d0 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -777,8 +777,8 @@ compCons1(["CONS",x,y],m,e) == yt':= convert(yt,mr) or return nil [x,.,e]:= convert([x,mx,yt'.env],second mr) or return nil yt'.expr is ['%listlit,:.] => [['%listlit,x,:rest yt'.expr],mr,e] - [["CONS",x,yt'.expr],mr,e] - [["CONS",x,y],["Pair",mx,my],e] + [['%makepair,x,yt'.expr],mr,e] + [['%makepair,x,y],["Pair",mx,my],e] convert(T,m) --% SETQ diff --git a/src/interp/define.boot b/src/interp/define.boot index 69d451b2..1aca96d0 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1195,7 +1195,6 @@ addArgumentConditions($body,$functionName) == $body putInLocalDomainReferences (def := [opName,[lam,varl,body]]) == - $elt: local := "getShellEntry" NRTputInTail CDDADR def def diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 993f928c..7a69f229 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -444,7 +444,7 @@ $VMsideEffectFreeOperators == %beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl %icst0 %icst1 %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc - %irem %iquo %idivide + %irem %iquo %idivide %idec %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float? %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc %fsin %fcos %ftan %fcot %fsec %fcsc %fatan %facot diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 50846d50..b2c00ccd 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -512,6 +512,7 @@ for x in [ ['%igcd, :'GCD], ['%ige, :">="], ['%iinc, :"1+"], + ['%idec, :"1-"], ['%ilcm, :'LCM], ['%ile, :"<="], ['%imax, :'MAX], diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp index 69bd3b2e..1c013f0c 100644 --- a/src/interp/macros.lisp +++ b/src/interp/macros.lisp @@ -555,7 +555,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ; (spadcall ; (cons (|function| (lambda (#:G1420 |envArg|) #:G1420)) (vector)) ; |#1| -; (qrefelt |*1;f;1;initial;MV| 0)))))) +; (svref |*1;f;1;initial;MV| 0)))))) ; ; the (|function| (lambda form used to cause an infinite expansion loop ; diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 6734e132..68169169 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -681,7 +681,6 @@ NRTsubstDelta(initSig) == updateSlot1DataBase [name,info] == HPUT($Slot1DataBase,name,info) NRTputInLocalReferences bod == - $elt: local := "getShellEntry" NRTputInHead bod NRTputInHead bod == diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index a9097d17..ef1bcf6d 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -427,7 +427,7 @@ newCompareSig(sig, numvec, index, dollar, domain) == null (target := first sig) or lazyMatchArg(target,numvec.k,dollar,domain) => and/[lazyMatchArg(s,numvec.(k := i),dollar,domain) - for s in rest sig for i in (index+1)..] => numvec.(QSINC1 k) + for s in rest sig for i in (index+1)..] => numvec.(k + 1) nil nil diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 7289b9d3..fb0afcc2 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -246,7 +246,7 @@ countCircularAlist(cal,n) == +/[nodeCount x for x in cal for i in 1..n] predCircular(al,n) == - for i in 1..QSSUB1 n repeat al:= rest al + for i in 1..(n - 1) repeat al:= rest al al assocCircular(x,al) == --like ASSOC except that al is circular diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index 322f703c..b4cbf6d2 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2010, Gabriel Dos Reis. +;; Copyright (C) 2007-2011, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -321,9 +321,6 @@ (defmacro qlength (a) `(length ,a)) -(defmacro qrefelt (vec ind) - `(svref ,vec ,ind)) - (defmacro qrplaca (a b) `(rplaca (the cons ,a) ,b)) @@ -338,27 +335,12 @@ (defmacro qsadd1 (x) `(the fixnum (1+ (the fixnum ,x)))) -(defmacro qsdec1 (x) - `(the fixnum (1- (the fixnum ,x)))) - (defmacro qsdifference (x y) `(the fixnum (- (the fixnum ,x) (the fixnum ,y)))) -(defmacro qsetrefv (vec ind val) - `(setf (svref ,vec (the fixnum ,ind)) ,val)) - -(defmacro qsetvelt (vec ind val) - `(setf (svref ,vec (the fixnum ,ind)) ,val)) - -(defmacro qsetvelt-1 (vec ind val) - `(setf (svref ,vec (the fixnum (1- (the fixnum ,ind)))) ,val)) - (defmacro qsgreaterp (a b) `(> (the fixnum ,a) (the fixnum ,b))) -(defmacro qsinc1 (x) - `(the fixnum (1+ (the fixnum ,x)))) - (defmacro qsleftshift (a b) `(the fixnum (ash (the fixnum ,a) (the fixnum ,b)))) @@ -395,12 +377,6 @@ (defmacro qszerop (x) `(zerop (the fixnum ,x))) -(defmacro qvelt (vec ind) - `(svref ,vec (the fixnum ,ind))) - -(defmacro qvelt-1 (vec ind) - `(svref ,vec (the fixnum (1- (the fixnum ,ind))))) - (defmacro qvmaxindex (x) `(the fixnum (1- (the fixnum (length (the simple-vector ,x)))))) |