(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED " 2-Feb-91 14:33:36" |{DSK}<usr>local>lde>lispcore>sources2>COMMON-LISP-PACKAGE.;7|
 7002   

      |changes| |to:|  (VARIABLES OLDCLSYMS *COMMON-LISP-PACKAGE*) (VARS COMMON-LISP-PACKAGECOMS) (FUNCTIONS CRUNCH-FILES CREATE-CL-PACKAGE)

      |previous| |date:| " 2-Feb-91 13:17:24" 
|{DSK}<usr>local>lde>lispcore>sources2>COMMON-LISP-PACKAGE.;5|)


; Copyright (c) 1991 by Venue Corporation.  All rights reserved.

(PRETTYCOMPRINT COMMON-LISP-PACKAGECOMS)

(RPAQQ COMMON-LISP-PACKAGECOMS ((VARIABLES *COMMON-LISP-PACKAGE* NEWCLSYMS OLDCLSYMS SPLITCLSYMS) (FUNCTIONS CRUNCH-FILES FLIP-CL CREATE-CL-PACKAGE)))

(DEFGLOBALVAR *COMMON-LISP-PACKAGE* NIL "Place holder for the COMMON-LISP package variable")

(LISP:DEFPARAMETER NEWCLSYMS (QUOTE ("REAL" "BASE-CHARACTER" "EXTENDED-CHARACTER" "READTABLE-CASE" "SIMPLE-STRING" "BASE-STRING" "SIMPLE-BASE-STRING" "BROADCAST-STREAM" "CONCATENATED-STREAM" "ECHO-STREAM" "SYNONYM-STREAM" "STRING-STREAM" "FILE-STREAM" "TWO-WAY-STREAM" "UPGRADED-ARRAY-ELEMENT-TYPE" "UPGRADED-COMPLEX-PART-TYPE" "LOAD-TIME-EVAL" "REALP" "FDEFINITION" "NTH-VALUE" "DESTRUCTURING-BIND" "DEFINE-COMPILER-MACRO" "COMPILER-MACRO-FUNCTION" "COMPILER-MACROEXPAND" "COMPILER-MACROEXPAND-1" "VARIABLE-INFORMATION" "FUNCTION-INFORMATION" "DECLARATION-INFORMATION" "AUGMENT-ENVIRONMENT" "DEFINE-DECLARATION" "PARSE-MACRO" "ENCLOSE" "DECLAIM" "DYNAMIC-EXTENT" "*GENSYM-COUNTER*" "DELETE-PACKAGE" "DEFPACKAGE" "WITH-PACKAGE-ITERATOR" "LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT" "LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT" "LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT" "LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" "LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT" "LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT" "LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT" "LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT" "COMPLEMENT" "MAP-INTO" "WITH-HASH-TABLE-ITERATOR" "HASH-TABLE-REHASH-SIZE" "HASH-TABLE-REHASH-THRESHOLD" "HASH-TABLE-SIZE" "HASH-TABLE-TEST" "ROW-MAJOR-AREF" "OPEN-STREAM-P" "BROADCAST-STREAM-STREAMS" "CONCATENATED-STREAM-STREAMS" "ECHO-STREAM-INPUT-STREAM" "ECHO-STREAM-OUTPUT-STREAM" "SYNONYM-STREAM-SYMBOL" "TWO-WAY-STREAM-INPUT-STREAM" "TWO-WAY-STREAM-OUTPUT-STREAM" "INTERACTIVE-STREAM-P" "STREAM-EXTERNAL-FORMAT" "*READ-EVAL*" "READTABLE-CASE" "*PRINT-READABLY*" "WITH-STANDARD-IO-SYNTAX" "PRINT-UNREADABLE-OBJECT" "WILD-PATHNAME-P" "PATHNAME-MATCH-P" "TRANSLATE-PATHNAME" "LOGICAL-PATHNAME" "TRANSLATE-LOGICAL-PATHNAME" "LOGICAL-PATHNAME-TRANSLATIONS" "LOAD-LOGICAL-PATHNAME-TRANSLATIONS" "COMPILE-FILE-PATHNAME" "FILE-STRING-LENGTH" "*LOAD-PRINT*" "*LOAD-PATHNAME*" "*LOAD-TRUENAME*" "MAKE-LOAD-FORM" "MAKE-LOAD-FORM-SAVING-SLOTS" "*COMPILE-VERBOSE" "*COMPILE-PRINT*" "*COMPILE-FILE-PATHNAME*" "*COMPILE-FILE-TRUENAME*" "LOAD-TIME-VALUE" "FUNCTION-LAMBDA-EXPRESSION" "WITH-COMPILATION-UNIT")))

