* algebra/indexedp.spad.pamphlet (IndexedDirectProductCategory):

	Rework implementation.

7 files changed, 56 insertions, 42 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index aef22333..2887db40 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
 2010-06-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* algebra/indexedp.spad.pamphlet (IndexedDirectProductCategory):
+	Rework implementation.
+
+2010-06-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* algebra/indexedp.spad.pamphlet (IndexedDirectProductCategory)
 	[support]: New.
 	(IndexedDirectProductObject): Implement.
diff --git a/src/algebra/indexedp.spad.pamphlet b/src/algebra/indexedp.spad.pamphlet
index 2caf4e10..1e1a569f 100644
--- a/src/algebra/indexedp.spad.pamphlet
+++ b/src/algebra/indexedp.spad.pamphlet
@@ -52,50 +52,59 @@ IndexedDirectProductCategory(A:SetCategory,S:OrderedSet): Category ==
       ++ and the corresponding value (the second component).
 
 @
+
 \section{domain IDPO IndexedDirectProductObject}
 <<domain IDPO IndexedDirectProductObject>>=
 )abbrev domain IDPO IndexedDirectProductObject
-++ Data Last Updated: June 28, 2010
-++ Indexed direct products of objects over a set \spad{A}
-++ of generators indexed by an ordered set S. All items have finite support.
-IndexedDirectProductObject(A:SetCategory,S:OrderedSet): IndexedDirectProductCategory(A,S)
- == add
-    --representations
-       Term:=  Record(k:S,c:A)
-       Rep:=  List Term
-    --declarations
-       x,y: %
-       f: A -> A
-       s: S
-    --define
-       x = y ==
-         while not null x and not null y repeat
-           x.first.k ~= y.first.k => return false
-           x.first.c ~= y.first.c => return false
-           x:=x.rest
-           y:=y.rest
-         null x and null y
+++ Author: James Davenport, Gabriel Dos Reis
+++ Date Created:
+++ Date Last Updated: June 28, 2010
+++ Description:
+++   Indexed direct products of objects over a set \spad{A}
+++   of generators indexed by an ordered set S. All items have finite support.
+IndexedDirectProductObject(A,S): Public == Private where
+  A: SetCategory
+  S: OrderedSet
+  Public == IndexedDirectProductCategory(A,S)
+  Private == add
+    Term == Pair(S,A)
+    Rep == List Term
+    -- Return the index of a term
+    termIndex(t: Term): S == first t
+    -- Return the value of a term
+    termValue(t: Term): A == second t
+
+    x = y ==
+      x' := rep x
+      y' := rep y
+      while not null x' and not null y' repeat
+        termIndex first x' ~= termIndex first y' => return false
+        termValue first x' ~= termValue first y' => return false
+        x' := rest x'
+        y' := rest y'
+      null x' and null y'
 
-       coerce(x:%):OutputForm ==
-          bracket [rarrow(t.k :: OutputForm, t.c :: OutputForm) for t in x]
+    coerce(x:%):OutputForm ==
+       bracket [rarrow(termIndex(t)::OutputForm, termValue(t)::OutputForm)
+                 for t in rep x]
 
-       -- sample():% == [[sample()$S,sample()$A]$Term]$Rep
+    -- sample():% == [[sample()$S,sample()$A]$Term]$Rep
 
-       monomial(r,s) == [[s,r]]
-       map(f,x) == [[tm.k,f(tm.c)] for tm in x]
+    monomial(r,s) == per [[s,r]]
+    map(f,x) == per [[termIndex tm,f termValue tm] for tm in rep x]
 
-       reductum x     ==
-          rest x
-       leadingCoefficient x  ==
-          null x => error "Can't take leadingCoefficient of empty product element"
-          x.first.c
-       leadingSupport x  ==
-          null x => error "Can't take leadingCoefficient of empty product element"
-          x.first.k
+    reductum x ==
+       per rest rep x
+    leadingCoefficient x  ==
+       null rep x =>
+         error "Can't take leadingCoefficient of empty product element"
+       termValue first rep x
+    leadingSupport x  ==
+       null rep x =>
+         error "Can't take leadingCoefficient of empty product element"
+       termIndex first rep x
 
-       -- FIXME: We should define Rep directly as List Pair(S,R)
-       --        so that this gross pretend can go away.
-       support x == x pretend List Pair(S,A)
+    support x == rep x
 
 @
 \section{domain IDPAM IndexedDirectProductAbelianMonoid}
diff --git a/src/share/algebra/browse.daase b/src/share/algebra/browse.daase
index 09f5d135..b8ba4119 100644
--- a/src/share/algebra/browse.daase
+++ b/src/share/algebra/browse.daase
@@ -1,5 +1,5 @@
 
