[ Home ]   [ Intro ]   [ Axiom ]   [ Lisp ]   [ Future 30 Years ]
[ Prev ]   [ Next ]

## ALGEBRA CODE IN LISP

### ANY.NRLIB/code.lsp

```
(/VERSIONCHECK 2)

(PUT (QUOTE |ANY;obj;\$N;1|) (QUOTE |SPADreplace|) (QUOTE QCDR))

(DEFUN |ANY;obj;\$N;1| (|x| \$) (QCDR |x|))

(PUT (QUOTE |ANY;dom;\$Se;2|) (QUOTE |SPADreplace|) (QUOTE QCAR))

(DEFUN |ANY;dom;\$Se;2| (|x| \$) (QCAR |x|))

(PUT (QUOTE |ANY;domainOf;\$Of;3|) (QUOTE |SPADreplace|) (QUOTE QCAR))

(DEFUN |ANY;domainOf;\$Of;3| (|x| \$) (QCAR |x|))

(DEFUN |ANY;=;2\$B;4| (|x| |y| \$)
(COND
((SPADCALL (QCAR |x|) (QCAR |y|) (QREFELT \$ 17)) (EQ (QCDR |x|) (QCDR |y|)))
((QUOTE T) (QUOTE NIL))))

(DEFUN |ANY;objectOf;\$Of;5| (|x| \$)

(DEFUN |ANY;showTypeInOutput;BS;6| (|b| \$)
(SEQ
(SETELT \$ 10 (SPADCALL |b| (QREFELT \$ 9)))
(EXIT
(COND
(|b| "Type of object will be displayed in output of a member of Any")
((QUOTE T)
"Type of object will not be displayed in output of a member of Any")))))

(DEFUN |ANY;coerce;\$Of;7| (|x| \$)
(PROG (|obj1| |p| |dom1| #0=#:G1442 |a| #1=#:G1443)
(RETURN
(SEQ
(LETT |obj1| (SPADCALL |x| (QREFELT \$ 24)) |ANY;coerce;\$Of;7|)
(COND
((NULL (SPADCALL (QREFELT \$ 10) (QREFELT \$ 26))) (EXIT |obj1|)))
(LETT |dom1| (SEQ (LETT |p| (|prefix2String| (|devaluate| (QCAR |x|))) |ANY;coerce;\$Of;7|) (EXIT (COND ((SPADCALL |p| (QREFELT \$ 27)) (SPADCALL |p| (QREFELT \$ 23))) ((QUOTE T) (SPADCALL |p| (QREFELT \$ 29)))))) |ANY;coerce;\$Of;7|)
(EXIT
(CONS |obj1|
(CONS ":"
(PROGN
(LETT #0# NIL |ANY;coerce;\$Of;7|)
(SEQ
(LETT |a| NIL |ANY;coerce;\$Of;7|)
(LETT #1# |dom1| |ANY;coerce;\$Of;7|)
G190
(COND
((OR (ATOM #1#) (PROGN (LETT |a| (CAR #1#) |ANY;coerce;\$Of;7|) NIL)) (GO G191)))
(SEQ
(EXIT
(LETT #0#
(CONS (SPADCALL |a| (QREFELT \$ 30)) #0#) |ANY;coerce;\$Of;7|)))
(LETT #1# (CDR #1#) |ANY;coerce;\$Of;7|)
(GO G190)
G191
(EXIT (NREVERSE0 #0#))))))
(QREFELT \$ 31)))))))

(DEFUN |ANY;any;SeN\$;8| (|domain| |object| \$)
(SEQ
(COND
((|isValidType| |domain|) (CONS |domain| |object|))
((QUOTE T)
(SEQ
(LETT |domain| (|devaluate| |domain|) |ANY;any;SeN\$;8|)
(EXIT
(COND
((|isValidType| |domain|) (CONS |domain| |object|))
((QUOTE T)
(|error| "function any must have a domain as first argument")))))))))

(DEFUN |Any| NIL
(PROG NIL
(RETURN
(PROG (#0=#:G1448)
(RETURN
(COND
((LETT #0# (HGET |\$ConstructorCache| (QUOTE |Any|)) |Any|)
(|CDRwithIncrement| (CDAR #0#)))
((QUOTE T)
(UNWIND-PROTECT
(PROG1
(CDDAR
(HPUT |\$ConstructorCache|
(QUOTE |Any|)
(LIST (CONS NIL (CONS 1 (|Any;|))))))
(LETT #0# T |Any|))
(COND
((NOT #0#) (HREM |\$ConstructorCache|
(QUOTE |Any|))))))))))))

(DEFUN |Any;| NIL
(PROG (|dv\$| \$ |pv\$|)
(RETURN
(PROGN
(LETT |dv\$| (QUOTE (|Any|)) . #0=(|Any|))
(LETT \$ (GETREFV 35) . #0#)
(QSETREFV \$ 0 |dv\$|)
(QSETREFV \$ 3 (LETT |pv\$| (|buildPredVector| 0 0 NIL) . #0#))
(|haddProp| |\$ConstructorCache| (QUOTE |Any|) NIL (CONS 1 \$))
(|stuffDomainSlots| \$)
(QSETREFV \$ 6 (|Record| (|:| |dm| (|SExpression|)) (|:| |ob| (|None|))))
(QSETREFV \$ 10 (SPADCALL (QUOTE NIL) (QREFELT \$ 9)))
\$))))

(MAKEPROP
(QUOTE |Any|)
(QUOTE |infovec|)
(LIST
(QUOTE #(NIL NIL NIL NIL NIL NIL (QUOTE |Rep|) (|Boolean|) (|Reference| 7)
(0 . |ref|) (QUOTE |printTypeInOutputP|) (|None|) |ANY;obj;\$N;1|
(|SExpression|) |ANY;dom;\$Se;2| (|OutputForm|) |ANY;domainOf;\$Of;3|
(5 . =) |ANY;=;2\$B;4| (|String|) (|Symbol|) (11 . |coerce|) (|List| 20)
(16 . |list|) |ANY;objectOf;\$Of;5| |ANY;showTypeInOutput;BS;6|
(21 . |deref|) (26 . |atom?|) (|List| \$) (31 . |list|) (36 . |coerce|)
(41 . |hconcat|) |ANY;coerce;\$Of;7| |ANY;any;SeN\$;8| (|SingleInteger|)))
(QUOTE #(~= 46 |showTypeInOutput| 52 |objectOf| 57 |obj| 62 |latex| 67
|hash| 72 |domainOf| 77 |dom| 82 |coerce| 87 |any| 92 = 98))
(QUOTE NIL)
(CONS
(|makeByteWordVec2| 1 (QUOTE (0 0 0)))
(CONS
(QUOTE #(|SetCategory&| |BasicType&| NIL))
(CONS
(QUOTE #((|SetCategory|) (|BasicType|) (|CoercibleTo| 15)))
(|makeByteWordVec2| 34
(QUOTE (1 8 0 7 9 2 13 7 0 0 17 1 20 0 19 21 1 22 0 20 23 1 8 7 0 26
1 13 7 0 27 1 20 28 0 29 1 20 15 0 30 1 15 0 28 31 2 0 7 0 0
1 1 0 19 7 25 1 0 15 0 24 1 0 11 0 12 1 0 19 0 1 1 0 34 0 1
1 0 15 0 16 1 0 13 0 14 1 0 15 0 32 2 0 0 13 11 33 2 0 7 0
0 18))))))
(QUOTE |lookupComplete|)))

(MAKEPROP (QUOTE |Any|) (QUOTE NILADIC) T)
```