diff options
Diffstat (limited to 'src/algebra/strap/URAGG-.lsp')
-rw-r--r-- | src/algebra/strap/URAGG-.lsp | 216 |
1 files changed, 113 insertions, 103 deletions
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index 44f85770..68179ede 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -228,7 +228,8 @@ (DEFUN |URAGG-;#;ANni;15| (|x| $) (PROG (|k|) (RETURN - (SEQ (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) G190 + (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) + (SEQ G190 (COND ((NULL (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) (GO G191))) @@ -237,10 +238,10 @@ (COND ((SPADCALL |x| (|getShellEntry| $ 48)) (EXIT (|error| "cyclic list")))))) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;#;ANni;15|))) - (SETQ |k| (QSADD1 |k|)) (GO G190) G191 (EXIT NIL)) + (LETT |x| (SPADCALL |x| (|getShellEntry| $ 14)) + |URAGG-;#;ANni;15|) + (EXIT (LETT |k| (+ |k| 1) |URAGG-;#;ANni;15|))) + NIL (GO G190) G191 (EXIT NIL)) (EXIT |k|))))) (DEFUN |URAGG-;tail;2A;16| (|x| $) @@ -282,7 +283,7 @@ ((NULL (NOT (SPADCALL |y| (|getShellEntry| $ 20)))) (GO G191))) (SEQ (COND - ((SPADCALL |x| |y| (|getShellEntry| $ 51)) + ((SPADCALL |x| |y| (|getShellEntry| $ 54)) (RETURN-FROM |URAGG-;findCycle| |x|))) (LETT |x| (SPADCALL |x| (|getShellEntry| $ 14)) |URAGG-;findCycle|) @@ -292,7 +293,7 @@ ((SPADCALL |y| (|getShellEntry| $ 20)) (RETURN-FROM |URAGG-;findCycle| |y|))) (COND - ((SPADCALL |x| |y| (|getShellEntry| $ 51)) + ((SPADCALL |x| |y| (|getShellEntry| $ 54)) (RETURN-FROM |URAGG-;findCycle| |y|))) (EXIT (LETT |y| (SPADCALL |y| (|getShellEntry| $ 14)) @@ -306,7 +307,7 @@ (SEQ (COND ((SPADCALL (LETT |y| - (LETT |x| (SPADCALL |x| (|getShellEntry| $ 52)) + (LETT |x| (SPADCALL |x| (|getShellEntry| $ 55)) |URAGG-;cycleTail;2A;18|) |URAGG-;cycleTail;2A;18|) (|getShellEntry| $ 20)) @@ -317,7 +318,7 @@ (SEQ G190 (COND ((NULL (NOT (SPADCALL |x| |z| - (|getShellEntry| $ 51)))) + (|getShellEntry| $ 54)))) (GO G191))) (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) (EXIT (LETT |z| @@ -328,7 +329,7 @@ (EXIT |y|)))))))) (DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) - (PROG (|l| |z| |k| |y|) + (PROG (|z| |l| |k| |y|) (RETURN (SEQ (COND ((SPADCALL |x| (|getShellEntry| $ 20)) |x|) @@ -340,15 +341,19 @@ ('T (SEQ (LETT |z| (SPADCALL |y| (|getShellEntry| $ 14)) |URAGG-;cycleEntry;2A;19|) - (SEQ (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) G190 + (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) + (SEQ G190 (COND ((NULL (NOT (SPADCALL |y| |z| - (|getShellEntry| $ 51)))) + (|getShellEntry| $ 54)))) (GO G191))) - (LETT |z| (SPADCALL |z| (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|) - (SETQ |l| (QSADD1 |l|)) (GO G190) G191 - (EXIT NIL)) + (SEQ (LETT |z| + (SPADCALL |z| + (|getShellEntry| $ 14)) + |URAGG-;cycleEntry;2A;19|) + (EXIT (LETT |l| (+ |l| 1) + |URAGG-;cycleEntry;2A;19|))) + NIL (GO G190) G191 (EXIT NIL)) (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 (COND ((QSGREATERP |k| |l|) (GO G191))) @@ -359,7 +364,7 @@ (SEQ G190 (COND ((NULL (NOT (SPADCALL |x| |y| - (|getShellEntry| $ 51)))) + (|getShellEntry| $ 54)))) (GO G191))) (SEQ (LETT |x| (SPADCALL |x| @@ -373,7 +378,7 @@ (EXIT |x|)))))))) (DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) - (PROG (|k| |y|) + (PROG (|y| |k|) (RETURN (SEQ (COND ((OR (SPADCALL |x| (|getShellEntry| $ 20)) @@ -385,15 +390,19 @@ ('T (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) |URAGG-;cycleLength;ANni;20|) - (SEQ (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) G190 + (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) + (SEQ G190 (COND ((NULL (NOT (SPADCALL |x| |y| - (|getShellEntry| $ 51)))) + (|getShellEntry| $ 54)))) (GO G191))) - (LETT |y| (SPADCALL |y| (|getShellEntry| $ 14)) - |URAGG-;cycleLength;ANni;20|) - (SETQ |k| (QSADD1 |k|)) (GO G190) G191 - (EXIT NIL)) + (SEQ (LETT |y| + (SPADCALL |y| + (|getShellEntry| $ 14)) + |URAGG-;cycleLength;ANni;20|) + (EXIT (LETT |k| (+ |k| 1) + |URAGG-;cycleLength;ANni;20|))) + NIL (GO G190) G191 (EXIT NIL)) (EXIT |k|)))))))) (DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) @@ -415,24 +424,24 @@ (DEFUN |URAGG-;last;ANniA;22| (|x| |n| $) (PROG (|m|) (RETURN - (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 57)) + (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 60)) |URAGG-;last;ANniA;22|) (EXIT (COND ((> |n| |m|) (|error| "index out of range")) ('T (SPADCALL (SPADCALL |x| - (LET ((#0=#:G1500 (- |m| |n|))) + (LET ((#0=#:G1502 (- |m| |n|))) (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 59)) - (|getShellEntry| $ 60))))))))) + (|getShellEntry| $ 62)) + (|getShellEntry| $ 63))))))))) (DEFUN |URAGG-;=;2AB;23| (|x| |y| $) (PROG (|k|) (RETURN (SEQ (COND - ((SPADCALL |x| |y| (|getShellEntry| $ 51)) T) + ((SPADCALL |x| |y| (|getShellEntry| $ 54)) T) ('T (SEQ (SEQ (LETT |k| 0 |URAGG-;=;2AB;23|) G190 (COND @@ -457,7 +466,7 @@ (|getShellEntry| $ 8)) (SPADCALL |y| (|getShellEntry| $ 8)) - (|getShellEntry| $ 63)) + (|getShellEntry| $ 66)) (RETURN-FROM |URAGG-;=;2AB;23| NIL)) ('T @@ -486,7 +495,7 @@ ((NULL (NOT (SPADCALL |v| (|getShellEntry| $ 20)))) (GO G191))) (SEQ (EXIT (COND - ((SPADCALL |u| |v| (|getShellEntry| $ 65)) + ((SPADCALL |u| |v| (|getShellEntry| $ 68)) (RETURN-FROM |URAGG-;node?;2AB;24| T)) ('T (SEQ (COND @@ -501,20 +510,20 @@ (|getShellEntry| $ 14)) |URAGG-;node?;2AB;24|))))))) (SETQ |k| (QSADD1 |k|)) (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |u| |v| (|getShellEntry| $ 65))))))) + (EXIT (SPADCALL |u| |v| (|getShellEntry| $ 68))))))) (DEFUN |URAGG-;setelt;Afirst2S;25| (|x| T3 |a| $) - (SPADCALL |x| |a| (|getShellEntry| $ 67))) + (SPADCALL |x| |a| (|getShellEntry| $ 70))) (DEFUN |URAGG-;setelt;Alast2S;26| (|x| T4 |a| $) - (SPADCALL |x| |a| (|getShellEntry| $ 69))) + (SPADCALL |x| |a| (|getShellEntry| $ 72))) (DEFUN |URAGG-;setelt;Arest2A;27| (|x| T5 |a| $) - (SPADCALL |x| |a| (|getShellEntry| $ 71))) + (SPADCALL |x| |a| (|getShellEntry| $ 74))) (DEFUN |URAGG-;concat;3A;28| (|x| |y| $) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 60)) |y| - (|getShellEntry| $ 73))) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 63)) |y| + (|getShellEntry| $ 76))) (DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| $) (SEQ (COND @@ -522,17 +531,17 @@ (|error| "setlast: empty list")) ('T (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 24)) |s| - (|getShellEntry| $ 67)) + (|getShellEntry| $ 70)) (EXIT |s|)))))) (DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $) (COND ((EQL (LENGTH |lv|) 1) - (SPADCALL |u| (|SPADfirst| |lv|) (|getShellEntry| $ 71))) + (SPADCALL |u| (|SPADfirst| |lv|) (|getShellEntry| $ 74))) ('T (|error| "wrong number of children specified")))) (DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| $) - (SPADCALL |u| |s| (|getShellEntry| $ 67))) + (SPADCALL |u| |s| (|getShellEntry| $ 70))) (DEFUN |URAGG-;split!;AIA;32| (|p| |n| $) (PROG (|q|) @@ -542,15 +551,15 @@ ('T (SEQ (LETT |p| (SPADCALL |p| - (LET ((#0=#:G1526 (- |n| 1))) + (LET ((#0=#:G1528 (- |n| 1))) (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 59)) + (|getShellEntry| $ 62)) |URAGG-;split!;AIA;32|) (LETT |q| (SPADCALL |p| (|getShellEntry| $ 14)) |URAGG-;split!;AIA;32|) - (SPADCALL |p| (SPADCALL (|getShellEntry| $ 81)) - (|getShellEntry| $ 71)) + (SPADCALL |p| (SPADCALL (|getShellEntry| $ 84)) + (|getShellEntry| $ 74)) (EXIT |q|)))))))) (DEFUN |URAGG-;cycleSplit!;2A;33| (|x| $) @@ -558,10 +567,10 @@ (RETURN (SEQ (COND ((OR (SPADCALL - (LETT |y| (SPADCALL |x| (|getShellEntry| $ 52)) + (LETT |y| (SPADCALL |x| (|getShellEntry| $ 55)) |URAGG-;cycleSplit!;2A;33|) (|getShellEntry| $ 20)) - (SPADCALL |x| |y| (|getShellEntry| $ 51))) + (SPADCALL |x| |y| (|getShellEntry| $ 54))) |y|) ('T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14)) @@ -569,7 +578,7 @@ (SEQ G190 (COND ((NULL (NOT (SPADCALL |z| |y| - (|getShellEntry| $ 51)))) + (|getShellEntry| $ 54)))) (GO G191))) (SEQ (LETT |x| |z| |URAGG-;cycleSplit!;2A;33|) (EXIT (LETT |z| @@ -577,14 +586,14 @@ (|getShellEntry| $ 14)) |URAGG-;cycleSplit!;2A;33|))) NIL (GO G190) G191 (EXIT NIL)) - (SPADCALL |x| (SPADCALL (|getShellEntry| $ 81)) - (|getShellEntry| $ 71)) + (SPADCALL |x| (SPADCALL (|getShellEntry| $ 84)) + (|getShellEntry| $ 74)) (EXIT |y|)))))))) (DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) (|dv$| (LIST '|UnaryRecursiveAggregate&| |dv$1| |dv$2|)) - ($ (|newShell| 85)) + ($ (|newShell| 88)) (|pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| '|shallowlyMutable|))))) (|setShellEntry| $ 0 |dv$|) @@ -594,35 +603,35 @@ (|setShellEntry| $ 7 |#2|) (COND ((|HasAttribute| |#1| '|finiteAggregate|) - (|setShellEntry| $ 61 + (|setShellEntry| $ 64 (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) $)))) (COND ((|HasCategory| |#2| '(|SetCategory|)) (PROGN - (|setShellEntry| $ 64 + (|setShellEntry| $ 67 (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) $)) - (|setShellEntry| $ 66 + (|setShellEntry| $ 69 (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) $))))) (COND ((|testBitVector| |pv$| 1) (PROGN - (|setShellEntry| $ 68 + (|setShellEntry| $ 71 (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) $)) - (|setShellEntry| $ 70 + (|setShellEntry| $ 73 (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) $)) - (|setShellEntry| $ 72 + (|setShellEntry| $ 75 (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) $)) - (|setShellEntry| $ 74 + (|setShellEntry| $ 77 (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) $)) - (|setShellEntry| $ 75 - (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $)) (|setShellEntry| $ 78 + (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $)) + (|setShellEntry| $ 81 (CONS (|dispatchFunction| |URAGG-;setchildren!;ALA;30|) $)) - (|setShellEntry| $ 79 - (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) $)) (|setShellEntry| $ 82 + (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) $)) + (|setShellEntry| $ 85 (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) $)) - (|setShellEntry| $ 83 + (|setShellEntry| $ 86 (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|) $))))) $)) @@ -641,57 +650,58 @@ (53 . |Zero|) (57 . >) (63 . |One|) (67 . |One|) (71 . -) |URAGG-;less?;ANniB;12| (77 . |zero?|) |URAGG-;more?;ANniB;13| |URAGG-;size?;ANniB;14| (82 . =) - (88 . |cyclic?|) |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| - (93 . |eq?|) (99 . |cycleEntry|) |URAGG-;cycleTail;2A;18| + (88 . |cyclic?|) (|PositiveInteger|) (93 . |One|) (97 . +) + |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| (103 . |eq?|) + (109 . |cycleEntry|) |URAGG-;cycleTail;2A;18| |URAGG-;cycleEntry;2A;19| |URAGG-;cycleLength;ANni;20| - |URAGG-;rest;ANniA;21| (104 . |#|) (109 . >) - (115 . |rest|) (121 . |copy|) (126 . |last|) - (132 . |true|) (136 . ~=) (142 . =) (148 . =) - (154 . |node?|) (160 . |setfirst!|) (166 . |setelt|) - (173 . |setlast!|) (179 . |setelt|) (186 . |setrest!|) - (192 . |setelt|) (199 . |concat!|) (205 . |concat|) - (211 . |setlast!|) (217 . |#|) (222 . |first|) - (227 . |setchildren!|) (233 . |setvalue!|) (239 . <) - (245 . |empty|) (249 . |split!|) (255 . |cycleSplit!|) + |URAGG-;rest;ANniA;21| (114 . |#|) (119 . >) + (125 . |rest|) (131 . |copy|) (136 . |last|) + (142 . |true|) (146 . ~=) (152 . =) (158 . =) + (164 . |node?|) (170 . |setfirst!|) (176 . |setelt|) + (183 . |setlast!|) (189 . |setelt|) (196 . |setrest!|) + (202 . |setelt|) (209 . |concat!|) (215 . |concat|) + (221 . |setlast!|) (227 . |#|) (232 . |first|) + (237 . |setchildren!|) (243 . |setvalue!|) (249 . <) + (255 . |empty|) (259 . |split!|) (265 . |cycleSplit!|) '"value") - '#(|value| 260 |third| 265 |tail| 270 |split!| 275 |size?| - 281 |setvalue!| 287 |setlast!| 293 |setelt| 299 - |setchildren!| 320 |second| 326 |rest| 331 |nodes| 337 - |node?| 342 |more?| 348 |less?| 354 |leaf?| 360 |last| 365 - |elt| 376 |cyclic?| 394 |cycleTail| 399 |cycleSplit!| 404 - |cycleLength| 409 |cycleEntry| 414 |concat| 419 |children| - 425 = 430 |#| 436) + '#(|value| 270 |third| 275 |tail| 280 |split!| 285 |size?| + 291 |setvalue!| 297 |setlast!| 303 |setelt| 309 + |setchildren!| 330 |second| 336 |rest| 341 |nodes| 347 + |node?| 352 |more?| 358 |less?| 364 |leaf?| 370 |last| 375 + |elt| 386 |cyclic?| 404 |cycleTail| 409 |cycleSplit!| 414 + |cycleLength| 419 |cycleEntry| 424 |concat| 429 |children| + 435 = 440 |#| 446) 'NIL (CONS (|makeByteWordVec2| 1 'NIL) (CONS '#() (CONS '#() - (|makeByteWordVec2| 83 + (|makeByteWordVec2| 86 '(1 6 7 0 8 1 6 7 0 11 1 6 0 0 14 1 6 19 0 20 0 19 0 21 1 19 0 0 22 1 6 0 0 24 0 26 0 27 2 26 0 6 0 28 1 26 0 0 29 0 35 0 36 0 37 0 38 2 37 19 0 0 39 0 35 0 40 0 37 0 41 2 37 0 0 0 42 1 37 19 0 44 2 35 19 0 0 47 1 6 19 0 48 - 2 6 19 0 0 51 1 6 0 0 52 1 6 35 0 57 - 2 35 19 0 0 58 2 6 0 0 35 59 1 6 0 0 - 60 2 0 0 0 35 61 0 19 0 62 2 7 19 0 0 - 63 2 0 19 0 0 64 2 6 19 0 0 65 2 0 19 - 0 0 66 2 6 7 0 7 67 3 0 7 0 9 7 68 2 - 6 7 0 7 69 3 0 7 0 12 7 70 2 6 0 0 0 - 71 3 0 0 0 15 0 72 2 6 0 0 0 73 2 0 0 - 0 0 74 2 0 7 0 7 75 1 26 35 0 76 1 26 - 6 0 77 2 0 0 0 30 78 2 0 7 0 7 79 2 - 37 19 0 0 80 0 6 0 81 2 0 0 0 37 82 1 - 0 0 0 83 1 0 7 0 34 1 0 7 0 18 1 0 0 - 0 50 2 0 0 0 37 82 2 0 19 0 35 46 2 0 - 7 0 7 79 2 0 7 0 7 75 3 0 7 0 12 7 70 - 3 0 0 0 15 0 72 3 0 7 0 9 7 68 2 0 0 - 0 30 78 1 0 7 0 17 2 0 0 0 35 56 1 0 - 30 0 31 2 0 19 0 0 66 2 0 19 0 35 45 - 2 0 19 0 35 43 1 0 19 0 33 2 0 0 0 35 - 61 1 0 7 0 25 2 0 7 0 12 13 2 0 0 0 - 15 16 2 0 7 0 9 10 1 0 19 0 23 1 0 0 - 0 53 1 0 0 0 83 1 0 35 0 55 1 0 0 0 - 54 2 0 0 0 0 74 1 0 30 0 32 2 0 19 0 - 0 64 1 0 35 0 49))))) + 0 49 0 50 2 35 0 0 0 51 2 6 19 0 0 54 + 1 6 0 0 55 1 6 35 0 60 2 35 19 0 0 61 + 2 6 0 0 35 62 1 6 0 0 63 2 0 0 0 35 + 64 0 19 0 65 2 7 19 0 0 66 2 0 19 0 0 + 67 2 6 19 0 0 68 2 0 19 0 0 69 2 6 7 + 0 7 70 3 0 7 0 9 7 71 2 6 7 0 7 72 3 + 0 7 0 12 7 73 2 6 0 0 0 74 3 0 0 0 15 + 0 75 2 6 0 0 0 76 2 0 0 0 0 77 2 0 7 + 0 7 78 1 26 35 0 79 1 26 6 0 80 2 0 0 + 0 30 81 2 0 7 0 7 82 2 37 19 0 0 83 0 + 6 0 84 2 0 0 0 37 85 1 0 0 0 86 1 0 7 + 0 34 1 0 7 0 18 1 0 0 0 53 2 0 0 0 37 + 85 2 0 19 0 35 46 2 0 7 0 7 82 2 0 7 + 0 7 78 3 0 7 0 12 7 73 3 0 0 0 15 0 + 75 3 0 7 0 9 7 71 2 0 0 0 30 81 1 0 7 + 0 17 2 0 0 0 35 59 1 0 30 0 31 2 0 19 + 0 0 69 2 0 19 0 35 45 2 0 19 0 35 43 + 1 0 19 0 33 2 0 0 0 35 64 1 0 7 0 25 + 2 0 7 0 12 13 2 0 0 0 15 16 2 0 7 0 9 + 10 1 0 19 0 23 1 0 0 0 56 1 0 0 0 86 + 1 0 35 0 58 1 0 0 0 57 2 0 0 0 0 77 1 + 0 30 0 32 2 0 19 0 0 67 1 0 35 0 52))))) '|lookupComplete|)) |