12. Packages, Libraries, and Modules

;;;-----------------------------
(defpackage :alpha (:use :cl))
(in-package :alpha)
(setf name "first")

(defpackage :omega (:use :cl))
(in-package :omega)
(setf name "last")

(in-package :cl-user) ; default package, kinda like Perl's 'main' package
(format t "Alpha is ~A, omega is ~A.~%" alpha::name omega::name)
;; Alpha is first, omega is last.
;;;-----------------------------
(load "FileHandle.lisp")                ; run-time load
(load "FileHandle.fasl")        ; explicitly load pre-compiled version
(load "FileHandle")          ; same as previous two, will prefer .fasl
(require :FileHandle)                   ; similar, still run-time

;; Could use LOAD here instead of REQUIRE; it's the EVAL-WHEN that
;; makes this compile-time.  Note that it's fairly unusual to do this
;; explicitly with EVAL-WHEN.  Instead, one normally ensures that the
;; requisite packages have already been loaded before attempting to
;; compile a file, e.g., using a build system such as ASDF.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :FileHandle))                ; compile-time

;; The Cards::Poker example is no different than the above in CL.  CL
;; has no in-built hierarchicalp package system, hence no translation
;; of "::" into a directory separator, etc.
;;;-----------------------------
(defpackage :cards.poker                
  (:use :cl)                            ; equivalent to Perl line 2
  (:export :shuffle :*card-deck*))      ; line 4
(in-package :cards.poker)               ; line 1
(defparameter *card-deck* nil)          ; line 5
(defun shuffle ())                      ; line 6
;;;-----------------------------

;;;-----------------------------
(defpackage :your-module (:use :cl)
            (:export ...))              ; one way to export
(in-package :your-module)

(defparameter *version* 1.00) ; not standard CL, but one could ascribe meaning by convention

(export '(...))                         ; another way to export

;; There is no built-in equivalent to EXPORT_OK.  EXPORT_TAGS also has
;; no standard CL counterpart, but something similar can easily be
;; implemented.  See IMPORT-TAGS, defined in the appendix.
(defparameter *export-tags*
  '(:TAG1 ( ... )
    :TAG2 ( ... )))

;;;;;;;;;;;;;;;;;;;;;;;;
;; your code goes here
;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------
(defpackage :my-package (:use cl)
            (:use :your-module)) ; Import default symbols into my package.
(defpackage :my-package (:use cl)
            (:import-from :your-module ...)) ; Import listed symbols into my package.