(LISP:DEFPARAMETER OLDCLSYMS (QUOTE ("COMMON" "COMMONP" "STRING-CHAR" "STRING-CHAR-P" "INT-CHAR" "COMPILER-LET" "CHAR-BIT" "SET-CHAR-BIT" "*MODULES*" "PROVIDE" "REQUIRE" "CHAR-FONT-LIMIT" "CHAR-BITS-LIMIT" "CHAR-BITS" "CHAR-FONT" "MAKE-CHAR" "CHAR-CONTROL-BIT" "CHAR-META-BIT" "CHAR-SUPER-BIT" "CHAR-HYPER-BIT" "*BREAK-ON-WARNINGS*")) "Symbols in LISP and not in COMMON-LISP")

(LISP:DEFPARAMETER SPLITCLSYMS (QUOTE ("LOCALLY" "IN-PACKAGE")))

(LISP:DEFUN CRUNCH-FILES (FL) (LISP:WHEN (AND FL (LISP:SYMBOLP FL)) (LISP:SETQ FL (LIST FL))) (LISP:DOLIST (F FL) (LISP:FORMAT T "Crunching ~a~%" F) (FLIP-CL :LISP) (LOAD F (QUOTE ALLPROP)) (FLIP-CL :NOWHERE) (MAKEFILE F (QUOTE NEW)) (LISP:IF (LISP:PROBE-FILE (CONCAT F ".DFASL")) (LISP:COMPILE-FILE F) (FAKE-COMPILE-FILE F)) (LISP:FORMAT T "Done crunching ~a~%" F)))

(LISP:DEFUN FLIP-CL (WHERE) (LISP:ECASE WHERE (:LISP (LISP:RENAME-PACKAGE *COMMON-LISP-PACKAGE* "COMMON-LISP" NIL NIL) (LISP:RENAME-PACKAGE *LISP-PACKAGE* "LISP" (QUOTE ("CL")) "CL")) (:COMMON-LISP (LISP:RENAME-PACKAGE *LISP-PACKAGE* "LISP" NIL NIL) (LISP:RENAME-PACKAGE *COMMON-LISP-PACKAGE* "COMMON-LISP" (QUOTE ("CL")) "CL")) (:NOWHERE (LISP:RENAME-PACKAGE *LISP-PACKAGE* "LISP" NIL NIL) (LISP:RENAME-PACKAGE *COMMON-LISP-PACKAGE* "COMMON-LISP" NIL NIL))))

