(FILECREATED " 6-Jun-86 11:46:03" {QV}<PEDERSEN>LISP>IDLARRAYITERATORS.;4 10871
changes to: (VARS IDLARRAYITERATORSCOMS)
(RECORDS GENERATOR)
(FNS GENERATOR-SETUP GENERATOR-NEXTELT GENERATOR-SETNEXTELT)
previous date: "13-May-86 18:01:24" {QV}<PEDERSEN>LISP>IDLARRAYITERATORS.;3)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IDLARRAYITERATORSCOMS)
(RPAQQ IDLARRAYITERATORSCOMS ((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: EVAL@COMPILE
(DATATYPE GENERATOR (VECTOR ITERATOR))
(DATATYPE ITERATOR (OFFSET MULTIPLIERS INDICES LIMITS ENDITERATION))
(DATATYPE META-ITERATOR (BASEARRAY LEVELS LEVELLIMITS 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))
(QUOTE ((META-ITERATOR 0 POINTER)
(META-ITERATOR 2 POINTER)
(META-ITERATOR 4 POINTER)
(META-ITERATOR 6 POINTER)))
(QUOTE 8))
(DEFINEQ
(GENERATOR-NEXTELT
[LAMBDA (GENERATOR) (* jop: " 5-Jun-86 22:19")
(* *)
(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)))
(IDLARRAY-REF (fetch (GENERATOR VECTOR) of GENERATOR)
INDEX))
else GENERATOR])
(GENERATOR-SETNEXTELT
[LAMBDA (NEWVALUE GENERATOR) (* jop: " 5-Jun-86 22:19")
(* *)
(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)))
(IDLARRAY-SET NEWVALUE (fetch (GENERATOR VECTOR) of GENERATOR)
INDEX))
else (HELP "Not a generator" GENERATOR])
(GENERATOR-SETUP
[LAMBDA (IDLARRAY ITERATOR) (* jop: " 5-Jun-86 22:10")
(* *)
(if (IDLARRAY-SCALARP IDLARRAY)
then IDLARRAY
else (create GENERATOR
VECTOR ← (IDLARRAY-LINEARIZE IDLARRAY)
ITERATOR ← (OR ITERATOR (ITERATOR-SETUP IDLARRAY])
(ITERATOR-NEXTINDEX
[LAMBDA (ITERATOR) (* jop: "13-May-86 14:22")
(* *)
(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 (EQL (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 (EQL 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: "13-May-86 14:22")
(* * 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 (NLISTP LIMIT)
(ZEROP LIMIT]
ITERATOR])
(ITERATOR-SETUP
[LAMBDA (BASEARRAY LEVELMAPS DIMMAP) (* jop: "13-May-86 14:22")
(* *)
[if (NULL LEVELMAPS)
then (SETQ LEVELMAPS (for I from 1 to (IDLARRAY-RANK BASEARRAY) collect (QUOTE ALL]
(LET*[(BASEDIMS (IDLARRAY-DIMS BASEARRAY))
(BASESCANDIMS (IDLARRAY-SCANDIMS BASEARRAY))
(OFFSET (for LEVELMAP in LEVELMAPS as MULT in BASESCANDIMS when (FIXP LEVELMAP)
sum (ITIMES MULT LEVELMAP)))
(MULTIPLIERS (for LEVELMAP in LEVELMAPS as MULT in BASESCANDIMS
when (NOT (FIXP LEVELMAP)) collect MULT))
(INDICES (for LEVELMAP in LEVELMAPS when (NOT (FIXP LEVELMAP))
collect (if (LISTP LEVELMAP)
then LEVELMAP
else 0)))
(LIMITS (for LEVELMAP in LEVELMAPS as DIM in BASEDIMS when (NOT (FIXP LEVELMAP))
collect (if (LISTP LEVELMAP)
then LEVELMAP
else DIM)))
(ENDITERATION (for LIMIT in LIMITS thereis (AND (FIXP LIMIT)
(ZEROP LIMIT]
(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])
(META-ITERATOR-NEXTITERATOR
[LAMBDA (META-ITERATOR) (* jop: "13-May-86 14:21")
(* *)
(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)
[if (NOT (fetch (META-ITERATOR ENDITERATION) of META-ITERATOR))
then (SETQ ITERATOR (ITERATOR-SETUP BASEARRAY LEVELS))
(bind INDEX (I ←(LENGTH LEVELS))
while [AND (IGREATERP I 0)
(OR (EQ (CAR (SETQ INDEX (FNTH LEVELS I)))
(QUOTE ALL))
(EQL (ADD1 (CAR INDEX))
(CAR (FNTH LEVELLIMITS I]
do (if (NEQ (CAR INDEX)
(QUOTE ALL))
then (RPLACA INDEX 0))
(SETQ I (SUB1 I)) finally (if (EQL I 0)
then (replace (META-ITERATOR ENDITERATION)
of ITERATOR with T)
else (RPLACA INDEX (ADD1 (CAR INDEX]
ITERATOR])
(META-ITERATOR-RESET
[LAMBDA (META-ITERATOR) (* jop: "13-May-86 17:29")
(* * 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 (ZEROP LIMIT)))
META-ITERATOR])
(META-ITERATOR-SETUP
[LAMBDA (BASEARRAY HELDDIMENSIONS) (* jop: "13-May-86 14:01")
(* *)
(SETQ HELDDIMENSIONS (MKLIST HELDDIMENSIONS))
(LET ((LEVELS (for I from 0 upto (IDLARRAY-RANK BASEARRAY)
collect (if (MEMB I HELDDIMENSIONS)
then (QUOTE ALL)
else 0)))
(LEVELLIMITS (IDLARRAY-DIMS BASEARRAY)))
(create META-ITERATOR
BASEARRAY ← BASEARRAY
LEVELS ← LEVELS
LEVELLIMITS ← LEVELLIMITS
ENDITERATION ←(for I from 0 as LIMIT in LEVELLIMITS unless (MEMB I HELDDIMENSIONS)
thereis (ZEROP LIMIT])
)
(PUTPROPS IDLARRAYITERATORS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1555 10783 (GENERATOR-NEXTELT 1565 . 2133) (GENERATOR-SETNEXTELT 2135 . 2741) (
GENERATOR-SETUP 2743 . 3098) (ITERATOR-NEXTINDEX 3100 . 5061) (ITERATOR-RESET 5063 . 5950) (
ITERATOR-SETUP 5952 . 7733) (META-ITERATOR-NEXTITERATOR 7735 . 9208) (META-ITERATOR-RESET 9210 . 9961)
(META-ITERATOR-SETUP 9963 . 10781)))))
STOP