;; Or at some point in my-package do this:
(in-package :my-package)
(import '(your-module:symbol1 your-module:symbol2 ...)) ; Import listed symbols into my package.
(defpackage :my-package (:use cl)
            (:import-from :your-module)) ; Do not import any symbols
;;;-----------------------------
(export '(f1 f2 my-list))
;;;-----------------------------
;; No equivalent to EXPORT_OK
;;;-----------------------------
(import '(your-module:op-func your-module:your-table your-module:f1))
;;;-----------------------------
;; From within the package you want to import into, do this
;; (IMPORT-TAGS defined in appendix, not standard CL).
(import-tags :your-module :DEFAULT)
(import 'your-module:your-table)
;;;-----------------------------
(defparameter *export-tags*
  '((:functions (f1 f2 op-func))
    (:variables (your-list your-table))))
;;;-----------------------------
(import-tags :your-module :functions)
(import 'your-module:your-table)
;;;-----------------------------

;;;-----------------------------
;; In the following example, EVAL-WHEN is like the Perl example's
;; BEGIN.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (multiple-value-bind (retval why-not)
      (ignore-errors (require :mod))    ; no import
    (when why-not
      (warn "couldn't load :mod: ~A" why-not))))

;; Note that there is no "use" in CL, but you can REQUIRE and then
;; USE-PACKAGE if it was successful.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (multiple-value-bind (retval why-not)
      (ignore-errors (require :mod))
    (if why-not
      (warn "couldn't load :mod: ~A" why-not)
      (use-package :mod))))             ; imports into current package
;;;-----------------------------

;; This code is written in order to be as much like the Perl example
;; as possible, and likely isn't what you'd use in practice.  Normally
;; you'd just take advantage of the existing features of, for example,
;; ASDF.
(eval-when (:compile-toplevel :load-toplevel :execute)

  (let ((dbs '(giant.eenie giant.meanie mouse.mynie moe))
        found)

    (dolist (module dbs)
      (multiple-value-bind (_ why-not)
          (ignore-errors (require module))
        (unless why-not
          (let (import-fn)
            (let ((*package* (find-package module)))
              ;; The following line assumes the module defines
              ;; MY-IMPORT (note it can't be called IMPORT b/c that
              ;; clashes with CL's built-in IMPORT).
              (setf import-fn (symbol-function (find-symbol "MY-IMPORT")))
            (funcall import-fn)))
          (setf found t)
          (return))))

    (unless found (error "None of ~{~A~^ ~} loaded" dbs))))
;;;-----------------------------

;;;-----------------------------
(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless (and (= 3 (length *posix-argv*)) ; Perl skips past executable
               (= 2 (length (perl-grep *posix-argv* ; PERL-GREP defined in Appendix
                              (scan "^\\d+$" it)))))
    (error "usage: ~A num1 num2" (car *posix-argv*))))

(require :some.module)
(require :more.modules)
;;;-----------------------------
;; This would be silly since CL's numbers already are "big".
(when opt-b (require :math.bigint)) 
;;;-----------------------------
;; The following is just to make the examples work.
(defpackage :fcntl (:use cl))
(in-package :fcntl)
(defconstant +O-EXCL+ #x800)
(defconstant +O-CREAT+ #x200)
(defconstant +O-RDWR+ #x2)

(export '(+O-EXCL+ +O-CREAT+ +O-RDWR+))
(provide 'fcntl)

(defpackage :my-package
  (:use cl)
  (:import-from :fcntl +O-EXCL+ +O-CREAT+ +O-RDWR+))
(in-package :my-package)
;;;-----------------------------
(require :fcntl)
(import '(fcntl:+O-EXCL+ fcntl:+O-CREAT+ fcntl:+O-RDWR+))
;;;-----------------------------
(in-package cl-user)
(defun load-module (module)
  (require module)
  (import module))                      ; WRONG
;;;-----------------------------
(load-module :fcntl '(fcntl:+O-EXCL+ fcntl:+O-CREAT+ fcntl:+O-RDWR+))
(defun load-module (module symbols)
  (require module)
  ;; No need for die because REQUIRE will do it for us.
  (import symbols))
;;;-----------------------------
;; CL doesn't have anything like Perl's autouse, as far as I can tell.
;; The following is a rough implementation of it.  Usage:
;;   (autouse 'my-package (xyz abc))
;; Where XYZ and ABC are functions defined within MY-PACKAGE.
(defmacro autouse (pack symbols)
  (list*
   'progn
   (loop
      for symb in symbols
      collect
        `(defun ,symb (&rest args)
           (require ',pack)
           (apply (find-symbol ,(symbol-name symb) ',pack) args)))))
;;;-----------------------------

;;;-----------------------------
(defpackage :alpha (:use :cl))
(in-package :alpha)

(defparameter aa 10)
(export 'aa)
(defparameter x "azure")

(defpackage :beta (:use :cl))
(in-package :beta)

(defparameter bb 20)
(export 'bb)
(defparameter x "blue")

(in-package :cl-user)         ; closest thing to Perl's 'main' package
;; Unlike the Perl example, without the explict EXPORT and IMPORT the
;; symbols won't be visible in the CL-USER package.
(import '(alpha:aa beta:bb))
(format t "~A, ~A, ~A, ~A, ~A~%" aa bb (if (boundp 'x) x "") alpha::x beta::x)
;; 10, 20, , azure, blue
;;;-----------------------------
;; flipper.lisp
(defpackage :flipper
  (:use cl cl-ppcre)
  (:export flip-words flip-boundary))
(in-package :flipper)

(defvar *separatrix* #\Space) ; default to blank; must precede functions

(defun flip-boundary (&optional separatrix)
  (prog1 *separatrix*
    (when separatrix
      (setf *separatrix* separatrix))))

(defun flip-words (line)
  (let ((words (split *separatrix* line)))
    (format nil (format nil "~~{~~A~~^~A~~}" *separatrix*) (reverse words))))
;;;-----------------------------
    

;;;-----------------------------
;; #. forces *PACKAGE* to be evaluated at compile-time, so that it
;; won't pick up the dynamic value of *PACKAGE* (i.e., the package of
;; the calling function, which may be different.)
(setf this-pack #.*package*)
;;;-----------------------------
;; As long as the following does not appear at the "top level" of the
;; file, it will contain the current package (i.e., the "outermost"
;; calling function's, assuming it hasn't been rebound explicitly.)
(setf that-pack *package*)
;;;-----------------------------
(format t "I am in package *package*~%")        ; WRONG!
;; I am in package *package*
;;;-----------------------------
(defpackage :alpha (:use cl beta))
(in-package :alpha)

;; As (I think) the Perl example does, this presupposes that TEMP is
;; set to an already-open stream (in BETA), e.g.:
;;  (setf temp (open "/usr/share/dict/words"))
(runit "(setf line (read-line temp))")

(defpackage :beta 
  (:use cl)
  (:export runit))
(in-package :beta)

(defun runit (codestr)
  ;; The following is not a good idea, but is intended to make this
  ;; example work the way the Perl one does, by causing the EVAL to
  ;; occur in the context of this package (BETA) rather than the
  ;; caller's (ALPHA's).
  (in-package #.(package-name *package*))
  ;; EVAL will throw an error if there's any problems, no need to do
  ;; it explicitly like the Perl does.
  (eval (read-from-string codestr)))
;;;-----------------------------
(defpackage :beta 
  (:use cl)
  (:export runit))
(in-package :beta)

(defun runit (codestr)
  ;; CL is essentially the reverse of Perl in this regard, the default
  ;; behavior already works the right way without the need to use
  ;; something like Perl's 'caller'.
  (eval (read-from-string codestr)))
;;;-----------------------------
(defpackage :alpha (:use cl beta))
(in-package :alpha)

(runit (lambda () (setf line (read-line temp))))

(defpackage :beta
  (:use cl)
  (:export runit))
(in-package :beta)

(defun runit (coderef)
  (funcall coderef))
;;;-----------------------------
(in-package cl-user)

(defparameter *fh* (open "/etc/services")) ; don't have /etc/termcap on my machine
(multiple-value-setq (a b c) (values-list (nreadline 3 "*fh*")))

(defun nreadline (count handle)
  (unless (plusp count) (error "COUNT must be > 0"))
  (let ((handle (symbol-value (find-symbol (string-upcase handle)))))
    (unless (open-stream-p handle)
      (error "need open filehandle"))
    (loop
       repeat count
       collect (read-line handle))))
;;;-----------------------------

;;;-----------------------------
;; In section 12.7 we assume the use of ASDF, which is the de facto
;; standard package mechanism.
(loop 
   for path in asdf:*central-registry*
   for i from 0
   do (format t "~D ~A~%" i path))
;;0 /Users/mongo/moogle-code/cl-fnord/
;;1 /Users/mongo/common-lisp.net/cl-zztop/trunk/
;;2 (MERGE-PATHNAMES .sbcl/systems/ (USER-HOMEDIR-PATHNAME))
;;3 (LET ((HOME (POSIX-GETENV SBCL_HOME)))
;;    (WHEN HOME (MERGE-PATHNAMES site-systems/ (TRUENAME HOME))))
;;4 *DEFAULT-PATHNAME-DEFAULTS*

;;;-----------------------------
(pushnew "/projects/spectre/lib" asdf:*central-registry*)
;;;-----------------------------
(require :find-bin)
(pushnew find-bin::*bin* asdf:*central-registry*)
;;;-----------------------------
(shadowing-import find-bin::*bin*)
(pushnew (concatenate 'string *bin* "/../lib"))
;;;-----------------------------