home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / D / CLISP / CLISPSRC.TAR / clisp-1995-01-01 / src / defs3.lsp < prev    next >
Encoding:
Text File  |  1994-10-17  |  14.5 KB  |  285 lines
  1. ;;; CLtL2-kompatible Definitionen
  2. ;;; Bruno Haible 6.12.1993
  3.  
  4. ;===============================================================================
  5.  
  6. (defpackage "COMMON-LISP"
  7.   (:nicknames "CL")
  8.   (:use "LISP" "CLOS")
  9.   (:shadow "MAKE-PACKAGE" "FLET" "LABELS" "MACROLET")
  10. )
  11.  
  12. (in-package "COMMON-LISP")
  13.  
  14. ;;; Exportierungen:
  15. ;; Nur in ANSI Common Lisp (CLtL2 bzw. dpANS) explizit erwΣhnte Symbole!
  16. (export '(
  17. ;; Typen:
  18. array atom bignum bit bit-vector character common compiled-function
  19. complex cons double-float fixnum float function hash-table integer keyword
  20. list #+LOGICAL-PATHNAMES logical-pathname long-float nil null number package
  21. pathname random-state ratio rational readtable real sequence short-float
  22. simple-array simple-bit-vector simple-string simple-vector single-float
  23. standard-char stream string string-char symbol t vector satisfies values mod
  24. signed-byte unsigned-byte restart condition warning serious-condition error
  25. simple-condition simple-warning simple-error storage-condition type-error
  26. simple-type-error program-error control-error package-error stream-error
  27. end-of-file file-error cell-error unbound-variable undefined-function
  28. arithmetic-error division-by-zero floating-point-overflow
  29. floating-point-underflow
  30. ;; Klassen:
  31. built-in-class standard-class standard-generic-function standard-method
  32. standard-object structure-class
  33. ;; Konstanten:
  34. lambda-list-keywords lambda-parameters-limit nil t call-arguments-limit
  35. multiple-values-limit pi boole-clr boole-set boole-1 boole-2 boole-c1 boole-c2
  36. boole-and boole-ior boole-xor boole-eqv boole-nand boole-nor boole-andc1
  37. boole-andc2 boole-orc1 boole-orc2 most-positive-fixnum most-negative-fixnum
  38. most-positive-short-float least-positive-short-float least-negative-short-float
  39. most-negative-short-float most-positive-single-float
  40. least-positive-single-float least-negative-single-float
  41. most-negative-single-float most-positive-double-float
  42. least-positive-double-float least-negative-double-float
  43. most-negative-double-float most-positive-long-float least-positive-long-float
  44. least-negative-long-float most-negative-long-float
  45. least-positive-normalized-short-float least-negative-normalized-short-float
  46. least-positive-normalized-single-float least-negative-normalized-single-float
  47. least-positive-normalized-double-float least-negative-normalized-double-float
  48. least-positive-normalized-long-float least-negative-normalized-long-float
  49. short-float-epsilon single-float-epsilon double-float-epsilon
  50. long-float-epsilon short-float-negative-epsilon single-float-negative-epsilon
  51. double-float-negative-epsilon long-float-negative-epsilon
  52. char-code-limit char-font-limit char-bits-limit char-control-bit char-meta-bit
  53. char-super-bit char-hyper-bit array-rank-limit array-dimension-limit
  54. array-total-size-limit internal-time-units-per-second
  55. ;; Variablen:
  56. *macroexpand-hook* *package* *modules* *random-state* *evalhook* *applyhook*
  57. + ++ +++ - * ** *** / // /// *standard-input* *standard-output* *error-output*
  58. *query-io* *debug-io* *terminal-io* *trace-output* *read-base* *read-suppress*
  59. *readtable* *print-readably* *print-escape* *print-pretty* *print-circle*
  60. *print-base* *print-radix* *print-case* *print-gensym* *print-level*
  61. *print-length* *print-array* *read-default-float-format*
  62. *default-pathname-defaults* *load-verbose* *load-print* *load-pathname*
  63. *load-truename* *break-on-warnings* *compile-verbose* *compile-print*
  64. *compile-file-pathname* *compile-file-truename* *features* *break-on-signals*
  65. *debugger-hook*
  66. ;; Funktionen:
  67. coerce type-of upgraded-array-element-type typep subtypep null symbolp
  68. atom consp listp numberp integerp rationalp floatp realp complexp characterp
  69. stringp bit-vector-p vectorp simple-vector-p simple-string-p
  70. simple-bit-vector-p arrayp packagep functionp compiled-function-p commonp eq
  71. eql equal equalp not symbol-value symbol-function fdefinition boundp fboundp
  72. special-form-p set makunbound fmakunbound get-setf-method
  73. get-setf-method-multiple-value apply funcall mapcar maplist mapc mapl mapcan
  74. mapcon values values-list macro-function macroexpand macroexpand-1 proclaim
  75. get remprop symbol-plist getf get-properties symbol-name make-symbol
  76. copy-symbol gensym gentemp symbol-package keywordp make-package in-package
  77. find-package package-name package-nicknames rename-package package-use-list
  78. package-used-by-list package-shadowing-symbols list-all-packages intern
  79. find-symbol unintern export unexport import shadowing-import shadow
  80. use-package unuse-package find-all-symbols provide require zerop plusp minusp
  81. oddp evenp = /= < > <= >= max min + - * / 1+ 1- conjugate gcd lcm exp expt
  82. log sqrt isqrt abs phase signum sin cos tan cis asin acos atan sinh cosh tanh
  83. asinh acosh atanh float rational rationalize numerator denominator floor
  84. ceiling truncate round mod rem ffloor fceiling ftruncate fround decode-float
  85. scale-float float-radix float-sign float-digits float-precision
  86. integer-decode-float complex realpart imagpart logior logxor logand logeqv
  87. lognand lognor logandc1 logandc2 logorc1 logorc2 boole lognot logtest logbitp
  88. ash logcount integer-length byte byte-size byte-position ldb ldb-test mask-field
  89. dpb deposit-field random make-random-state random-state-p standard-char-p
  90. graphic-char-p string-char-p alpha-char-p upper-case-p lower-case-p
  91. both-case-p digit-char-p alphanumericp char= char/= char< char> char<= char>=
  92. char-equal char-not-equal char-lessp char-greaterp char-not-greaterp
  93. char-not-lessp char-code char-bits char-font code-char make-char character
  94. char-upcase char-downcase digit-char char-int int-char char-name name-char
  95. char-bit set-char-bit elt subseq copy-seq length reverse nreverse
  96. make-sequence concatenate map map-into some every notany notevery reduce fill
  97. replace remove remove-if remove-if-not delete delete-if delete-if-not
  98. remove-duplicates delete-duplicates substitute substitute-if
  99. substitute-if-not nsubstitute nsubstitute-if nsubstitute-if-not find find-if
  100. find-if-not position position-if position-if-not count count-if count-if-not
  101. mismatch search sort stable-sort merge car cdr caar cadr cdar cddr caaar
  102. caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar
  103. cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
  104. cons tree-equal endp list-length nth first second third fourth fifth sixth
  105. seventh eighth ninth tenth rest nthcdr last list list* make-list append
  106. copy-list copy-alist copy-tree revappend nconc nreconc butlast nbutlast ldiff
  107. rplaca rplacd subst subst-if subst-if-not nsubst nsubst-if nsubst-if-not sublis
  108. nsublis member member-if member-if-not tailp adjoin union nunion intersection
  109. nintersection set-difference nset-difference set-exclusive-or
  110. nset-exclusive-or subsetp acons pairlis assoc assoc-if assoc-if-not rassoc
  111. rassoc-if rassoc-if-not make-hash-table hash-table-p gethash remhash maphash
  112. clrhash hash-table-count sxhash make-array vector aref svref
  113. array-element-type array-rank array-dimension array-dimensions
  114. array-total-size array-in-bounds-p array-row-major-index adjustable-array-p
  115. bit sbit bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor bit-andc1 bit-andc2
  116. bit-orc1 bit-orc2 bit-not array-has-fill-pointer-p fill-pointer vector-push
  117. vector-push-extend vector-pop adjust-array char schar string= string-equal
  118. string< string> string<= string>= string/= string-lessp string-greaterp
  119. string-not-greaterp string-not-lessp string-not-equal make-string string-trim
  120. string-left-trim string-right-trim string-upcase string-downcase
  121. string-capitalize nstring-upcase nstring-downcase nstring-capitalize string
  122. eval evalhook applyhook constantp make-synonym-stream make-broadcast-stream
  123. make-concatenated-stream make-two-way-stream make-echo-stream
  124. make-string-input-stream make-string-output-stream get-output-stream-string
  125. streamp input-stream-p output-stream-p stream-element-type interactive-stream-p
  126. close copy-readtable readtablep set-syntax-from-char set-macro-character
  127. get-macro-character make-dispatch-macro-character
  128. set-dispatch-macro-character get-dispatch-macro-character readtable-case
  129. read read-preserving-whitespace read-delimited-list read-line read-char
  130. unread-char peek-char listen read-char-no-hang clear-input read-from-string
  131. parse-integer read-byte write prin1 print pprint princ write-to-string
  132. prin1-to-string princ-to-string write-char write-string write-line terpri
  133. fresh-line finish-output force-output clear-output write-byte format y-or-n-p
  134. yes-or-no-p wild-pathname-p pathname-match-p translate-pathname
  135. #+LOGICAL-PATHNAMES logical-pathname
  136. #+LOGICAL-PATHNAMES translate-logical-pathname
  137. #+LOGICAL-PATHNAMES logical-pathname-translations
  138. #+LOGICAL-PATHNAMES load-logical-pathname-translations
  139. compile-file-pathname pathname truename parse-namestring merge-pathnames
  140. make-pathname pathnamep pathname-host pathname-device pathname-directory
  141. pathname-name pathname-type pathname-version namestring file-namestring
  142. directory-namestring host-namestring enough-namestring user-homedir-pathname
  143. open rename-file delete-file probe-file file-write-date file-author
  144. file-position file-length load directory error cerror warn break compile
  145. compile-file disassemble function-lambda-expression
  146. documentation  variable structure type ; drei Dokumentations-Typen
  147. describe describe-object inspect room ed dribble apropos apropos-list
  148. get-decoded-time get-universal-time decode-universal-time encode-universal-time
  149. get-internal-run-time get-internal-real-time sleep lisp-implementation-type
  150. lisp-implementation-version machine-type machine-version machine-instance
  151. software-type software-version short-site-name long-site-name identity
  152. add-method call-next-method class-name class-of compute-applicable-methods
  153. find-class find-method function-keywords initialize-instance make-instance
  154. method-qualifiers next-method-p no-applicable-method no-next-method
  155. print-object reinitialize-instance remove-method shared-initialize slot-boundp
  156. slot-exists-p slot-makunbound slot-missing slot-unbound slot-value
  157. signal make-condition compute-restarts restart-name find-restart invoke-restart
  158. invoke-restart-interactively abort continue muffle-warning store-value
  159. use-value invoke-debugger simple-condition-format-string
  160. simple-condition-format-arguments type-error-datum type-error-expected-type
  161. package-error-package stream-error-stream file-error-pathname cell-error-name
  162. arithmetic-error-operation arithmetic-error-operands
  163. ;; Special-forms:
  164. eval-when quote function setq progn let let* locally compiler-let progv flet
  165. labels macrolet symbol-macrolet if block return-from tagbody go
  166. multiple-value-call multiple-value-prog1 catch unwind-protect throw declare
  167. the load-time-value
  168. ;; Macros:
  169. deftype defun defvar defparameter defconstant and or psetq setf psetf shiftf
  170. rotatef define-modify-macro defsetf define-setf-method prog1 prog2
  171. when unless cond
  172. case typecase  otherwise ; otherwise als Marker fⁿr die catchall-clause
  173. return loop do do* dolist dotimes prog prog* multiple-value-list
  174. multiple-value-bind multiple-value-setq nth-value defmacro destructuring-bind
  175. declaim remf defpackage do-symbols do-external-symbols do-all-symbols incf decf
  176. push pushnew pop defstruct with-open-stream with-input-from-string
  177. with-output-to-string print-unreadable-object with-open-file check-type assert
  178. etypecase ctypecase ecase ccase trace untrace step time
  179. loop-finish
  180. defclass defgeneric defmethod generic-flet generic-function generic-labels
  181. with-accessors with-slots
  182. check-type assert etypecase ctypecase ecase ccase handler-case ignore-errors
  183. handler-bind define-condition with-simple-restart restart-case restart-bind
  184. with-condition-restarts
  185. ;; sonstige Markierer:
  186. lambda
  187. ; Lambda-Listen-Markierer:
  188. &optional &rest &key &allow-other-keys &aux &body &whole &environment
  189. ; EVAL-WHEN-Situationen:
  190. eval load compile
  191. ; DECLARE-Specifier:
  192. special type ftype function inline notinline ignore optimize speed space
  193. safety compilation-speed debug declaration
  194. ; Methoden-Kombination:
  195. standard
  196. ))
  197.  
  198. ;===============================================================================
  199.  
  200. (in-package "SYSTEM")
  201.  
  202. (defun common-lisp:make-package (package-name &key (nicknames '()) (use '("COMMON-LISP")))
  203.   (lisp:make-package package-name :nicknames nicknames :use use)
  204. )
  205.  
  206. ; impliziten BLOCK in eine Liste von Funktionsdefinitionen einfⁿgen
  207. (defun expand-fundefs (specform fdefs env)
  208.   (let ((new-fundefs '()))
  209.     (loop
  210.       (when (atom fdefs)
  211.         (if (null fdefs)
  212.           (return)
  213.           (error-of-type 'program-error
  214.             (DEUTSCH "Dotted list im Code von ~S, endet mit ~S"
  215.              ENGLISH "code after ~S contains a dotted list, ending with ~S"
  216.              FRANCAIS "Le code de ~S contient une paire pointΘe, terminΘe par ~S")
  217.             specform fdefs
  218.       ) ) )
  219.       (let ((fdef (pop fdefs)))
  220.         (unless (and (consp fdef) (consp (cdr fdef)))
  221.           (error-of-type 'program-error
  222.             (DEUTSCH "Falsche Syntax einer Funktionsdefinition in ~S: ~S"
  223.              ENGLISH "Illegal function definition syntax in ~S: ~S"
  224.              FRANCAIS "Mauvaise syntaxe de dΘfinition de fonction dans ~S : ~S")
  225.             specform fdef
  226.         ) )
  227.         (multiple-value-bind (body-rest declarations docstring)
  228.             (sys::parse-body (cddr fdef) t env)
  229.           (push `(,(first fdef) ,(second fdef)
  230.                   ,@(if declarations `((DECLARE ,@declarations)) '())
  231.                   ,@(if docstring `(,docstring) '())
  232.                   (BLOCK ,(first fdef) ,@body-rest)
  233.                  )
  234.                 new-fundefs
  235.       ) ) )
  236.     )
  237.     (nreverse new-fundefs)
  238. ) )
  239.  
  240. (defmacro common-lisp:flet (fundefs &body body &environment env)
  241.   (multiple-value-bind (body-rest declarations)
  242.       (sys::parse-body body nil env)
  243.     ((lambda (main-form)
  244.        (if declarations
  245.          `(LOCALLY (DECLARE ,@declarations) ,main-form)
  246.          main-form
  247.      ) )
  248.      `(LISP:FLET
  249.         ,(expand-fundefs 'common-lisp:flet fundefs env)
  250.         ,@body-rest
  251.       )
  252. ) ) )
  253.  
  254. (defmacro common-lisp:labels (fundefs &body body &environment env)
  255.   (multiple-value-bind (body-rest declarations)
  256.       (sys::parse-body body nil env)
  257.     ((lambda (main-form)
  258.        (if declarations
  259.          `(LOCALLY (DECLARE ,@declarations) ,main-form)
  260.          main-form
  261.      ) )
  262.      `(LISP:LABELS
  263.         ,(expand-fundefs 'common-lisp:labels fundefs env) ; env stimmt hier nicht ganz
  264.         ,@body-rest
  265.       )
  266. ) ) )
  267.  
  268. (defmacro common-lisp:macrolet (macrodefs &body body &environment env)
  269.   (multiple-value-bind (body-rest declarations)
  270.       (sys::parse-body body nil env)
  271.     `(LISP:MACROLET ,macrodefs
  272.        ,@(if declarations
  273.            `((LOCALLY (DECLARE ,@declarations) ,@body-rest))
  274.            body-rest
  275.          )
  276.      )
  277. ) )
  278.  
  279. ;===============================================================================
  280.  
  281. (defpackage "COMMON-LISP-USER" (:nicknames "CL-USER") (:use "COMMON-LISP"))
  282.  
  283. ;===============================================================================
  284.  
  285.