home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
clisp
/
src
/
archive
/
clisp.faslsp.lha
/
macros2.fas
< prev
next >
Wrap
Text File
|
1996-06-17
|
15KB
|
305 lines
(SYSTEM::VERSION '(SYSTEM::CLISP2 13. LISP:T 130695.))
#Y(#:TOP-LEVEL-FORM-1 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "SYSTEM")
#Y(#:TOP-LEVEL-FORM-2
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) TYPECASE
REMOVE-OLD-DEFINITIONS MACRO
#Y(TYPECASE
#126Y(00 01 00 01 00 08 AC 71 48 D8 8F 01 2F 0F 9D 5B 77 9E 5B 78 37 01
71 90 62 AC 1A 80 4C AC 2E 01 19 03 DA DB DC DD 6D 03 06 DF 93 03
32 02 1F AA CB 59 16 01 1C 1E 63 9C 5A 5B 1B 01 CC 79 83 01 16 01
1A 2A 9B 5A 1F 5A 9B 5A 77 AA 02 59 1C 5F 16 01 1B 62 E2 AD E3 9E
5A 77 7A 02 7A 03 9C 5A 5B 1B 01 CF 79 83 01 82 00 9B 20 58 16 01
E5 AC AF 7A 02 7A 01 E6 AD 31 4A 79 60 03 19 07
)
2. MACRO-CALL-ERROR PROGRAM-ERROR "Invalid clause in ~S: ~S"
"Unzulässige Klausel in ~S: ~S" "Clause inadmissible dans ~S : ~S"
LANGUAGE TYPECASE OTHERWISE (NIL) TYPEP QUOTE (NIL) LET COND
) )
#Y(#:TOP-LEVEL-FORM-3
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) CHECK-TYPE
REMOVE-OLD-DEFINITIONS MACRO
#Y(CHECK-TYPE
#119Y(00 01 00 01 00 08 D8 AD 71 48 D9 90 02 31 80 5A 9D 5B 77 9E 5B 5B
77 9F 5B 5B 5B 1B 80 51 00 14 37 01 71 90 37 01 71 90 DB AC DC DD
B2 DE B3 7A 02 7A 03 DF AF 7A 02 7A 03 E0 E1 E2 62 E3 E4 E5 6D 03
0E B6 B5 B7 6D 05 0F B5 7A 05 E8 62 E9 EA EB 6D 03 0E B5 6D 03 0F
D7 7B 02 ED B4 03 16 7B 02 DF B2 7A 02 B1 60 08 19 08 AC 2E 02 19
03 9F 5B 5B 5B 5A 1A FF A8
)
3. 4. MACRO-CALL-ERROR TAGBODY WHEN TYPEP QUOTE GO CERROR
(LANGUAGE "You may input a new value."
"Sie dürfen einen neuen Wert eingeben."
"Vous avez l'occasion d'entrer une nouvelle valeur."
)
(LANGUAGE "~A~%The value is: ~S" "~A~%Der Wert ist: ~S"
"~A~%La valeur est : ~S"
)
"The value of ~S should be ~:[of type ~S~;~:*~A~]."
"Der Wert von ~S sollte ~:[vom Typ ~S~;~:*~A~] sein."
"La valeur de ~S devrait être ~:[de type ~S~;~:*~A~]." LANGUAGE FORMAT
WRITE-STRING "~%New ~S: " "~%Neues ~S: " "~%Nouveau ~S : " (*QUERY-IO*)
SETF ((READ *QUERY-IO*))
) )
#Y(#:TOP-LEVEL-FORM-4
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) ASSERT
REMOVE-OLD-DEFINITIONS MACRO
#Y(ASSERT
#188Y(00 01 00 01 00 08 AC 71 48 D8 8F 01 2F 80 57 9D 5B 77 9E 5B 5B 1B
80 53 00 14 9F 5B 5B 5B 1B 80 51 00 14 A0 5B 5B 5B 78 37 01 71 90
37 01 71 90 DA AC DB B2 DC AF 7A 02 7A 03 DD B2 71 48 AA 23 06 38
AA 23 08 37 CD F6 E3 91 09 01 CF 14 7A 02 91 09 2D 62 E5 E6 E7 6D
03 10 B7 6D 03 11 60 01 7B 03 62 B3 1A 3F AC 2E 01 19 03 9E 5B 5B
5A 1A FF A7 9F 5B 5B 5B 5A 1A FF A8 CA 1A 4A CC 1A 47 A3 1A 5D 93
00 EA 62 EB EC ED 6D 03 10 AD 6D 03 11 03 16 7B 02 EF AC 03 18 7B
02 7A 02 AD 7F A6 02 16 01 82 00 9B 20 5B 16 01 AA 7F A7 00 DC B1
7A 02 B0 7A 02 32 02 23 61 04 19 09
)
2. MACRO-CALL-ERROR TAGBODY WHEN GO CERROR 0.
(LANGUAGE "Retry" "Neuer Anlauf" "Reéssayer") 1.
(LANGUAGE "You may input a new value."
"Sie dürfen einen neuen Wert eingeben."
"Vous pouvez entrer une nouvelle valeur."
)
(LANGUAGE "You may input new values." "Sie dürfen neue Werte eingeben."
"Vous pouvez entrer de nouvelles valeurs."
)
QUOTE "~A" "~S must evaluate to a non-NIL value."
"Der Wert von ~S darf nicht NIL sein."
"La valeur de ~S ne peut pas être NIL." LANGUAGE FORMAT WRITE-STRING
"~%New ~S: " "~%Neues ~S: " "~%Nouveau ~S : " (*QUERY-IO*) SETF
((READ *QUERY-IO*))
) )
#Y(#:TOP-LEVEL-FORM-5
#45Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 DC 2E 01 DC DA C8 79 31 82
DE 2E 01 DE DA CA 79 31 82 E0 2E 01 E0 DA CC 79 31 82 CB 19 01
)
ETYPECASE REMOVE-OLD-DEFINITIONS MACRO
#Y(ETYPECASE
#39Y(00 01 00 01 00 08 AC 71 48 D8 8F 01 2F 14 9D 5B 77 9E 5B 78 DA AC AC
AE AE C6 73 AE C7 73 C8 33 19 05 AC 2E 01 19 03
)
2. MACRO-CALL-ERROR TYPECASE
#1=#Y(TYPECASE-ERRORSTRING
#25Y(00 02 00 00 00 03 D8 AC 72 00 17 62 D9 DA DB 6D 03 04 AF AD 2C
04 05 19 04
)
#.#'FIRST "The value of ~S must be of one of the types ~{~S~^, ~}"
"Der Wert von ~S muß einem der Typen ~{~S~^, ~} angehören."
"La valeur de ~S doit appartenir à l'un des types ~{~S~^, ~}."
LANGUAGE FORMAT
)
#Y(TYPECASE-EXPECTED-TYPE
#15Y(00 01 00 00 00 02 D8 D9 AD 32 00 17 5C 19 02) OR #.#'FIRST
)
#2=#Y(SIMPLY-ERROR
#48Y(00 05 00 00 00 06 37 01 71 90 D8 AB B1 7A 02 7A 01 B2 AD B2 D9
DA DB DC B3 DD DE B8 7A 02 DF BA B8 7A 09 7A 02 7A 01 32 02 23
7B 02 60 03 19 07
)
LET OTHERWISE ERROR-OF-TYPE 'TYPE-ERROR :DATUM :EXPECTED-TYPE QUOTE
(LANGUAGE "~A~%The value is: ~S" "~A~%Der Wert ist: ~S"
"~A~%La valeur est : ~S"
) ))
CTYPECASE
#Y(CTYPECASE
#36Y(00 01 00 01 00 08 AC 71 48 D8 8F 01 2F 11 9D 5B 77 9E 5B 78 DA AC AC
AE AE C6 73 C7 33 19 05 AC 2E 01 19 03
)
2. MACRO-CALL-ERROR TYPECASE #1#
#3=#Y(RETRY-LOOP
#72Y(00 04 00 00 00 05 37 01 71 90 37 01 71 90 D8 AC D9 AD DA B0 B6
B6 B6 DB DC DD DE BA BD 7A 05 DF 62 E0 E1 E2 6D 03 0B BD 6D 03
0C D0 7B 02 E6 BC D2 7B 02 E8 B8 7A 02 7A 05 7A 01 32 02 23 7B
02 7A 03 7A 03 60 03 19 07
)
BLOCK TAGBODY RETURN-FROM OTHERWISE CERROR
(LANGUAGE "You may input a new value."
"Sie dürfen einen neuen Wert eingeben."
"Vous pouvez entrer une nouvelle valeur."
)
(LANGUAGE "~A~%The value is: ~S" "~A~%Der Wert ist: ~S"
"~A~%La valeur est : ~S"
)
WRITE-STRING "~%New ~S: " "~%Neues ~S: " "~%Nouveau ~S : " LANGUAGE
FORMAT (*QUERY-IO*) SETF ((READ *QUERY-IO*)) GO
) )
ECASE
#Y(ECASE
#39Y(00 01 00 01 00 08 AC 71 48 D8 8F 01 2F 14 9D 5B 77 9E 5B 78 DA AC AC
AE AE C6 73 AE C7 73 C8 33 19 05 AC 2E 01 19 03
)
2. MACRO-CALL-ERROR CASE
#4=#Y(CASE-ERRORSTRING
#58Y(00 02 00 00 00 03 62 AC 1A 19 9B 1A 0D 93 00 AA 86 00 00 14 8D
0D 73 AA 60 01 F6 AD 7F A5 02 16 01 82 00 9B 20 67 16 01 AA 7F
A7 00 62 D8 D9 DA 6D 03 03 AF AD 2C 04 04 19 04
)
"The value of ~S must be one of ~{~S~^, ~}"
"Der Wert von ~S muß einer der folgenden sein: ~{~S~^, ~}"
"La valeur de ~S doit être l'une des suivantes : ~{~S~^, ~}"
LANGUAGE FORMAT
)
#Y(CASE-EXPECTED-TYPE
#49Y(00 01 00 00 00 02 D8 62 AD 1A 19 9B 1A 0D 93 00 AA 86 00 00 14 8D
0D 73 AA 60 01 F6 AD 7F A5 02 16 01 82 00 9B 20 67 16 01 AA 30 A7
16 01 5C 19 02
)
MEMBER
)
#2#
)
CCASE
#Y(CCASE
#36Y(00 01 00 01 00 08 AC 71 48 D8 8F 01 2F 11 9D 5B 77 9E 5B 78 DA AC AC
AE AE C6 73 C7 33 19 05 AC 2E 01 19 03
)
2. MACRO-CALL-ERROR CASE #4# #3#
) )
#Y(#:TOP-LEVEL-FORM-6
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) DEFTYPE
REMOVE-OLD-DEFINITIONS MACRO
#Y(DEFTYPE
#223Y(00 01 00 01 00 08 3C 01 AC 71 48 D8 8F 01 2F 29 9D 5B 77 9E 5B 5B
77 9F 5B 5B 78 AC 8E 08 1F AC DF 37 01 8D 84 07 AC E0 37 01 8E 84
17 DA E1 E2 CE 14 6D 03 06 AE 32 01 1F AC 2E 01 19 03 DA DB DC C8
1A 6D AA 63 B0 30 62 41 03 92 01 06 E4 9D 79 60 01 F7 D0 10 0E D0
10 0F 00 10 10 00 10 11 00 10 12 D6 10 14 C0 ED 65 19 EE 2C 04 17
EE 6E 18 F1 6A 11 71 4A C0 6A 12 71 4A 65 19 32 03 23 7B 02 92 01
07 F2 AC F3 AD 60 04 F6 F4 F5 64 1E 62 64 1F 64 20 65 1F 7A 02 64
21 64 22 64 23 65 22 70 4E 72 02 13 70 CE 64 24 64 25 64 26 65 25
B7 7A 03 7A 03 7A 03 7A 04 64 27 64 28 64 20 65 21 7A 02 03 29 7B
02 64 20 65 1C 7A 02 7A 03 64 20 65 20 7A 02 7A 05 60 03 16 02 12
06 19 09
)
3. MACRO-CALL-ERROR PROGRAM-ERROR "type name should be a symbol, not ~S"
"Typname muß ein Symbol sein, nicht ~S"
"Le type doit être un symbole et non ~S" LANGUAGE TYPE-SYMBOL TYPE-LIST
"~S is a built-in type and may not be redefined."
"~S ist ein eingebauter Typ und darf nicht umdefiniert werden."
"~S est un type prédéfini et ne peut pas être redéfini." DECLARE 0.
%ARG-COUNT %MIN-ARGS %RESTP %LET-LIST %KEYWORD-TESTS '* %DEFAULT-FORM
(CDR <DEFTYPE-FORM>) <DEFTYPE-FORM> ANALYZE1 MAKE-LENGTH-TEST LET* IF
(TYPE-CALL-ERROR <DEFTYPE-FORM>) EVAL-WHEN (COMPILE LOAD EVAL) LET %PUT
QUOTE 'DEFTYPE-EXPANDER FUNCTION "DEFTYPE-" LAMBDA (<DEFTYPE-FORM>) BLOCK
SETF DOCUMENTATION ('TYPE)
) )
#Y(#:TOP-LEVEL-FORM-7 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
TYPE-CALL-ERROR REMOVE-OLD-DEFINITIONS
#Y(TYPE-CALL-ERROR
#23Y(00 01 00 00 00 02 D8 D9 DA DB 6D 03 04 93 03 AE 71 48 71 98 32 02 1F
)
ERROR "The deftype expander for ~S may not be called with ~S arguments."
"Der Deftype-Expander für ~S kann nicht mit ~S Argumenten aufgerufen werden."
"L'«expandeur» de DEFTYPE pour ~S ne peut pas être appelé avec ~S arguments."
LANGUAGE
) )
#Y(#:TOP-LEVEL-FORM-8
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) TIME
REMOVE-OLD-DEFINITIONS MACRO
#Y(TIME
#77Y(00 01 00 01 00 08 AC 71 48 D8 8F 01 2E 3A 9D 5B 77 37 01 71 90 37 01
71 90 37 01 71 90 37 01 71 90 37 01 71 90 37 01 71 90 37 01 71 90 37
01 71 90 37 01 71 90 7A 09 DA AB DB DC AF DD DE DF A3 7B 03 7A 03 60
04 19 05 AC 2E 01 19 03
)
2. MACRO-CALL-ERROR MULTIPLE-VALUE-BIND (%%TIME) UNWIND-PROTECT
MULTIPLE-VALUE-CALL #'%TIME (%%TIME)
) )
#Y(#:TOP-LEVEL-FORM-9
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01)
WITH-INPUT-FROM-STRING REMOVE-OLD-DEFINITIONS MACRO
#Y(WITH-INPUT-FROM-STRING
#194Y(00 01 00 01 00 08 3C 01 AC 71 48 D8 8F 01 2F 80 80 9D 5B 5A 77 9E
5B 5A 5B 77 9F 5B 5A 5B 78 AA DA 6A 03 71 85 AA 0E 03 21 80 6B 02
14 AC DC 6A 03 71 85 AA 0E 03 21 80 62 02 14 AE DE 6A 03 71 85 AA
0E 03 21 80 5A 02 14 A6 5B 78 B1 DF 30 63 AA 62 B7 30 62 41 02 92
00 06 E0 9C 79 60 01 F6 E1 B6 E2 B7 91 09 80 44 91 07 80 40 00 7B
02 7A 02 7A 01 AC E3 E4 A1 79 91 0C 3A 00 14 E7 BC 7A 02 7A 01 32
02 23 7B 02 7A 01 32 02 23 61 02 19 0F AC 2E 01 19 03 7C 00 1A FF
91 C8 F6 00 1A FF 99 7C 00 1A FF A2 B3 60 01 5C 1A 41 B4 91 08 76
00 5C 1A FF B8 E5 B8 E6 BD 7A 02 7A 03 60 01 1A FF BA
)
2. MACRO-CALL-ERROR :INDEX MACRO-MISSING-VALUE :START 0. :END
(:END :START :INDEX) DECLARE LET MAKE-STRING-INPUT-STREAM UNWIND-PROTECT
PROGN SETF STRING-INPUT-STREAM-INDEX CLOSE
) )
#Y(#:TOP-LEVEL-FORM-10
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) WITH-OPEN-FILE
REMOVE-OLD-DEFINITIONS MACRO
#Y(WITH-OPEN-FILE
#94Y(00 01 00 01 00 08 3C 01 AC 71 48 D8 8F 01 2F 80 48 9D 5B 5A 77 9E 5B
5A 78 9F 5B 78 AA 62 B0 30 62 41 02 92 00 06 DA 9C 79 60 01 F6 DB AF
DC A1 79 7A 02 7A 01 AC DD DE DF A2 79 E0 B5 E1 B7 7A 02 7A 03 7A 03
E0 B4 E1 B6 CD 7B 02 7A 03 7A 03 7A 01 32 02 23 61 02 19 08 AC 2E 01
19 03
)
2. MACRO-CALL-ERROR DECLARE LET OPEN UNWIND-PROTECT MULTIPLE-VALUE-PROG1
PROGN WHEN CLOSE (:ABORT T)
) )
#Y(#:TOP-LEVEL-FORM-11
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) WITH-OPEN-STREAM
REMOVE-OLD-DEFINITIONS MACRO
#Y(WITH-OPEN-STREAM
#84Y(00 01 00 01 00 08 3C 01 AC 71 48 D8 8F 01 2F 3F 9D 5B 5A 77 9E 5B 5A
5B 77 9F 5B 78 AA 62 B0 30 62 41 02 92 00 06 DA 9C 79 60 01 F6 DB AF
AF 7A 02 7A 01 AC DC DD DE A2 79 DF B5 7A 02 7A 03 DF B4 CB 7B 02 7A
03 7A 01 32 02 23 61 02 19 08 AC 2E 01 19 03
)
2. MACRO-CALL-ERROR DECLARE LET UNWIND-PROTECT MULTIPLE-VALUE-PROG1 PROGN
CLOSE (:ABORT T)
) )
#Y(#:TOP-LEVEL-FORM-12
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01)
WITH-OUTPUT-TO-STRING REMOVE-OLD-DEFINITIONS MACRO
#Y(WITH-OUTPUT-TO-STRING
#129Y(00 01 00 01 00 08 3C 01 AC 71 48 D8 8F 01 2F 80 48 9D 5B 5A 77 9E
5B 5A 5B 1B 80 42 00 14 9F 5B 5A 5B 58 58 14 A0 5B 78 AA 62 B1 30
62 41 02 91 00 34 91 03 3A DB B0 CB 79 7A 01 AC DD DE B0 E1 B6 7A
02 7A 01 32 02 23 79 CA 14 B5 7A 02 7A 03 7A 01 32 02 23 61 02 19
09 AC 2E 01 19 03 9E 5B 5A 5B 5A 1A FF B7 DA 9C 79 60 01 F6 92 03
46 DB B0 DC B1 7A 02 7A 02 7A 01 AC DD DE A1 79 CA 1A 49
)
2. MACRO-CALL-ERROR DECLARE LET MAKE-STRING-PUSH-STREAM UNWIND-PROTECT
PROGN CLOSE ((MAKE-STRING-OUTPUT-STREAM)) GET-OUTPUT-STREAM-STRING
) )
#Y(#:TOP-LEVEL-FORM-13 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "LISP")
#Y(#:TOP-LEVEL-FORM-14 #13Y(00 00 00 00 00 01 D8 37 01 30 DA 19 01)
WITH-OUTPUT-TO-PRINTER
)
#Y(#:TOP-LEVEL-FORM-15 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "SYSTEM")
#Y(#:TOP-LEVEL-FORM-16
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01)
WITH-OUTPUT-TO-PRINTER REMOVE-OLD-DEFINITIONS MACRO
#Y(WITH-OUTPUT-TO-PRINTER
#70Y(00 01 00 01 00 08 3C 01 AC 71 48 D8 8F 01 2F 31 9D 5B 5A 77 9E 5B 78
AA 62 AF 30 62 41 02 92 00 06 DA 9C 79 60 01 F6 DB AE C7 79 7A 01 AC
DD DE A1 79 DF B3 7A 02 7A 03 7A 01 32 02 23 61 02 19 07 AC 2E 01 19
03
)
2. MACRO-CALL-ERROR DECLARE LET ((MAKE-PRINTER-STREAM)) UNWIND-PROTECT
PROGN CLOSE
) )
#Y(#:TOP-LEVEL-FORM-17 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "LISP")
#Y(#:TOP-LEVEL-FORM-18 #13Y(00 00 00 00 00 01 D8 37 01 30 DA 19 01)
WITHOUT-FLOATING-POINT-UNDERFLOW
)
#Y(#:TOP-LEVEL-FORM-19 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "SYSTEM")
#Y(#:TOP-LEVEL-FORM-20
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01)
WITHOUT-FLOATING-POINT-UNDERFLOW REMOVE-OLD-DEFINITIONS MACRO
#Y(WITHOUT-FLOATING-POINT-UNDERFLOW
#17Y(00 01 00 01 00 08 94 02 D8 D9 DA 9E 79 60 03 19 04) LET
((*INHIBIT-FLOATING-POINT-UNDERFLOW* T)) PROGN
) )
#Y(#:TOP-LEVEL-FORM-21 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "LISP")
#Y(#:TOP-LEVEL-FORM-22 #13Y(00 00 00 00 00 01 D8 37 01 30 DA 19 01)
LANGUAGE-CASE
)
#Y(#:TOP-LEVEL-FORM-23 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "SYSTEM")
#Y(#:TOP-LEVEL-FORM-24
#18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) LANGUAGE-CASE
REMOVE-OLD-DEFINITIONS MACRO
#Y(LANGUAGE-CASE #15Y(00 01 00 01 00 08 94 02 D8 D9 9D 61 02 19 04) CASE
(DEUTSCH 'DEUTSCH ENGLISH 'ENGLISH FRANCAIS 'FRANCAIS)
) )