(FILECREATED "24-Jun-86 00:05:51" {QV}<PEDERSEN>LISP>EARRAY-ITERATORS.;4 10363
changes to: (FNS GENERATOR-SETUP ITERATOR-SETUP META-ITERATOR-SETUP)
previous date: "16-Jun-86 18:33:37" {QV}<PEDERSEN>LISP>EARRAY-ITERATORS.;3)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT EARRAY-ITERATORSCOMS)
(RPAQQ EARRAY-ITERATORSCOMS ((RECORDS GENERATOR ITERATOR META-ITERATOR)
(FNS GENERATOR-NEXTELT GENERATOR-SETNEXTELT GENERATOR-SETUP
ITERATOR-NEXTINDEX ITERATOR-RESET ITERATOR-SETUP
META-ITERATOR-NEXTITERATOR META-ITERATOR-RESET
META-ITERATOR-SETUP)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))))
[DECLARE: EVAL@COMPILE
(DATATYPE GENERATOR (VECTOR ITERATOR))
(DATATYPE ITERATOR (OFFSET MULTIPLIERS INDICES LIMITS ENDITERATION))
(DATATYPE META-ITERATOR (BASEARRAY LEVELS LEVELLIMITS ITERATOR ENDITERATION))
]
(/DECLAREDATATYPE (QUOTE GENERATOR)
(QUOTE (POINTER POINTER))
(QUOTE ((GENERATOR 0 POINTER)
(GENERATOR 2 POINTER)))
(QUOTE 4))
(/DECLAREDATATYPE (QUOTE ITERATOR)
(QUOTE (POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((ITERATOR 0 POINTER)
(ITERATOR 2 POINTER)
(ITERATOR 4 POINTER)
(ITERATOR 6 POINTER)
(ITERATOR 8 POINTER)))
(QUOTE 10))
(/DECLAREDATATYPE (QUOTE META-ITERATOR)
(QUOTE (POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((META-ITERATOR 0 POINTER)
(META-ITERATOR 2 POINTER)
(META-ITERATOR 4 POINTER)
(META-ITERATOR 6 POINTER)
(META-ITERATOR 8 POINTER)))
(QUOTE 10))
(DEFINEQ
(GENERATOR-NEXTELT
[LAMBDA (GENERATOR) (* jop: " 8-Jun-86 17:25")
(* *)
(if (type? GENERATOR GENERATOR)
then (LET* ((ITERATOR (fetch (GENERATOR ITERATOR) of GENERATOR))
(INDEX (ITERATOR-NEXTINDEX ITERATOR)))
(if (NULL INDEX)
then (ITERATOR-RESET ITERATOR)
(SETQ INDEX (ITERATOR-NEXTINDEX ITERATOR)))
(AREF (fetch (GENERATOR VECTOR) of GENERATOR)
INDEX))
else GENERATOR])
(GENERATOR-SETNEXTELT
[LAMBDA (NEWVALUE GENERATOR) (* jop: " 8-Jun-86 17:26")
(* *)
(if (type? GENERATOR GENERATOR)
then (LET* ((ITERATOR (fetch (GENERATOR ITERATOR) of GENERATOR))
(INDEX (ITERATOR-NEXTINDEX ITERATOR)))
(if (NULL INDEX)
then (ITERATOR-RESET ITERATOR)
(SETQ INDEX (ITERATOR-NEXTINDEX ITERATOR)))
(ASET NEWVALUE (fetch (GENERATOR VECTOR) of GENERATOR)
INDEX))
else (HELP "Not a generator" GENERATOR])
(GENERATOR-SETUP
[LAMBDA (ARRAY ITERATOR OLDGENERATOR) (* jop: "23-Jun-86 22:23")
(* *)
(if (NULL OLDGENERATOR)
then (SETQ OLDGENERATOR (create GENERATOR)))
(if (EARRAY-SCALARP ARRAY)
then ARRAY
else (create GENERATOR
VECTOR ←(EARRAY-LINEARIZE ARRAY)
ITERATOR ←(OR ITERATOR (ITERATOR-SETUP ARRAY)) smashing OLDGENERATOR])
(ITERATOR-NEXTINDEX
[LAMBDA (ITERATOR) (* jop: " 8-Jun-86 17:04")
(* *)
(LET ((INDICES (fetch (ITERATOR INDICES) of ITERATOR))
(LIMITS (fetch (ITERATOR LIMITS) of ITERATOR))
(MULTIPLIERS (fetch (ITERATOR MULTIPLIERS) of ITERATOR))
(OFFSET (fetch (ITERATOR OFFSET) of ITERATOR))
(ENDITERATION (fetch (ITERATOR ENDITERATION) of ITERATOR))
RESULT)
[if (NOT ENDITERATION)
then [SETQ RESULT (IPLUS OFFSET (for INDEX in INDICES as MULT in
MULTIPLIERS
sum (ITIMES MULT (if (LISTP INDEX)
then (CAR INDEX)
else INDEX]
(bind INDEX (I ← (LENGTH INDICES))
while [AND (IGREATERP I 0)
(if [LISTP (CAR (SETQ INDEX (FNTH INDICES I]
then (NULL (CDAR INDEX))
else (EQ (ADD1 (CAR INDEX))
(CAR (FNTH LIMITS I]
do (RPLACA INDEX (if (LISTP (CAR INDEX))
then (CAR (FNTH LIMITS I))
else 0))
(SETQ I (SUB1 I))
finally (if (EQ I 0)
then (replace (ITERATOR ENDITERATION) of ITERATOR
with T)
else (RPLACA INDEX (if (LISTP (CAR INDEX))
then (CDAR INDEX)
else (ADD1 (CAR INDEX]
RESULT])
(ITERATOR-RESET
[LAMBDA (ITERATOR) (* jop: " 8-Jun-86 17:05")
(* * reset iterator for another iteration)
(LET ((INDICES (fetch (ITERATOR INDICES) of ITERATOR))
(LIMITS (fetch (ITERATOR LIMITS) of ITERATOR)))
(for INDEX on INDICES as LIMIT in LIMITS do (if (LISTP (CAR INDEX))
then (RPLACA INDEX LIMIT)
else (RPLACA INDEX 0)))
[replace (ITERATOR ENDITERATION) of ITERATOR with (for LIMIT in LIMITS
thereis (AND (FIXP LIMIT)
(EQ LIMIT 0]
ITERATOR])
(ITERATOR-SETUP
[LAMBDA (BASEARRAY LEVELMAPS DIMMAP OLDITERATOR) (* jop: "23-Jun-86 22:23")
(* *)
(if (EARRAY-SCALARP BASEARRAY)
then (ERROR "cannot iterate over a scalar" BASEARRAY))
[if (NULL LEVELMAPS)
then (SETQ LEVELMAPS (for I from 1 to (ARRAY-RANK BASEARRAY) collect
(QUOTE ALL]
(if (NULL OLDITERATOR)
then (SETQ OLDITERATOR (create ITERATOR)))
(LET ((BASEDIMS (ARRAY-DIMENSIONS BASEARRAY))
(BASESCANDIMS (EARRAY-SCANDIMS BASEARRAY))
(OFFSET 0)
MULTIPLIERS INDICES LIMITS ENDITERATION)
(for LEVELMAP in LEVELMAPS as MULT in BASESCANDIMS as DIM in BASEDIMS
do (if (FIXP LEVELMAP)
then (SETQ OFFSET (IPLUS OFFSET (ITIMES MULT LEVELMAP)))
else (push MULTIPLIERS MULT)
(if (LISTP LEVELMAP)
then (push INDICES LEVELMAP)
(push LIMITS LEVELMAP)
else (push INDICES 0)
(push LIMITS DIM)))
finally (SETQ MULTIPLIERS (DREVERSE MULTIPLIERS))
(SETQ INDICES (DREVERSE INDICES))
(SETQ LIMITS (DREVERSE LIMITS)))
[SETQ ENDITERATION (for LIMIT in LIMITS thereis (AND (FIXP LIMIT)
(EQ LIMIT 0]
(if DIMMAP
then (SETQ MULTIPLIERS (PERMUTELIST MULTIPLIERS DIMMAP))
(SETQ INDICES (PERMUTELIST INDICES DIMMAP))
(SETQ LIMITS (PERMUTELIST LIMITS DIMMAP)))
(create ITERATOR
OFFSET ← OFFSET
MULTIPLIERS ← MULTIPLIERS
INDICES ← INDICES
LIMITS ← LIMITS
ENDITERATION ← ENDITERATION smashing OLDITERATOR])
(META-ITERATOR-NEXTITERATOR
[LAMBDA (META-ITERATOR) (* jop: "16-Jun-86 12:19")
(* *)
(LET ((BASEARRAY (fetch (META-ITERATOR BASEARRAY) of META-ITERATOR))
(LEVELS (fetch (META-ITERATOR LEVELS) of META-ITERATOR))
(LEVELLIMITS (fetch (META-ITERATOR LEVELLIMITS) of META-ITERATOR))
(ITERATOR (fetch (META-ITERATOR ITERATOR) of META-ITERATOR)))
(if (NOT (fetch (META-ITERATOR ENDITERATION) of META-ITERATOR))
then (SETQ ITERATOR (ITERATOR-SETUP BASEARRAY LEVELS NIL ITERATOR))
[bind INDEX (I ←(LENGTH LEVELS))
while [AND (IGREATERP I 0)
(OR (EQ (CAR (SETQ INDEX (FNTH LEVELS I)))
(QUOTE ALL))
(EQ (ADD1 (CAR INDEX))
(CAR (FNTH LEVELLIMITS I]
do (if (NEQ (CAR INDEX)
(QUOTE ALL))
then (RPLACA INDEX 0))
(SETQ I (SUB1 I))
finally (if (EQ I 0)
then (replace (META-ITERATOR ENDITERATION) of
META-ITERATOR
with T)
else (RPLACA INDEX (ADD1 (CAR INDEX]
ITERATOR])
(META-ITERATOR-RESET
[LAMBDA (META-ITERATOR) (* jop: " 8-Jun-86 17:28")
(* * reset iterator for another iteration)
(LET ((LEVELS (fetch (META-ITERATOR LEVELS) of META-ITERATOR))
(LEVELLIMITS (fetch (META-ITERATOR LEVELLIMITS) of META-ITERATOR)))
(for LEVEL on LEVELS unless (EQ (CAR LEVEL)
(QUOTE ALL))
do (RPLACA LEVEL 0))
(replace (META-ITERATOR ENDITERATION) of META-ITERATOR
with (for LIMIT in LEVELLIMITS as LEVEL in LEVELS unless (EQ LEVEL
(QUOTE
ALL))
thereis (EQ LIMIT 0)))
META-ITERATOR])
(META-ITERATOR-SETUP
[LAMBDA (BASEARRAY HELDDIMENSIONS) (* jop: "23-Jun-86 22:23")
(* *)
(if (EARRAY-SCALARP BASEARRAY)
then (ERROR "cannot iterate over a scalar" BASEARRAY))
(SETQ HELDDIMENSIONS (MKLIST HELDDIMENSIONS))
(LET ((LEVELS (for I from 0 upto (ARRAY-RANK BASEARRAY) collect (if (MEMB I
HELDDIMENSIONS)
then
(QUOTE ALL)
else 0)))
(LEVELLIMITS (ARRAY-DIMENSIONS BASEARRAY)))
(create META-ITERATOR
BASEARRAY ← BASEARRAY
LEVELS ← LEVELS
LEVELLIMITS ← LEVELLIMITS
ITERATOR ←(create ITERATOR)
ENDITERATION ←(for I from 0 as LIMIT in LEVELLIMITS
unless (MEMB I HELDDIMENSIONS) thereis (EQ LIMIT 0])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS EARRAY-ITERATORS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1615 10172 (GENERATOR-NEXTELT 1625 . 2184) (GENERATOR-SETNEXTELT 2186 . 2783) (
GENERATOR-SETUP 2785 . 3242) (ITERATOR-NEXTINDEX 3244 . 4799) (ITERATOR-RESET 4801 . 5491) (
ITERATOR-SETUP 5493 . 7282) (META-ITERATOR-NEXTITERATOR 7284 . 8563) (META-ITERATOR-RESET 8565 . 9304)
(META-ITERATOR-SETUP 9306 . 10170)))))
STOP