From 7bd660a8c61540adcd0998122d89b3692cd127f8 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 30 Apr 2012 01:11:28 +0000 Subject: * lisp/core.lisp.in (fixnum?): New. * algebra/sex.spad.pamphlet: Use %float? instead of RNUM. Use %integer? instead of INTP. * interp/g-timer.boot: Use float? instead of RNUMP. * interp/i-coerce.boot: Use fixnum? instead of SINTP or SMINTP. * interp/i-intern.boot: Likewise. * interp/lisp-backend.boot: Likewise. * interp/slam.boot: Likewise. * interp/trace.boot: Likewise. * interp/vmlisp.lisp: Likewise. (INTP): Remove. (BINTP): Likewise. (LESSP): Likewise. (LINTP): Likewise. (MAKESTRING): Likewise. (MAPELT): Likewise. (NUMP): Likewise. (RNUMP): Likewise. (SINTP): Likewise. (SMINTP): Likewise. --- src/interp/g-timer.boot | 8 ++++---- src/interp/i-coerce.boot | 12 +++++------ src/interp/i-coerfn.boot | 17 ---------------- src/interp/i-intern.boot | 4 ++-- src/interp/lisp-backend.boot | 2 +- src/interp/slam.boot | 4 ++-- src/interp/trace.boot | 2 +- src/interp/vmlisp.lisp | 47 +++++++++----------------------------------- 8 files changed, 25 insertions(+), 71 deletions(-) (limited to 'src/interp') diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot index f3d9a4a0..a93d01e1 100644 --- a/src/interp/g-timer.boot +++ b/src/interp/g-timer.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -95,7 +95,7 @@ makeLongStatStringByProperty _ strconc(str, '" = ", total) normalizeStatAndStringify t == - RNUMP t => + float? t => t := roundStat t t = 0.0 => '"0" FORMAT(nil,'"~,2F",t) @@ -108,12 +108,12 @@ normalizeStatAndStringify t == STRINGIMAGE t significantStat t == - RNUMP t => (t > 0.01) + float? t => (t > 0.01) integer? t => (t > 100) true roundStat t == - not RNUMP t => t + not float? t => t QUOTIENT(FIX (0.5 + t * 1000.0), 1000.0) makeStatString(oldstr,time,abb,flag) == diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index dc951db6..43bf5694 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -107,7 +107,7 @@ retract1 object == val := objVal object type = $PositiveInteger => objNew(val,$NonNegativeInteger) type = $NonNegativeInteger => objNew(val,$Integer) - type = $Integer and SINTP unwrap val => objNew(val, $SingleInteger) + type = $Integer and fixnum? unwrap val => objNew(val, $SingleInteger) type' := equiType(type) if not sameObject?(type,type') then object := objNew(val,type') (1 = #type') or (type' is ['Union,:.]) or @@ -261,7 +261,7 @@ coerceRetract(object,t2) == (val := objValUnwrap(object)) = "$fromCoerceable$" => nil t1 := objMode object t2 = $OutputForm => nil - isEqualOrSubDomain(t1,$Integer) and typeIsASmallInteger(t2) and SMINTP(val) => + isEqualOrSubDomain(t1,$Integer) and typeIsASmallInteger(t2) and fixnum?(val) => objNewWrap(val,t2) t1 = $Integer => nil t1 = $Symbol => nil @@ -820,12 +820,12 @@ coerceInt1(triple,t2) == if typeIsASmallInteger(t1) then (t2 = $Integer) or typeIsASmallInteger(t2) => return objNew(val,t2) - sintp := SINTP val + sintp := fixnum? val sintp and (t2 = $PositiveInteger) and val > 0 => return objNew(val,t2) sintp and (t2 = $NonNegativeInteger) and val >= 0 => return objNew(val,t2) - typeIsASmallInteger(t2) and isEqualOrSubDomain(t1, $Integer) and INTP val => - SINTP val => objNew(val,t2) + typeIsASmallInteger(t2) and isEqualOrSubDomain(t1, $Integer) and integer? val => + fixnum? val => objNew(val,t2) nil t2 = $Void => objNew(voidValue(),$Void) diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot index bf42e2cf..407b0717 100644 --- a/src/interp/i-coerfn.boot +++ b/src/interp/i-coerfn.boot @@ -1157,23 +1157,6 @@ Qf2F(u,source is [.,D,:.],target) == Rn2F(rnum, source, target) == float QUOTIENT(first rnum, rest rnum) --- next function is needed in RN algebra code ---Rn2F([a,:b],source,target) == --- al:=if LINTP a then QLENGTHCODE a else 4 --- bl:=if LINTP b then QLENGTHCODE b else 4 --- MAX(al,bl) < 36 => FLOAT a / FLOAT b --- sl:=0 --- if al>32 then --- sl:=35*(al-32)/4 --- a:=a/2**sl --- if bl>32 then --- sbl:=35*(bl-32)/4 --- b:=b/2**sbl --- sl:=sl-sbl --- ans:=FLOAT a /FLOAT b --- sl=0 => ans --- ans*2**sl - Qf2domain(u,source is [.,D],target) == -- tests whether it is an element of the underlying domain useUnder := (ut := underDomainOf target) and canCoerce(source,ut) diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index 2dc3e34a..82309cc5 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -1,6 +1,6 @@ -- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -176,7 +176,7 @@ mkAtree2(x,op,argl) == integer? a => a >= 0 => mkAtree1 [['_$elt,D,internalName a]] t := evaluateType unabbrev [D] - typeIsASmallInteger(t) and SINTP a => + typeIsASmallInteger(t) and fixnum? a => v := mkAtreeNode $immediateDataSymbol putValue(v,objNewWrap(a, t)) v diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index b23d1bf6..684810ca 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -517,7 +517,7 @@ for x in [ ['%ieven?, :'EVENP], ['%integer?,:'INTEGERP], ['%iodd?, :'ODDP], - ['%ismall?, :'SMINTP], + ['%ismall?, :'fixnum?], ['%i2s, :'WRITE_-TO_-STRING], ['%ilength, :'INTEGER_-LENGTH], ['%ibit, :'INTEGER_-BIT], diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 13768228..b6fc6a86 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -130,7 +130,7 @@ mkDiffAssoc(op,body,k,sharpPosition,sharpArg,diffSlot,vecname) == body is [fn,:argl] => (fn = op) and argl.(sharpPosition-1) is ['SPADCALL,=sharpArg,n,["ELT",["%dynval",=MKQ vecname],=diffSlot]] => - NUMP n and n > 0 and n <= k => + integer? n and n > 0 and n <= k => [[body,:$TriangleVariableList.n]] ['$failed] "union"/[mkDiffAssoc(op,x,k,sharpPosition,sharpArg,diffSlot,vecname) for x in argl] diff --git a/src/interp/trace.boot b/src/interp/trace.boot index 8e09eeff..9b4d051b 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -678,7 +678,7 @@ orderBySlotNumber l == ASSOCRIGHT orderList [[n,:x] for (x:= [.,.,n,:.]) in l] _/TRACEREPLY() == - null _/TRACENAMES => MAKESTRING '" Nothing is traced." + null _/TRACENAMES => '" Nothing is traced." for x in _/TRACENAMES repeat x is [d,:.] and isDomainOrPackage d => domainList:= [devaluate d,:domainList] diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index bb74f3cd..059994da 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -73,9 +73,6 @@ (defmacro applx (&rest args) `(apply ,@args)) -(defmacro bintp (n) - `(typep ,n 'bignum)) - (defmacro closedfn (form) `(function ,form)) @@ -161,23 +158,9 @@ `(let ((,xx ,x)) (and (consp ,xx) (qcdr ,xx)))))) -(defmacro intp (x) - `(integerp ,x)) - (defmacro lam (&rest body) (list 'quote (*lam (copy-tree body)))) -(defmacro lessp (&rest args) - `(< ,@args)) - -(defmacro lintp (n) - `(typep ,n 'bignum)) - -(defmacro makestring (a) a) - -(defmacro mapelt (f vec) - `(map 'vector ,f ,vec)) - (defmacro maxindex (x) `(the fixnum (1- (the fixnum (length ,x))))) @@ -186,9 +169,6 @@ (defmacro ne (a b) `(not (equal ,a ,b))) -(defmacro nump (n) - `(numberp ,n)) - (defmacro plus (&rest args) `(+ ,@ args)) @@ -295,9 +275,6 @@ (defmacro resetq (a b) `(prog1 ,a (setq ,a ,b))) -(defmacro rnump (n) - `(floatp ,n)) - (defmacro rplq (&whole form exp pattern) (if (or (consp pattern) (simple-vector-p pattern)) `(,(rcqexp pattern) ,exp) @@ -322,12 +299,6 @@ (|substitute!| '(progn) nil body) ;don't treat NIL as a label `(block seq (tagbody ,@(|reverse!| body) ,val)))) -(defmacro sintp (n) - `(typep ,n 'fixnum)) - -(defmacro smintp (n) - `(typep ,n 'fixnum)) - (defmacro subrp (x) `(compiled-function-p ,x)) @@ -900,7 +871,7 @@ (RETURN (COND ((OR (NOT (EQ 3 (LENGTH FORM))) (NOT (|ident?| (car (setq FORM (cdr FORM)))))) - (MACRO-INVALIDARGS 'DCQ\/QDCQ FORM (MAKESTRING "invalid pattern."))) + (MACRO-INVALIDARGS 'DCQ\/QDCQ FORM "invalid pattern.")) (`((setq ,(car form) ,sv) ,@(DCQGENEXP SV (CADR FORM) EQTAG QFLAG))))))) (setq A (car FORM)) (setq D (cdr FORM)) @@ -961,7 +932,7 @@ ((EQ FORM SV) (RETURN NIL)) ((OR (|ident?| FORM) - (NUMP FORM) + (INTEGERP FORM) (AND (consp FORM) (EQ (qcar FORM) 'QUOTE))) (RETURN `((COND ((NOT (EQ ,form ,sv)) (GO BAD))) ))) @@ -982,7 +953,7 @@ (COND ( (OR (|ident?| A) - (NUMP A) + (INTEGERP A) (AND (consp A) (EQ (qcar A) 'QUOTE))) `((COND ( (NOT (EQ ,a (ELT ,sv ,i))) (GO BAD) ) ) ) ) @@ -1010,7 +981,7 @@ (setq PVL (CONS (setq W (GENSYM)) PVL))) (setq C (COND - ( (OR (|ident?| A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE))) + ( (OR (|ident?| A) (INTEGERP A) (AND (consp A) (EQ (car A) 'QUOTE))) `((COND ((NOT (EQ ,a (CAR ,sv))) (GO BAD))) )) ( (OR (consp A) (simple-vector-p A)) `((setq ,w (CAR ,sv)) @@ -1019,7 +990,7 @@ (|append!| C (COND - ( (OR (|ident?| D) (NUMP D) (AND (consp D) + ( (OR (|ident?| D) (INTEGERP D) (AND (consp D) (EQ (car D) 'QUOTE))) `((COND ((NOT (EQ ,d (CDR ,sv))) (GO BAD))) )) ( (OR (consp D) (simple-vector-p D)) @@ -1083,7 +1054,7 @@ (COND ( (OR (|ident?| A) - (NUMP A) + (INTEGERP A) (AND (consp A) (EQ (car A) 'QUOTE))) `((SETF (ELT ,sv ,i) ,a))) ( (OR (consp A) (simple-vector-p A)) @@ -1114,7 +1085,7 @@ (setq PVL (CONS (setq W (GENSYM)) PVL)) ) ) (setq C (COND - ( (OR (|ident?| A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE))) + ( (OR (|ident?| A) (INTEGERP A) (AND (consp A) (EQ (car A) 'QUOTE))) `((rplaca ,sv ,a))) ( (OR (consp A) (simple-vector-p A)) `((setq ,w (CAR ,sv)) @@ -1123,7 +1094,7 @@ (|append!| C (COND - ( (OR (|ident?| D) (NUMP D) (AND (consp D) (EQ (car D) 'QUOTE))) + ( (OR (|ident?| D) (INTEGERP D) (AND (consp D) (EQ (car D) 'QUOTE))) `((RPLACD ,sv ,d))) ( (OR (consp D) (simple-vector-p D)) `((setq ,sv (CDR ,sv)) @@ -1288,7 +1259,7 @@ ( (VARP BV-LIST) (LIST BV-LIST) ) ( (simple-vector-p BV-LIST) - (FLAT-BV-LIST (VEC2LIST (MAPELT #'FLAT-BV-LIST BV-LIST))) ) + (FLAT-BV-LIST (VEC2LIST (MAP 'VECTOR #'FLAT-BV-LIST BV-LIST))) ) ( (NOT (consp BV-LIST)) NIL ) ( (EQ '= (SETQ TMP1 (QCAR BV-LIST))) -- cgit v1.2.3