1
2(SDEFUN |CUBECF;sphereSolid;NniFcc;1|
3        ((|dim| |NonNegativeInteger|) ($ |FiniteCubicalComplex| (|Integer|)))
4        (SPROG
5         ((|r| (ASIMP)) (|vs1| (|List| (|Integer|)))
6          (|v1| (|List| (|List| (|List| (|Integer|))))) (#1=#:G405 NIL)
7          (|n| NIL) (#2=#:G404 NIL)
8          (ASIMP
9           (|Join| (|SetCategory|)
10                   (CATEGORY |domain|
11                    (SIGNATURE |cubicalComplex|
12                     ($ (|List| #3=(|Integer|)) (|List| (|CubicalFacet|))))
13                    (SIGNATURE |cubicalComplex|
14                     ($ (|List| #3#)
15                      (|List| (|List| (|Segment| (|Integer|))))))
16                    (SIGNATURE |cubicalComplex|
17                     ($ (|List| #3#) (|List| (|List| (|List| (|Integer|))))))
18                    (SIGNATURE |cubicalComplex| ($ (|List| #3#)))
19                    (SIGNATURE |maxIndex| ((|NonNegativeInteger|) $))
20                    (SIGNATURE |addCube| ($ $ (|CubicalFacet|)))
21                    (SIGNATURE |grade| ((|List| (|List| (|CubicalFacet|))) $))
22                    (SIGNATURE |addImpliedFaces|
23                     ((|List| (|List| (|CubicalFacet|))) $))
24                    (SIGNATURE |product| ($ $ $))
25                    (SIGNATURE |fundamentalGroup| ((|GroupPresentation|) $))
26                    (SIGNATURE |fundamentalGroup|
27                     ((|GroupPresentation|) $ (|Boolean|) (|Boolean|)))
28                    (SIGNATURE |homology| ((|List| (|Homology|)) $))
29                    (SIGNATURE |boundary| ($ $))
30                    (SIGNATURE |chain| ((|ChainComplex|) $))
31                    (SIGNATURE |coerce| ((|DeltaComplex| #3#) $))))))
32         (SEQ (LETT ASIMP (|FiniteCubicalComplex| (|Integer|)))
33              (LETT |v1|
34                    (LIST
35                     (PROGN
36                      (LETT #2# NIL)
37                      (SEQ (LETT |n| 1) (LETT #1# |dim|) G190
38                           (COND ((|greater_SI| |n| #1#) (GO G191)))
39                           (SEQ (EXIT (LETT #2# (CONS (LIST 1 2) #2#))))
40                           (LETT |n| (|inc_SI| |n|)) (GO G190) G191
41                           (EXIT (NREVERSE #2#))))))
42              (LETT |vs1| NIL)
43              (LETT |r|
44                    (SPADCALL |vs1| |v1|
45                              (|compiledLookupCheck| '|cubicalComplex|
46                                                     (LIST '$
47                                                           (LIST '|List|
48                                                                 (LIST
49                                                                  '|Integer|))
50                                                           (LIST '|List|
51                                                                 (LIST '|List|
52                                                                       (LIST
53                                                                        '|List|
54                                                                        (LIST
55                                                                         '|Integer|)))))
56                                                     ASIMP)))
57              (EXIT |r|))))
58
59(SDEFUN |CUBECF;sphereSurface;NniFcc;2|
60        ((|dim| |NonNegativeInteger|) ($ |FiniteCubicalComplex| (|Integer|)))
61        (SPROG
62         ((|r| (|FiniteCubicalComplex| (|Integer|)))
63          (|s| (|FiniteCubicalComplex| (|Integer|))))
64         (SEQ (LETT |s| (SPADCALL |dim| (QREFELT $ 8)))
65              (LETT |r| (SPADCALL |s| (QREFELT $ 9))) (EXIT |r|))))
66
67(SDEFUN |CUBECF;torusSurface;Fcc;3| (($ |FiniteCubicalComplex| (|Integer|)))
68        (SPROG ((|b| #1=(|FiniteCubicalComplex| (|Integer|))) (|a| #1#))
69               (SEQ (LETT |a| (SPADCALL 2 (QREFELT $ 10)))
70                    (LETT |b| (SPADCALL 2 (QREFELT $ 10)))
71                    (EXIT (SPADCALL |a| |b| (QREFELT $ 11))))))
72
73(SDEFUN |CUBECF;band;Fcc;4| (($ |FiniteCubicalComplex| (|Integer|)))
74        (SPROG
75         ((|b| (ASIMP)) (|vs1| (|List| (|Integer|)))
76          (|v1| (|List| (|List| (|List| (|Integer|)))))
77          (ASIMP
78           (|Join| (|SetCategory|)
79                   (CATEGORY |domain|
80                    (SIGNATURE |cubicalComplex|
81                     ($ (|List| #1=(|Integer|)) (|List| (|CubicalFacet|))))
82                    (SIGNATURE |cubicalComplex|
83                     ($ (|List| #1#)
84                      (|List| (|List| (|Segment| (|Integer|))))))
85                    (SIGNATURE |cubicalComplex|
86                     ($ (|List| #1#) (|List| (|List| (|List| (|Integer|))))))
87                    (SIGNATURE |cubicalComplex| ($ (|List| #1#)))
88                    (SIGNATURE |maxIndex| ((|NonNegativeInteger|) $))
89                    (SIGNATURE |addCube| ($ $ (|CubicalFacet|)))
90                    (SIGNATURE |grade| ((|List| (|List| (|CubicalFacet|))) $))
91                    (SIGNATURE |addImpliedFaces|
92                     ((|List| (|List| (|CubicalFacet|))) $))
93                    (SIGNATURE |product| ($ $ $))
94                    (SIGNATURE |fundamentalGroup| ((|GroupPresentation|) $))
95                    (SIGNATURE |fundamentalGroup|
96                     ((|GroupPresentation|) $ (|Boolean|) (|Boolean|)))
97                    (SIGNATURE |homology| ((|List| (|Homology|)) $))
98                    (SIGNATURE |boundary| ($ $))
99                    (SIGNATURE |chain| ((|ChainComplex|) $))
100                    (SIGNATURE |coerce| ((|DeltaComplex| #1#) $)))))
101          (|a| (|FiniteCubicalComplex| (|Integer|))))
102         (SEQ (LETT |a| (SPADCALL 2 (QREFELT $ 10)))
103              (LETT ASIMP (|FiniteCubicalComplex| (|Integer|)))
104              (LETT |v1| (LIST (LIST (LIST 1 2)))) (LETT |vs1| NIL)
105              (LETT |b|
106                    (SPADCALL |vs1| |v1|
107                              (|compiledLookupCheck| '|cubicalComplex|
108                                                     (LIST '$
109                                                           (LIST '|List|
110                                                                 (LIST
111                                                                  '|Integer|))
112                                                           (LIST '|List|
113                                                                 (LIST '|List|
114                                                                       (LIST
115                                                                        '|List|
116                                                                        (LIST
117                                                                         '|Integer|)))))
118                                                     ASIMP)))
119              (EXIT (SPADCALL |a| |b| (QREFELT $ 11))))))
120
121(SDEFUN |CUBECF;projectiveSpace;NniFcc;5|
122        ((|dim| |NonNegativeInteger|) ($ |FiniteCubicalComplex| (|Integer|)))
123        (SPROG
124         ((|r| (ASIMP)) (|vs1| (|List| (|Integer|)))
125          (|v1| (|List| (|List| (|List| (|Integer|)))))
126          (ASIMP
127           (|Join| (|SetCategory|)
128                   (CATEGORY |domain|
129                    (SIGNATURE |cubicalComplex|
130                     ($ (|List| #1=(|Integer|)) (|List| (|CubicalFacet|))))
131                    (SIGNATURE |cubicalComplex|
132                     ($ (|List| #1#)
133                      (|List| (|List| (|Segment| (|Integer|))))))
134                    (SIGNATURE |cubicalComplex|
135                     ($ (|List| #1#) (|List| (|List| (|List| (|Integer|))))))
136                    (SIGNATURE |cubicalComplex| ($ (|List| #1#)))
137                    (SIGNATURE |maxIndex| ((|NonNegativeInteger|) $))
138                    (SIGNATURE |addCube| ($ $ (|CubicalFacet|)))
139                    (SIGNATURE |grade| ((|List| (|List| (|CubicalFacet|))) $))
140                    (SIGNATURE |addImpliedFaces|
141                     ((|List| (|List| (|CubicalFacet|))) $))
142                    (SIGNATURE |product| ($ $ $))
143                    (SIGNATURE |fundamentalGroup| ((|GroupPresentation|) $))
144                    (SIGNATURE |fundamentalGroup|
145                     ((|GroupPresentation|) $ (|Boolean|) (|Boolean|)))
146                    (SIGNATURE |homology| ((|List| (|Homology|)) $))
147                    (SIGNATURE |boundary| ($ $))
148                    (SIGNATURE |chain| ((|ChainComplex|) $))
149                    (SIGNATURE |coerce| ((|DeltaComplex| #1#) $))))))
150         (SEQ (LETT ASIMP (|FiniteCubicalComplex| (|Integer|)))
151              (COND
152               ((SPADCALL |dim| 2 (QREFELT $ 15))
153                (|error| "projectiveSpace only defined for plane")))
154              (LETT |v1|
155                    (LIST
156                     (LIST (LIST 1 2) (LIST 1 1) (LIST 1 1) (LIST 1 2)
157                           (LIST 1 1))
158                     (LIST (LIST 1 2) (LIST 1 1) (LIST 1 1) (LIST 1 1)
159                           (LIST 1 2))
160                     (LIST (LIST 1 1) (LIST 1 2) (LIST 1 2) (LIST 1 1)
161                           (LIST 1 1))
162                     (LIST (LIST 1 1) (LIST 1 2) (LIST 1 1) (LIST 1 2)
163                           (LIST 1 1))
164                     (LIST (LIST 1 1) (LIST 1 1) (LIST 1 2) (LIST 1 1)
165                           (LIST 1 2))
166                     (LIST (LIST 1 2) (LIST 1 2) (LIST 2 2) (LIST 1 1)
167                           (LIST 1 1))
168                     (LIST (LIST 1 2) (LIST 2 2) (LIST 1 2) (LIST 1 1)
169                           (LIST 1 1))
170                     (LIST (LIST 2 2) (LIST 1 2) (LIST 1 2) (LIST 1 1)
171                           (LIST 1 1))
172                     (LIST (LIST 1 2) (LIST 1 2) (LIST 1 1) (LIST 1 1)
173                           (LIST 2 2))
174                     (LIST (LIST 1 2) (LIST 2 2) (LIST 1 1) (LIST 1 1)
175                           (LIST 1 2))
176                     (LIST (LIST 2 2) (LIST 1 2) (LIST 1 1) (LIST 1 1)
177                           (LIST 1 2))
178                     (LIST (LIST 1 2) (LIST 1 1) (LIST 1 2) (LIST 2 2)
179                           (LIST 1 1))
180                     (LIST (LIST 1 2) (LIST 1 1) (LIST 2 2) (LIST 1 2)
181                           (LIST 1 1))
182                     (LIST (LIST 2 2) (LIST 1 1) (LIST 1 2) (LIST 1 2)
183                           (LIST 1 1))
184                     (LIST (LIST 1 1) (LIST 1 2) (LIST 1 1) (LIST 1 2)
185                           (LIST 2 2))
186                     (LIST (LIST 1 1) (LIST 1 2) (LIST 1 1) (LIST 2 2)
187                           (LIST 1 2))
188                     (LIST (LIST 1 1) (LIST 2 2) (LIST 1 1) (LIST 1 2)
189                           (LIST 1 2))
190                     (LIST (LIST 1 1) (LIST 1 1) (LIST 1 2) (LIST 1 2)
191                           (LIST 2 2))
192                     (LIST (LIST 1 1) (LIST 1 1) (LIST 1 2) (LIST 2 2)
193                           (LIST 1 2))
194                     (LIST (LIST 1 1) (LIST 1 1) (LIST 2 2) (LIST 1 2)
195                           (LIST 1 2))))
196              (LETT |vs1| NIL)
197              (LETT |r|
198                    (SPADCALL |vs1| |v1|
199                              (|compiledLookupCheck| '|cubicalComplex|
200                                                     (LIST '$
201                                                           (LIST '|List|
202                                                                 (LIST
203                                                                  '|Integer|))
204                                                           (LIST '|List|
205                                                                 (LIST '|List|
206                                                                       (LIST
207                                                                        '|List|
208                                                                        (LIST
209                                                                         '|Integer|)))))
210                                                     ASIMP)))
211              (EXIT |r|))))
212
213(DECLAIM (NOTINLINE |CubicalComplexFactory;|))
214
215(DEFUN |CubicalComplexFactory| ()
216  (SPROG NIL
217         (PROG (#1=#:G416)
218           (RETURN
219            (COND
220             ((LETT #1# (HGET |$ConstructorCache| '|CubicalComplexFactory|))
221              (|CDRwithIncrement| (CDAR #1#)))
222             ('T
223              (UNWIND-PROTECT
224                  (PROG1
225                      (CDDAR
226                       (HPUT |$ConstructorCache| '|CubicalComplexFactory|
227                             (LIST
228                              (CONS NIL (CONS 1 (|CubicalComplexFactory;|))))))
229                    (LETT #1# T))
230                (COND
231                 ((NOT #1#)
232                  (HREM |$ConstructorCache| '|CubicalComplexFactory|))))))))))
233
234(DEFUN |CubicalComplexFactory;| ()
235  (SPROG ((|dv$| NIL) ($ NIL) (|pv$| NIL))
236         (PROGN
237          (LETT |dv$| '(|CubicalComplexFactory|))
238          (LETT $ (GETREFV 17))
239          (QSETREFV $ 0 |dv$|)
240          (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL)))
241          (|haddProp| |$ConstructorCache| '|CubicalComplexFactory| NIL
242                      (CONS 1 $))
243          (|stuffDomainSlots| $)
244          (SETF |pv$| (QREFELT $ 3))
245          $)))
246
247(MAKEPROP '|CubicalComplexFactory| '|infovec|
248          (LIST
249           '#(NIL NIL NIL NIL NIL NIL (|FiniteCubicalComplex| (|Integer|))
250              (|NonNegativeInteger|) |CUBECF;sphereSolid;NniFcc;1|
251              (0 . |boundary|) |CUBECF;sphereSurface;NniFcc;2| (5 . |product|)
252              |CUBECF;torusSurface;Fcc;3| |CUBECF;band;Fcc;4| (|Boolean|)
253              (11 . ~=) |CUBECF;projectiveSpace;NniFcc;5|)
254           '#(|torusSurface| 17 |sphereSurface| 21 |sphereSolid| 26
255              |projectiveSpace| 31 |moebiusBand| 36 |kleinBottle| 40 |band| 44)
256           'NIL
257           (CONS (|makeByteWordVec2| 1 '(0))
258                 (CONS '#(NIL)
259                       (CONS
260                        '#((|Join|
261                            (|mkCategory|
262                             (LIST
263                              '((|sphereSolid|
264                                 ((|FiniteCubicalComplex| (|Integer|))
265                                  (|NonNegativeInteger|)))
266                                T)
267                              '((|sphereSurface|
268                                 ((|FiniteCubicalComplex| (|Integer|))
269                                  (|NonNegativeInteger|)))
270                                T)
271                              '((|torusSurface|
272                                 ((|FiniteCubicalComplex| (|Integer|))))
273                                T)
274                              '((|band| ((|FiniteCubicalComplex| (|Integer|))))
275                                T)
276                              '((|moebiusBand|
277                                 ((|FiniteCubicalComplex| (|Integer|))))
278                                T)
279                              '((|projectiveSpace|
280                                 ((|FiniteCubicalComplex| (|Integer|))
281                                  (|NonNegativeInteger|)))
282                                T)
283                              '((|kleinBottle|
284                                 ((|FiniteCubicalComplex| (|Integer|))))
285                                T))
286                             (LIST) NIL NIL)))
287                        (|makeByteWordVec2| 16
288                                            '(1 6 0 0 9 2 6 0 0 0 11 2 7 14 0 0
289                                              15 0 0 6 12 1 0 6 7 10 1 0 6 7 8
290                                              1 0 6 7 16 0 0 6 1 0 0 6 1 0 0 6
291                                              13)))))
292           '|lookupComplete|))
293
294(MAKEPROP '|CubicalComplexFactory| 'NILADIC T)
295