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