Raymond Toy pushed to branch issue-390-autogen-errno-package at cmucl / cmucl

Commits:

1 changed file:

Changes:

  • src/bootfiles/21e/boot-2024-08.lisp
    ... ... @@ -9,321 +9,124 @@
    9 9
     	      (invoke-restart 'continue))))
    
    10 10
       (defconstant +ef-max+ 14))
    
    11 11
     
    
    12
    -
    
    13
    -;; For issue #390.  Initialize the new UNIX package with ERRNO stuff.
    
    14
    -;; Without this we need to disable package locks in code:exports.lisp
    
    15
    -;; when defining the UNIX package and that removes the ability to
    
    16
    -;; detect changes in the UNIX package.
    
    17
    -(in-package "LISP")
    
    18
    -(load "src/code/exports-errno")
    
    19
    -(ext:without-package-locks
    
    20
    -  ;; Define macro to create the UNIX package that also shadow imports
    
    21
    -  ;; the symbols from ERRNO and also exports them again.  This is
    
    22
    -  ;; needed so that we don't get a warning about UNIX shadowing all
    
    23
    -  ;; the symbols from ERRNO and a warning that UNIX exports all the
    
    24
    -  ;; symbols from ERRNO too.
    
    25
    -  (defmacro define-unix-package (&body body)
    
    26
    -    (let (errno-symbols)
    
    27
    -      (do-external-symbols (sym "ERRNO")
    
    28
    -	(push (symbol-name sym) errno-symbols))
    
    29
    -      `(ext:without-package-locks
    
    30
    -	 (defpackage "UNIX"
    
    31
    -	 (:shadowing-import-from "ERRNO" ,@errno-symbols)
    
    32
    -	 (:export ,@errno-symbols)
    
    33
    -	 ,@body)))))
    
    34
    -
    
    35
    -(define-unix-package
    
    36
    -  (:export "UNIX-CURRENT-DIRECTORY"
    
    37
    -	   "UNIX-OPEN"
    
    38
    -	   "UNIX-READ"
    
    39
    -	   "UNIX-WRITE"
    
    40
    -	   "UNIX-GETPAGESIZE"
    
    41
    -	   "UNIX-ERRNO"
    
    42
    -	   "UNIX-MAYBE-PREPEND-CURRENT-DIRECTORY"
    
    43
    -	   "UNIX-RESOLVE-LINKS"
    
    44
    -	   "UNIX-REALPATH"
    
    45
    -	   "UNIX-CLOSE"
    
    46
    -	   "UNIX-STAT"
    
    47
    -	   "UNIX-LSTAT"
    
    48
    -	   "UNIX-FSTAT"
    
    49
    -	   "UNIX-GETHOSTNAME"
    
    50
    -	   "UNIX-LSEEK"
    
    51
    -	   "UNIX-EXIT"
    
    52
    -	   "UNIX-CHDIR"
    
    53
    -	   "UNIX-ACCESS"
    
    54
    -	   "UNIX-DUP"
    
    55
    -	   "UNIX-CHMOD"
    
    56
    -	   "UNIX-READLINK"
    
    57
    -	   "UNIX-RENAME"
    
    58
    -	   "UNIX-SELECT"
    
    59
    -	   "UNIX-FAST-GETRUSAGE"
    
    60
    -	   "UNIX-GETRUSAGE"
    
    61
    -	   "UNIX-GETTIMEOFDAY"
    
    62
    -	   "UNIX-ISATTY"
    
    63
    -	   "UNIX-MKDIR"
    
    64
    -	   "UNIX-RMDIR"
    
    65
    -	   "UNIX-UNLINK"
    
    66
    -	   "TIMEZONE"
    
    67
    -	   "TIMEVAL"
    
    68
    -	   "SIZE-T"
    
    69
    -	   "OFF-T"
    
    70
    -	   "INO-T"
    
    71
    -	   "DEV-T"
    
    72
    -	   "TIME-T"
    
    73
    -	   "USER-INFO-NAME"
    
    74
    -	   "INT64-T"
    
    75
    -	   "MODE-T"
    
    76
    -	   "UNIX-FAST-SELECT"
    
    77
    -	   "UNIX-PIPE"
    
    78
    -	   "UNIX-GETPID"
    
    79
    -	   "UNIX-GETHOSTID"
    
    80
    -	   "UNIX-UID"
    
    81
    -	   "UNIX-GID"
    
    82
    -	   "GET-UNIX-ERROR-MSG"
    
    83
    -	   "WINSIZE"
    
    84
    -	   "TIMEVAL"
    
    85
    -	   "CLOSE-DIR"
    
    86
    -	   "OPEN-DIR"
    
    87
    -	   "READ-DIR"
    
    88
    -
    
    89
    -	   ;; filesys.lisp
    
    90
    -	   "UNIX-GETPWUID"
    
    91
    -
    
    92
    -	   ;; multi-proc.lisp
    
    93
    -	   "UNIX-SETITIMER"
    
    94
    -
    
    95
    -	   ;; run-program.lisp
    
    96
    -	   "UNIX-TTYNAME"
    
    97
    -	   "UNIX-IOCTL"
    
    98
    -	   "UNIX-OPENPTY"
    
    99
    -
    
    100
    -	   ;; alien-callback.lisp
    
    101
    -	   "UNIX-MPROTECT"
    
    102
    -
    
    103
    -	   ;; internet.lisp
    
    104
    -	   "UNIX-SOCKET"
    
    105
    -	   "UNIX-CONNECT"
    
    106
    -	   "UNIX-BIND"
    
    107
    -	   "UNIX-LISTEN"
    
    108
    -	   "UNIX-ACCEPT"
    
    109
    -	   "UNIX-GETSOCKOPT"
    
    110
    -	   "UNIX-SETSOCKOPT"
    
    111
    -	   "UNIX-GETPEERNAME"
    
    112
    -	   "UNIX-GETSOCKNAME"
    
    113
    -	   "UNIX-RECV"
    
    114
    -	   "UNIX-SEND"
    
    115
    -	   "UNIX-RECVFROM"
    
    116
    -	   "UNIX-SENDTO"
    
    117
    -	   "UNIX-SHUTDOWN"
    
    118
    -	   "UNIX-FCNTL"
    
    119
    -
    
    120
    -	   ;; serve-event.lisp
    
    121
    -	   "FD-SETSIZE"
    
    122
    -	   "FD-ISSET"
    
    123
    -	   "FD-CLR"
    
    124
    -
    
    125
    -	   ;; Simple streams
    
    126
    -	   "PROT_READ"
    
    127
    -	   "UNIX-MMAP"
    
    128
    -	   "UNIX-MUNMAP"
    
    129
    -	   "UNIX-MSYNC"
    
    130
    -
    
    131
    -	   ;; Motif
    
    132
    -	   "UNIX-GETUID"
    
    133
    -
    
    134
    -	   ;; Hemlock
    
    135
    -	   "UNIX-CFGETOSPEED"
    
    136
    -	   "TERMIOS"
    
    137
    -	   "UNIX-TCGETATTR"
    
    138
    -	   "UNIX-TCSETATTR"
    
    139
    -	   "UNIX-FCHMOD"
    
    140
    -	   "UNIX-CREAT"
    
    141
    -	   "UNIX-UTIMES"
    
    142
    -
    
    143
    -	   ;; Tests
    
    144
    -	   "UNIX-SYMLINK"
    
    145
    -
    
    146
    -	   ;; Other symbols from structures, etc.
    
    147
    -	   "C-CC" "C-CFLAG" "C-IFLAG" "C-ISPEED" "C-LFLAG" "C-OFLAG" "C-OSPEED"
    
    148
    -	   "CHECK" "D-NAME" "D-RECLEN"    
    
    149
    -	   "F-GETFL" "F-GETOWN" "F-SETFL" "F-SETOWN" "FAPPEND"
    
    150
    -	   "FASYNC" "FD-SET" "FD-ZERO" "FNDELAY" "F_OK" "GID-T" "IT-INTERVAL"
    
    151
    -	   "IT-VALUE" "ITIMERVAL" "L_INCR" "L_SET" "L_XTND" "MAP_ANONYMOUS"
    
    152
    -	   "MAP_FIXED" "MAP_PRIVATE" "MAP_SHARED" "MS_ASYNC" "MS_INVALIDATE"
    
    153
    -	   "MS_SYNC" "O_APPEND" "O_CREAT" "O_EXCL" "O_NDELAY" "O_NONBLOCK"
    
    154
    -	   "O_RDONLY" "O_RDWR" "O_TRUNC" "O_WRONLY" "PROT_EXEC" "PROT_NONE"
    
    155
    -	   "PROT_WRITE" "RU-IDRSS" "RU-INBLOCK" "RU-ISRSS" "RU-IXRSS" "RU-MAJFLT"
    
    156
    -	   "RU-MAXRSS" "RU-MINFLT" "RU-MSGRCV" "RU-MSGSND" "RU-NIVCSW" "RU-NSIGNALS"
    
    157
    -	   "RU-NSWAP" "RU-NVCSW" "RU-OUBLOCK" "RU-STIME" "RU-UTIME"
    
    158
    -	   "RUSAGE_CHILDREN" "RUSAGE_SELF" "R_OK" "S-IFBLK" "S-IFCHR" "S-IFDIR"
    
    159
    -	   "S-IFLNK" "S-IFMT" "S-IFREG" "S-IFSOCK" "SIGABRT" "SIGALRM" "SIGBUS"
    
    160
    -	   "SIGCHLD" "SIGCONT" "SIGCONTEXT" "SIGFPE" "SIGHUP" "SIGILL" "SIGINT"
    
    161
    -	   "SIGIO" "SIGIOT" "SIGKILL" "SIGMASK" "SIGPIPE" "SIGPROF" "SIGQUIT"
    
    162
    -	   "SIGSEGV" "SIGSTOP" "SIGTERM" "SIGTRAP" "SIGTSTP" "SIGTTIN" "SIGTTOU"
    
    163
    -	   "SIGURG" "SIGUSR1" "SIGUSR2" "SIGVTALRM" "SIGWINCH" "SIGXCPU" "SIGXFSZ"
    
    164
    -	   "ST-ATIME" "ST-BLKSIZE" "ST-BLOCKS" "ST-CTIME" "ST-DEV" "ST-GID"
    
    165
    -	   "ST-MODE" "ST-MTIME" "ST-NLINK" "ST-RDEV" "ST-SIZE" "ST-UID" "STAT"
    
    166
    -	   "TCSADRAIN" "TCSAFLUSH" "TCSANOW" "TIOCGPGRP" "TIOCGWINSZ" "TIOCNOTTY"
    
    167
    -	   "TIOCSPGRP" "TIOCSWINSZ" "TTY-BRKINT" "TTY-ECHO" "TTY-ECHOCTL"
    
    168
    -	   "TTY-ECHOE" "TTY-ECHOK" "TTY-ECHOKE" "TTY-ECHONL" "TTY-ECHOPRT"
    
    169
    -	   "TTY-FLUSHO" "TTY-ICANON" "TTY-ICRNL" "TTY-IEXTEN" "TTY-IGNBRK"
    
    170
    -	   "TTY-IGNCR" "TTY-IGNPAR" "TTY-IMAXBEL" "TTY-INLCR" "TTY-INPCK" "TTY-ISIG"
    
    171
    -	   "TTY-ISTRIP" "TTY-IXANY" "TTY-IXOFF" "TTY-IXON" "TTY-NOFLSH" "TTY-ONLCR"
    
    172
    -	   "TTY-OPOST" "TTY-PARMRK" "TTY-PENDIN" "TTY-TOSTOP" "TV-SEC" "TV-USEC"
    
    173
    -	   "TZ-DSTTIME" "TZ-MINUTESWEST" "UID-T" "UNIX-FD" "UNIX-FILE-KIND"
    
    174
    -	   "UNIX-FILE-MODE" "UNIX-GETUID" "UNIX-KILL" "UNIX-KILLPG" "UNIX-PATHNAME"
    
    175
    -	   "UNIX-SIGBLOCK" "UNIX-SIGNAL-DESCRIPTION" "UNIX-SIGNAL-NAME"
    
    176
    -	   "UNIX-SIGNAL-NUMBER" "UNIX-SIGPAUSE" "UNIX-SIGSETMASK" "USER-INFO"
    
    177
    -	   "USER-INFO-DIR" "USER-INFO-GECOS" "USER-INFO-GID" "USER-INFO-PASSWORD"
    
    178
    -	   "USER-INFO-SHELL" "USER-INFO-UID" "VDSUSP" "VEOF" "VEOL" "VEOL2" "VERASE"
    
    179
    -	   "VINTR" "VKILL" "VMIN" "VQUIT" "VSTART" "VSTOP" "VSUSP" "VTIME"
    
    180
    -	   "WRITEOWN" "WS-COL" "WS-ROW" "WS-XPIXEL" "WS-YPIXEL" "W_OK" "X_OK"
    
    181
    -	   "FIONREAD"
    
    182
    -	   "TERMINAL-SPEEDS"
    
    183
    -	   )
    
    184
    -  (:export
    
    185
    -   ;; For asdf
    
    186
    -   "UNIX-GETENV"
    
    187
    -   "UNIX-SETENV"
    
    188
    -   "UNIX-PUTENV"
    
    189
    -   "UNIX-UNSETENV"
    
    190
    -   ;; For slime
    
    191
    -   "UNIX-EXECVE"
    
    192
    -   "UNIX-FORK")
    
    193
    -  #-(or linux solaris)
    
    194
    -  (:export "TCHARS"
    
    195
    -	   "LTCHARS"
    
    196
    -	   "D-NAMLEN"
    
    197
    -	   
    
    198
    -	   ;; run-program.lisp
    
    199
    -	   "SGTTYB"
    
    200
    -
    
    201
    -	   ;; Other symbols from structures, etc.
    
    202
    -	   "DIRECT" "ELOCAL" "EPROCLIM" "EVICEERR" "EVICEOP" "EXECGRP" "EXECOTH"
    
    203
    -	   "EXECOWN" "F-DUPFD" "F-GETFD" "F-SETFD" "FCREAT" "FEXCL"
    
    204
    -	   "FTRUNC" "READGRP" "READOTH" "READOWN" "S-IEXEC" "S-IREAD" "S-ISGID"
    
    205
    -	   "S-ISUID" "S-ISVTX" "S-IWRITE" "SAVETEXT" "SETGIDEXEC" "SETUIDEXEC"
    
    206
    -	   "SG-ERASE" "SG-FLAGS" "SG-ISPEED" "SG-KILL" "SG-OSPEED" "SIGEMT" "SIGSYS"
    
    207
    -	   "T-BRKC" "T-DSUSPC" "T-EOFC" "T-FLUSHC" "T-INTRC" "T-LNEXTC" "T-QUITC"
    
    208
    -	   "T-RPRNTC" "T-STARTC" "T-STOPC" "T-SUSPC" "T-WERASC" "TCIFLUSH"
    
    209
    -	   "TCIOFLUSH" "TCOFLUSH" "TIOCFLUSH" "TIOCGETC"
    
    210
    -	   "TIOCGETP" "TIOCGLTC" "TIOCSETC" "TIOCSETP" "TIOCSLTC" "TTY-CBREAK"
    
    211
    -	   "TTY-CLOCAL" "TTY-CREAD" "TTY-CRMOD" "TTY-CS5" "TTY-CS6" "TTY-CS7"
    
    212
    -	   "TTY-CS8" "TTY-CSIZE" "TTY-CSTOPB" "TTY-HUPCL" "TTY-LCASE" "TTY-PARENB"
    
    213
    -	   "TTY-PARODD" "TTY-RAW" "TTY-TANDEM" "WRITEGRP" "WRITEOTH"
    
    214
    -	   )
    
    215
    -  #+linux
    
    216
    -  (:export "TCHARS"
    
    217
    -	   "LTCHARS"
    
    218
    -	   "D-NAMLEN"
    
    219
    -
    
    220
    -	   ;; run-program.lisp
    
    221
    -	   "SGTTYB"
    
    222
    -
    
    223
    -	   ;; Other symbols
    
    224
    -	   "BLKCNT-T" "D-INO" "D-OFF"     
    
    225
    -	   "O_NOCTTY" "SIGSTKFLT"
    
    226
    -	   "SG-FLAGS"
    
    227
    -	   "TIOCGETP"
    
    228
    -	   "TIOCSETP"
    
    229
    -	   "TTY-IUCLC"
    
    230
    -	   "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR"
    
    231
    -	   "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID"
    
    232
    -	   "UTSNAME"
    
    233
    -	   )
    
    234
    -  #+solaris
    
    235
    -  (:export "D-INO"
    
    236
    -	   "D-OFF"
    
    237
    -	   "DIRECT"
    
    238
    -	   "EXECGRP"
    
    239
    -	   "EXECOTH"
    
    240
    -	   "EXECOWN"
    
    241
    -	   
    
    242
    -	   "F-DUPFD"
    
    243
    -	   "F-GETFD"
    
    244
    -	   "F-SETFD"
    
    245
    -	   "FCREAT"
    
    246
    -	   "FEXCL"
    
    247
    -	   "FTRUNC"
    
    248
    -	   "LTCHARS"
    
    249
    -	   "O_NOCTTY"
    
    250
    -	   "RCV1EN"
    
    251
    -	   "READGRP"
    
    252
    -	   "READOTH"
    
    253
    -	   "READOWN"
    
    254
    -	   "S-IEXEC"
    
    255
    -	   "S-IREAD"
    
    256
    -	   "S-ISGID"
    
    257
    -	   "S-ISUID"
    
    258
    -	   "S-ISVTX"
    
    259
    -	   "S-IWRITE"
    
    260
    -	   "SAVETEXT"
    
    261
    -	   "SETGIDEXEC"
    
    262
    -	   "SETUIDEXEC"
    
    263
    -	   "SG-ERASE"
    
    264
    -	   "SG-FLAGS"
    
    265
    -	   "SG-ISPEED"
    
    266
    -	   "SG-KILL"
    
    267
    -	   "SG-OSPEED"
    
    268
    -	   "SGTTYB"
    
    269
    -	   "SIGEMT"
    
    270
    -	   "SIGSYS"
    
    271
    -	   "SIGWAITING"
    
    272
    -	   "T-BRKC"
    
    273
    -	   "T-DSUSPC"
    
    274
    -	   "T-EOFC"
    
    275
    -	   "T-FLUSHC"
    
    276
    -	   "T-INTRC"
    
    277
    -	   "T-LNEXTC"
    
    278
    -	   "T-QUITC"
    
    279
    -	   "T-RPRNTC"
    
    280
    -	   "T-STARTC"
    
    281
    -	   "T-STOPC"
    
    282
    -	   "T-SUSPC"
    
    283
    -	   "T-WERASC"
    
    284
    -	   "TCHARS"
    
    285
    -	   "TCIFLUSH"
    
    286
    -	   "TCIOFLUSH"
    
    287
    -	   "TCOFLUSH"
    
    288
    -	   "TIOCFLUSH"
    
    289
    -	   "TIOCGETC"
    
    290
    -	   "TIOCGETP"
    
    291
    -	   "TIOCGLTC"
    
    292
    -	   "TIOCSETC"
    
    293
    -	   "TIOCSETP"
    
    294
    -	   "TIOCSLTC"
    
    295
    -	   "TTY-CBAUD"
    
    296
    -	   "TTY-CBREAK"
    
    297
    -	   "TTY-CLOCAL"
    
    298
    -	   "TTY-CREAD"
    
    299
    -	   "TTY-CRMOD"
    
    300
    -	   "TTY-CS5"
    
    301
    -	   "TTY-CS6"
    
    302
    -	   "TTY-CS7"
    
    303
    -	   "TTY-CS8"
    
    304
    -	   "TTY-CSIZE"
    
    305
    -	   "TTY-CSTOPB"
    
    306
    -	   "TTY-DEFECHO"
    
    307
    -	   "TTY-HUPCL"
    
    308
    -	   "TTY-IUCLC"
    
    309
    -	   "TTY-LCASE"
    
    310
    -	   "TTY-LOBLK"
    
    311
    -	   "TTY-OCRNL"
    
    312
    -	   "TTY-OFDEL"
    
    313
    -	   "TTY-OFILL"
    
    314
    -	   "TTY-OLCUC"
    
    315
    -	   "TTY-ONLRET"
    
    316
    -	   "TTY-ONOCR"
    
    317
    -	   "TTY-PARENB"
    
    318
    -	   "TTY-PARODD"
    
    319
    -	   "TTY-RAW"
    
    320
    -	   "TTY-TANDEM"
    
    321
    -	   "TTY-XCASE"
    
    322
    -	   "UNIX-TIMES"
    
    323
    -	   "UNIX-DUP2"
    
    324
    -	   "UTSNAME"
    
    325
    -	   "WRITEGRP"
    
    326
    -	   "WRITEOTH"
    
    327
    -	   "XMT1EN"
    
    328
    -	   )
    
    329
    -  )
    12
    +;;; Bootstrap for adding %local-nicknames to package structure.
    
    13
    +(in-package :lisp)
    
    14
    +
    
    15
    +(intern "PACKAGE-LOCAL-NICKNAMES" "LISP")
    
    16
    +(intern	"ADD-PACKAGE-LOCAL-NICKNAME" "LISP")
    
    17
    +(intern	"REMOVE-PACKAGE-LOCAL-NICKNAME" "LISP")
    
    18
    +(intern	"PACKAGE-LOCALLY-NICKNAMED-BY-LIST" "LISP")
    
    19
    +
    
    20
    +;; Make sure we don't accidentally load fasls from somewhere.
    
    21
    +(setf (ext:search-list "target:")
    
    22
    +      '("src/"))
    
    23
    +
    
    24
    +;; Ensure all packages have been set up, since package definition is broken
    
    25
    +;; once this file has been loaded:
    
    26
    +(load "target:code/exports-errno" :if-does-not-exist nil)
    
    27
    +(load "target:code/exports")
    
    28
    +
    
    29
    +(setf *enable-package-locked-errors* nil)
    
    30
    +
    
    31
    +;;;
    
    32
    +;;; Like DEFSTRUCT, but silently clobber old definitions.
    
    33
    +;;;
    
    34
    +(defmacro defstruct! (name &rest stuff)
    
    35
    +  `(handler-bind ((error (lambda (c)
    
    36
    +                           (declare (ignore c))
    
    37
    +                           (invoke-restart 'kernel::clobber-it))))
    
    38
    +     (defstruct ,name ,@stuff)))
    
    39
    +
    
    40
    +
    
    41
    +(defstruct! (package
    
    42
    +	     (:constructor internal-make-package)
    
    43
    +	     (:predicate packagep)
    
    44
    +	     (:print-function %print-package)
    
    45
    +	     (:make-load-form-fun
    
    46
    +	      (lambda (package)
    
    47
    +		(values `(package-or-lose ',(package-name package))
    
    48
    +			nil))))
    
    49
    +  (tables (list nil))	; A list of all the hashtables for inherited symbols.
    
    50
    +  (%name nil :type (or simple-string null))
    
    51
    +  (%nicknames () :type list)
    
    52
    +  (%use-list () :type list)
    
    53
    +  (%used-by-list () :type list)
    
    54
    +  (internal-symbols (required-argument) :type package-hashtable)
    
    55
    +  (external-symbols (required-argument) :type package-hashtable)
    
    56
    +  (%shadowing-symbols () :type list)
    
    57
    +  (lock nil :type boolean)
    
    58
    +  (definition-lock nil :type boolean)
    
    59
    +  (%local-nicknames () :type list)
    
    60
    +  (doc-string nil :type (or simple-string null)))
    
    61
    +
    
    62
    +;; Need to define this with the extra arg because compiling pcl uses
    
    63
    +;; defpackage and we need this defined.  This isn't the actual
    
    64
    +;; implementation; we just added the extra arg.
    
    65
    +(defun %defpackage (name nicknames size shadows shadowing-imports
    
    66
    +			 use imports interns exports doc-string &optional local-nicknames)
    
    67
    +  (declare (type simple-base-string name)
    
    68
    +	   (type list nicknames local-nicknames shadows shadowing-imports
    
    69
    +		 imports interns exports)
    
    70
    +	   (type (or list (member :default)) use)
    
    71
    +	   (type (or simple-base-string null) doc-string))
    
    72
    +  (let ((package (or (find-package name)
    
    73
    +		     (progn
    
    74
    +		       (when (eq use :default)
    
    75
    +			 (setf use *default-package-use-list*))
    
    76
    +		       (make-package name
    
    77
    +				     :use nil
    
    78
    +				     :internal-symbols (or size 10)
    
    79
    +				     :external-symbols (length exports))))))
    
    80
    +    (unless (string= (the string (package-name package)) name)
    
    81
    +      (error 'simple-package-error
    
    82
    +	     :package name
    
    83
    +	     :format-control (intl:gettext "~A is a nick-name for the package ~A")
    
    84
    +	     :format-arguments (list name (package-name name))))
    
    85
    +    (enter-new-nicknames package nicknames)
    
    86
    +    ;; Shadows and Shadowing-imports.
    
    87
    +    (let ((old-shadows (package-%shadowing-symbols package)))
    
    88
    +      (shadow shadows package)
    
    89
    +      (dolist (sym-name shadows)
    
    90
    +	(setf old-shadows (remove (find-symbol sym-name package) old-shadows)))
    
    91
    +      (dolist (simports-from shadowing-imports)
    
    92
    +	(let ((other-package (package-or-lose (car simports-from))))
    
    93
    +	  (dolist (sym-name (cdr simports-from))
    
    94
    +	    (let ((sym (find-or-make-symbol sym-name other-package)))
    
    95
    +	      (shadowing-import sym package)
    
    96
    +	      (setf old-shadows (remove sym old-shadows))))))
    
    97
    +      (when old-shadows
    
    98
    +	(warn (intl:gettext "~A also shadows the following symbols:~%  ~S")
    
    99
    +	      name old-shadows)))
    
    100
    +    ;; Use
    
    101
    +    (unless (eq use :default)
    
    102
    +      (let ((old-use-list (package-use-list package))
    
    103
    +	    (new-use-list (mapcar #'package-or-lose use)))
    
    104
    +	(use-package (set-difference new-use-list old-use-list) package)
    
    105
    +	(let ((laterize (set-difference old-use-list new-use-list)))
    
    106
    +	  (when laterize
    
    107
    +	    (unuse-package laterize package)
    
    108
    +	    (warn (intl:gettext "~A previously used the following packages:~%  ~S")
    
    109
    +		  name
    
    110
    +		  laterize)))))
    
    111
    +    ;; Import and Intern.
    
    112
    +    (dolist (sym-name interns)
    
    113
    +      (intern sym-name package))
    
    114
    +    (dolist (imports-from imports)
    
    115
    +      (let ((other-package (package-or-lose (car imports-from))))
    
    116
    +	(dolist (sym-name (cdr imports-from))
    
    117
    +	  (import (list (find-or-make-symbol sym-name other-package))
    
    118
    +		  package))))
    
    119
    +    ;; Exports.
    
    120
    +    (let ((old-exports nil)
    
    121
    +	  (exports (mapcar #'(lambda (sym-name) (intern sym-name package))
    
    122
    +			   exports)))
    
    123
    +      (do-external-symbols (sym package)
    
    124
    +	(push sym old-exports))
    
    125
    +      (export exports package)
    
    126
    +      (let ((diff (set-difference old-exports exports)))
    
    127
    +	(when diff
    
    128
    +	  (warn (intl:gettext "~A also exports the following symbols:~%  ~S")
    
    129
    +		name diff))))
    
    130
    +    ;; Documentation
    
    131
    +    (setf (package-doc-string package) doc-string)
    
    132
    +    package))