(LISP:DEFUN CREATE-CL-PACKAGE NIL (* |;;| "First, rename the LISP package to get its nicknames out of our way") (LISP:RENAME-PACKAGE (LISP:FIND-PACKAGE "LISP") "LISP" NIL NIL) (* |;;| "Then create the COMMON-LISP package and friends") (LISP:UNLESS (LISP:FIND-PACKAGE "COMMON-LISP") (* |;;| "For the moment, no nicknames for COMMON-LISP; FLIP-CL can be used to fix this later.") (SETQ *COMMON-LISP-PACKAGE* (LISP:MAKE-PACKAGE "COMMON-LISP" :USE NIL)) (* |;;| "We probably want to have COMMON-LISP-USER use XCL; this needs to be discussed") (LISP:MAKE-PACKAGE "COMMON-LISP-USER" :USE (QUOTE ("COMMON-LISP")))) (LET ((WEIRDTAG (CONS NIL NIL)) (OLDPROP (CONS NIL NIL)) (UNSHAREDPROP (CONS NIL NIL)) I) (* |;;| "Flag the atoms in LISP that are not going to be shared into COMMON-LISP") (LISP:DOLIST (I OLDCLSYMS) (PUT (LISP:FIND-SYMBOL I *LISP-PACKAGE*) WEIRDTAG OLDPROP)) (LISP:DOLIST (I SPLITCLSYMS) (PUT (LISP:FIND-SYMBOL I *LISP-PACKAGE*) WEIRDTAG UNSHAREDPROP)) (* |;;| "OK, crunch the external symbols in LISP.  We may eventually rehome these symbols into COMMON-LISP") (LISP:DO-EXTERNAL-SYMBOLS (I *LISP-PACKAGE*) (LET ((WEIRD? (GET I WEIRDTAG)) S) (COND ((EQ WEIRD? OLDPROP) (* \; "Just leave it alone") (REMPROP I WEIRDTAG)) ((EQ WEIRD? UNSHAREDPROP) (* \; "Export a new, unshared symbol") (EXPORT (LISP:INTERN (LISP:SYMBOL-NAME I) *COMMON-LISP-PACKAGE*) *COMMON-LISP-PACKAGE*) (REMPROP I WEIRDTAG)) ((NULL WEIRD?) (* \; "Share symbol; if it's already there, shadow it") (LISP:IF (SETQ S (LISP:FIND-SYMBOL (LISP:SYMBOL-NAME I) *COMMON-LISP-PACKAGE*)) (LISP:UNLESS (EQ S I) (LISP:SHADOWING-IMPORT I *COMMON-LISP-PACKAGE*)) (IMPORT I *COMMON-LISP-PACKAGE*)) (EXPORT I *COMMON-LISP-PACKAGE*)) (T (* \; "VERY unlikely...") (ERROR "Garbage on property list during LISP->COMMON-LISP import" (CONS I WEIRD?)))))) (* |;;| "Hose out the new COMMON-LISP symbols") (LISP:DOLIST (I NEWCLSYMS) (EXPORT (LISP:INTERN I *COMMON-LISP-PACKAGE*) *COMMON-LISP-PACKAGE*)) (* |;;| "If these other packages are around, grab their symbols") (LET (P S) (LISP:WHEN (SETQ P (LISP:FIND-PACKAGE "XP")) (LISP:DOLIST (I (QUOTE ("*PRINT-PPRINT-DISPATCH*" "*PPRINT-RIGHT-MARGIN*" "*PPRINT-MISER-WIDTH*" "PPRINT-NEWLINE" "PPRINT-LOGICAL-BLOCK" "PPRINT-EXIT-IF-LIST-EXHAUSTED" "PPRINT-POP" "PPRINT-INDENT" "PPRINT-TAB" "PPRINT-FILL" "PPRINT-LINEAR" "PPRINT-TABULAR" "FORMATTER" "COPY-PPRINT-DISPATCH" "PPRINT-DISPATCH" "SET-PPRINT-DISPATCH"))) (SETQ S (LISP:FIND-SYMBOL I P)) (IMPORT S *COMMON-LISP-PACKAGE*) (EXPORT S *COMMON-LISP-PACKAGE*))) (* |;;| "This will have to be changed somewhat as we change the CONDITIONS system to comply with CLtL2") (LISP:WHEN (SETQ P (LISP:FIND-PACKAGE "CONDITIONS")) (LISP:DO-EXTERNAL-SYMBOLS (I P) (IMPORT I *COMMON-LISP-PACKAGE*) (EXPORT I *COMMON-LISP-PACKAGE*))) (FLIP-CL :COMMON-LISP))))
(PUTPROPS COMMON-LISP-PACKAGE COPYRIGHT ("Venue Corporation" 1991))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL)))
STOP