(FILECREATED "23-Jun-86 23:54:41" {QV}<PEDERSEN>LISP>EARRAY.;9 7171
changes to: (FNS EARRAY-DIMENSION EARRAY-ELEMENT-TYPE EARRAY-LINEARIZE EARRAY-MAKESCALAR
EARRAY-RANK EARRAY-TOTAL-SIZE CONFORMABLE-P)
(MACROS EARRAY-SCALARP)
(VARS EARRAYCOMS)
previous date: "23-Jun-86 14:04:35" {QV}<PEDERSEN>LISP>EARRAY.;8)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT EARRAYCOMS)
(RPAQQ EARRAYCOMS [(FNS CONFORMABLE-P EARRAY-ARITH-TYPE EARRAY-ASLIST EARRAY-ASVECTOR
EARRAY-COMMON-TYPE EARRAY-DIMENSION EARRAY-DIMENSIONS EARRAY-ELEMENT-TYPE
EARRAY-LINEARIZE EARRAY-MAKESCALAR EARRAY-RANK EARRAY-SCANDIMS
EARRAY-TEST-RESULT EARRAY-TOTAL-SIZE USE-FLOAT-P)
(MACROS EARRAY-SCALARP)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
CMLARRAY)
(FILES UNBOXEDOPS ARRAYSUPPORT BLAS MATRIXOPS ARRAYSORTER FLOATARRAYSORTER CDFS)
(FILES EARRAY-UTIL EARRAY-ITERATORS EARRAY-FNS EARRAY-SORTFNS EARRAY-CMPFNS EARRAY-ARITHFNS
EARRAY-MATHFNS EARRAY-MATRIXFNS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(CONFORMABLE-P
[LAMBDA (ARRAY1 ARRAY2) (* jop: "23-Jun-86 22:24")
(* *)
(OR (EARRAY-SCALARP ARRAY1)
(EARRAY-SCALARP ARRAY2)
(EQ (EARRAY-TOTAL-SIZE ARRAY1)
(EARRAY-TOTAL-SIZE ARRAY2])
(EARRAY-ARITH-TYPE
[LAMBDA (ELTTYPE1 ELTTYPE2) (* jop: "10-Jun-86 11:11")
(* *)
(if (OR (EQ ELTTYPE1 (QUOTE SINGLE-FLOAT))
(EQ ELTTYPE2 (QUOTE SINGLE-FLOAT)))
then (QUOTE SINGLE-FLOAT)
else (EARRAY-COMMON-TYPE ELTTYPE1 ELTTYPE2])
(EARRAY-ASLIST
[LAMBDA (ARRAY) (* jop: " 8-Jun-86 19:26")
(* *)
(SELECTQ (EARRAY-RANK ARRAY)
(0 ARRAY)
(1 (for I from 0 upto (EARRAY-TOTAL-SIZE ARRAY) collect (AREF ARRAY I)))
(bind (LINARRAY ← (EARRAY-LINEARIZE ARRAY)) for I from 0 upto (
ARRAY-TOTAL-SIZE
ARRAY)
collect (AREF LINARRAY I])
(EARRAY-ASVECTOR
[LAMBDA (LST ELEMENT-TYPE) (* jop: "15-Jun-86 17:27")
(* *)
[if (NULL ELEMENT-TYPE)
then (SETQ ELEMENT-TYPE (LET [(FIRSTTYPE (SCALAR-TYPE-OF (CAR LST]
(DECLARE (SPECVARS FIRSTTYPE))
(if [EVERY (CDR LST)
(FUNCTION (LAMBDA (X)
(EQUAL (SCALAR-TYPE-OF X)
FIRSTTYPE]
then FIRSTTYPE
else T]
(MAKE-ARRAY (LENGTH LST)
(QUOTE :ELEMENT-TYPE)
ELEMENT-TYPE
(QUOTE :INITIAL-CONTENTS)
LST])
(EARRAY-COMMON-TYPE
[LAMBDA (ELTTYPE1 ELTTYPE2) (* jop: " 9-Jun-86 13:18")
(* *)
(if (EQUAL ELTTYPE1 ELTTYPE2)
then ELTTYPE1
else T])
(EARRAY-DIMENSION
[LAMBDA (ARRAY DIM) (* jop: "23-Jun-86 22:24")
(* *)
(if (EARRAY-SCALARP ARRAY)
then (ERROR "Scalar has no dimensions" DIM)
else (ARRAY-DIMENSION ARRAY DIM])
(EARRAY-DIMENSIONS
[LAMBDA (ARRAY) (* jop: " 8-Jun-86 17:09")
(* *)
(AND (CL:ARRAYP ARRAY)
(ARRAY-DIMENSIONS ARRAY])
(EARRAY-ELEMENT-TYPE
[LAMBDA (ARRAY) (* jop: "23-Jun-86 22:24")
(* *)
(if (EARRAY-SCALARP ARRAY)
then (SCALAR-TYPE-OF ARRAY)
else (ARRAY-ELEMENT-TYPE ARRAY])
(EARRAY-LINEARIZE
[LAMBDA (EARRAY) (* jop: "23-Jun-86 22:24")
(* *)
(if (EARRAY-SCALARP EARRAY)
then EARRAY
else (MAKE-ARRAY (ARRAY-TOTAL-SIZE EARRAY)
(QUOTE :ELEMENT-TYPE)
(ARRAY-ELEMENT-TYPE EARRAY)
(QUOTE :DISPLACED-TO)
EARRAY])
(EARRAY-MAKESCALAR
[LAMBDA (ARRAY) (* jop: "23-Jun-86 22:24")
(* *)
(if (EARRAY-SCALARP ARRAY)
then ARRAY
else (AREF (EARRAY-LINEARIZE ARRAY)
0])
(EARRAY-RANK
[LAMBDA (ARRAY) (* jop: "23-Jun-86 22:24")
(* *)
(if (EARRAY-SCALARP ARRAY)
then 0
else (ARRAY-RANK ARRAY])
(EARRAY-SCANDIMS
[LAMBDA (ARRAY) (* jop: " 8-Jun-86 16:01")
(* *)
(LET [(RESULT (REVERSE (EARRAY-DIMENSIONS ARRAY]
(bind (PROD ← 1)
NEXTTERM for DIM on RESULT
do (SETQ NEXTTERM (CAR DIM))
(RPLACA DIM PROD)
(SETQ PROD (ITIMES PROD NEXTTERM)))
(DREVERSE RESULT])
(EARRAY-TEST-RESULT
[LAMBDA (RESULTARRAY RESULTDIMS RESULTELTTYPE) (* jop: "10-Jun-86 11:37")
(* * Uses RESULTELTTYPE only if a new array is created, else just checks RESULTDIMS)
(if (NULL RESULTARRAY)
then [SETQ RESULTARRAY (AND RESULTDIMS (if RESULTELTTYPE
then (MAKE-ARRAY RESULTDIMS
(QUOTE :ELEMENT-TYPE)
RESULTELTTYPE)
else (MAKE-ARRAY RESULTDIMS]
elseif (NOT (EQUAL (EARRAY-DIMENSIONS RESULTARRAY)
RESULTDIMS))
then (HELP "Invalid RESULT" RESULTARRAY))
RESULTARRAY])
(EARRAY-TOTAL-SIZE
[LAMBDA (ARRAY) (* jop: "23-Jun-86 22:24")
(* *)
(if (EARRAY-SCALARP ARRAY)
then 1
else (ARRAY-TOTAL-SIZE ARRAY])
(USE-FLOAT-P
[LAMBDA (ARRAY1 ARRAY2) (* jop: " 9-Jun-86 16:40")
(* *)
(AND (OR (EQ (EARRAY-ELEMENT-TYPE ARRAY1)
(QUOTE SINGLE-FLOAT))
(FIXP ARRAY1))
(OR (EQ (EARRAY-ELEMENT-TYPE ARRAY2)
(QUOTE SINGLE-FLOAT))
(FIXP ARRAY2])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS EARRAY-SCALARP MACRO ((DATUM)
(NOT (CL:ARRAYP DATUM]
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
CMLARRAY)
(FILESLOAD UNBOXEDOPS ARRAYSUPPORT BLAS MATRIXOPS ARRAYSORTER FLOATARRAYSORTER CDFS)
(FILESLOAD EARRAY-UTIL EARRAY-ITERATORS EARRAY-FNS EARRAY-SORTFNS EARRAY-CMPFNS EARRAY-ARITHFNS
EARRAY-MATHFNS EARRAY-MATRIXFNS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS EARRAY COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1244 6477 (CONFORMABLE-P 1254 . 1526) (EARRAY-ARITH-TYPE 1528 . 1868) (EARRAY-ASLIST
1870 . 2355) (EARRAY-ASVECTOR 2357 . 2989) (EARRAY-COMMON-TYPE 2991 . 3209) (EARRAY-DIMENSION 3211 .
3485) (EARRAY-DIMENSIONS 3487 . 3695) (EARRAY-ELEMENT-TYPE 3697 . 3957) (EARRAY-LINEARIZE 3959 . 4326)
(EARRAY-MAKESCALAR 4328 . 4583) (EARRAY-RANK 4585 . 4804) (EARRAY-SCANDIMS 4806 . 5222) (
EARRAY-TEST-RESULT 5224 . 5880) (EARRAY-TOTAL-SIZE 5882 . 6113) (USE-FLOAT-P 6115 . 6475)))))
STOP