-(2293439 . 3486753495)       
+(2293439 . 3486762004)       
 (-18 A S) 
 ((|constructor| (NIL "One-dimensional-array aggregates serves as models for one-dimensional arrays. Categorically,{} these aggregates are finite linear aggregates with the \\spadatt{shallowlyMutable} property,{} that is,{} any component of the array may be changed without affecting the identity of the overall array. Array data structures are typically represented by a fixed area in storage and therefore cannot efficiently grow or shrink on demand as can list structures (see however \\spadtype{FlexibleArray} for a data structure which is a cross between a list and an array). Iteration over,{} and access to,{} elements of arrays is extremely fast (and often can be optimized to open-code). Insertion and deletion however is generally slow since an entirely new data structure must be created for the result."))) 
 NIL 
diff --git a/src/share/algebra/category.daase b/src/share/algebra/category.daase
index b74acbfe..c82eb837 100644
--- a/src/share/algebra/category.daase
+++ b/src/share/algebra/category.daase
@@ -1,5 +1,5 @@
 
-(203818 . 3486753502)        
+(203818 . 3486762012)        
 (((|#2| |#2|) -12 (|has| |#2| (-319 |#2|)) (|has| |#2| (-1119))) ((#0=(-2 (|:| -4298 |#1|) (|:| -4437 |#2|)) #0#) |has| (-2 (|:| -4298 |#1|) (|:| -4437 |#2|)) (-319 (-2 (|:| -4298 |#1|) (|:| -4437 |#2|))))) 
 ((((-576)) . T) (($) -2755 (|has| |#1| (-317)) (|has| |#1| (-374)) (|has| |#1| (-360)) (|has| |#1| (-568))) (((-419 (-576))) -2755 (|has| |#1| (-374)) (|has| |#1| (-360)) (|has| |#1| (-1057 (-419 (-576))))) ((|#1|) . T)) 
 (((|#2| |#2|) . T)) 
diff --git a/src/share/algebra/compress.daase b/src/share/algebra/compress.daase
index 1ff2fc66..ea14f8ad 100644
--- a/src/share/algebra/compress.daase
+++ b/src/share/algebra/compress.daase
@@ -1,5 +1,5 @@
 
-(30 . 3486753493)            
+(30 . 3486762003)            
 (4465 |Enumeration| |Mapping| |Record| |Union| |ofCategory| |isDomain|
  ATTRIBUTE |package| |domain| |category| CATEGORY |nobranch| AND |Join|
  |ofType| SIGNATURE "failed" "algebra" |OneDimensionalArrayAggregate&|
diff --git a/src/share/algebra/interp.daase b/src/share/algebra/interp.daase
index fa2d51ab..5aea172d 100644
--- a/src/share/algebra/interp.daase
+++ b/src/share/algebra/interp.daase
@@ -1,5 +1,5 @@
 
-(3260701 . 3486753518)       
+(3260701 . 3486762027)       
 ((-2923 (((-112) (-1 (-112) |#2| |#2|) $) 86) (((-112) $) NIL)) (-1457 (($ (-1 (-112) |#2| |#2|) $) 18) (($ $) NIL)) (-3753 ((|#2| $ (-576) |#2|) NIL) ((|#2| $ (-1253 (-576)) |#2|) 44)) (-3588 (($ $) 80)) (-3683 ((|#2| (-1 |#2| |#2| |#2|) $ |#2| |#2|) 52) ((|#2| (-1 |#2| |#2| |#2|) $ |#2|) 50) ((|#2| (-1 |#2| |#2| |#2|) $) 49)) (-3657 (((-576) (-1 (-112) |#2|) $) 27) (((-576) |#2| $) NIL) (((-576) |#2| $ (-576)) 96)) (-3964 (((-656 |#2|) $) 13)) (-2331 (($ (-1 (-112) |#2| |#2|) $ $) 64) (($ $ $) NIL)) (-4322 (($ (-1 |#2| |#2|) $) 37)) (-4114 (($ (-1 |#2| |#2|) $) NIL) (($ (-1 |#2| |#2| |#2|) $ $) 60)) (-2171 (($ |#2| $ (-576)) NIL) (($ $ $ (-576)) 67)) (-3550 (((-3 |#2| "failed") (-1 (-112) |#2|) $) 29)) (-3334 (((-112) (-1 (-112) |#2|) $) 23)) (-2794 ((|#2| $ (-576) |#2|) NIL) ((|#2| $ (-576)) NIL) (($ $ (-1253 (-576))) 66)) (-3461 (($ $ (-576)) 76) (($ $ (-1253 (-576))) 75)) (-1458 (((-783) (-1 (-112) |#2|) $) 34) (((-783) |#2| $) NIL)) (-2012 (($ $ $ (-576)) 69)) (-1868 (($ $) 68)) (-3579 (($ (-656 |#2|)) 73)) (-1613 (($ $ |#2|) NIL) (($ |#2| $) NIL) (($ $ $) 87) (($ (-656 $)) 85)) (-3567 (((-874) $) 92)) (-2458 (((-112) (-1 (-112) |#2|) $) 22)) (-2922 (((-112) $ $) 95)) (-2947 (((-112) $ $) 99))) 
 (((-18 |#1| |#2|) (-10 -8 (-15 -2922 ((-112) |#1| |#1|)) (-15 -3567 ((-874) |#1|)) (-15 -2947 ((-112) |#1| |#1|)) (-15 -1457 (|#1| |#1|)) (-15 -1457 (|#1| (-1 (-112) |#2| |#2|) |#1|)) (-15 -3588 (|#1| |#1|)) (-15 -2012 (|#1| |#1| |#1| (-576))) (-15 -2923 ((-112) |#1|)) (-15 -2331 (|#1| |#1| |#1|)) (-15 -3657 ((-576) |#2| |#1| (-576))) (-15 -3657 ((-576) |#2| |#1|)) (-15 -3657 ((-576) (-1 (-112) |#2|) |#1|)) (-15 -2923 ((-112) (-1 (-112) |#2| |#2|) |#1|)) (-15 -2331 (|#1| (-1 (-112) |#2| |#2|) |#1| |#1|)) (-15 -3753 (|#2| |#1| (-1253 (-576)) |#2|)) (-15 -2171 (|#1| |#1| |#1| (-576))) (-15 -2171 (|#1| |#2| |#1| (-576))) (-15 -3461 (|#1| |#1| (-1253 (-576)))) (-15 -3461 (|#1| |#1| (-576))) (-15 -4114 (|#1| (-1 |#2| |#2| |#2|) |#1| |#1|)) (-15 -1613 (|#1| (-656 |#1|))) (-15 -1613 (|#1| |#1| |#1|)) (-15 -1613 (|#1| |#2| |#1|)) (-15 -1613 (|#1| |#1| |#2|)) (-15 -2794 (|#1| |#1| (-1253 (-576)))) (-15 -3579 (|#1| (-656 |#2|))) (-15 -3550 ((-3 |#2| "failed") (-1 (-112) |#2|) |#1|)) (-15 -3683 (|#2| (-1 |#2| |#2| |#2|) |#1|)) (-15 -3683 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2|)) (-15 -3683 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2| |#2|)) (-15 -2794 (|#2| |#1| (-576))) (-15 -2794 (|#2| |#1| (-576) |#2|)) (-15 -3753 (|#2| |#1| (-576) |#2|)) (-15 -1458 ((-783) |#2| |#1|)) (-15 -3964 ((-656 |#2|) |#1|)) (-15 -1458 ((-783) (-1 (-112) |#2|) |#1|)) (-15 -3334 ((-112) (-1 (-112) |#2|) |#1|)) (-15 -2458 ((-112) (-1 (-112) |#2|) |#1|)) (-15 -4322 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -4114 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -1868 (|#1| |#1|))) (-19 |#2|) (-1236)) (T -18)) 
 NIL 
@@ -2115,7 +2115,7 @@ NIL
 (((-523 |#1| |#2|) (-13 (-805) (-521 |#1| |#2|)) (-805) (-862)) (T -523)) 
 NIL 
 (-13 (-805) (-521 |#1| |#2|)) 
-((-3486 (((-112) $ $) NIL)) (-4343 (((-656 (-885 |#2| |#1|)) $) 37)) (-2109 (($ $) 32)) (-1940 (($ |#1| |#2|) 28)) (-4114 (($ (-1 |#1| |#1|) $) 30)) (-1771 ((|#2| $) 34)) (-2086 ((|#1| $) 33)) (-3440 (((-1177) $) NIL)) (-1448 (((-1139) $) NIL)) (-3567 (((-874) $) 27)) (-2957 (((-112) $ $) NIL)) (-2922 (((-112) $ $) 20))) 
+((-3486 (((-112) $ $) NIL)) (-4343 (((-656 (-885 |#2| |#1|)) $) 39)) (-2109 (($ $) 34)) (-1940 (($ |#1| |#2|) 30)) (-4114 (($ (-1 |#1| |#1|) $) 32)) (-1771 ((|#2| $) 38)) (-2086 ((|#1| $) 37)) (-3440 (((-1177) $) NIL)) (-1448 (((-1139) $) NIL)) (-3567 (((-874) $) 28)) (-2957 (((-112) $ $) NIL)) (-2922 (((-112) $ $) 21))) 
 (((-524 |#1| |#2|) (-521 |#1| |#2|) (-1119) (-862)) (T -524)) 
 NIL 
 (-521 |#1| |#2|) 
diff --git a/src/share/algebra/operation.daase b/src/share/algebra/operation.daase
index 7641d07b..976c4ca6 100644
--- a/src/share/algebra/operation.daase
+++ b/src/share/algebra/operation.daase
@@ -1,5 +1,5 @@
 
-(731535 . 3486753497)        
+(731535 . 3486762006)        
 (((*1 *2)
   (-12 (-4 *1 (-353 *3 *4 *5)) (-4 *3 (-1240)) (-4 *4 (-1262 *3))
    (-4 *5 (-1262 (-419 *4))) (-5 *2 (-701 (-419 *4))))))