86 lines
3.5 KiB
Common Lisp
86 lines
3.5 KiB
Common Lisp
(in-package #:syrup)
|
|
|
|
(defvar *capture-exports* nil
|
|
"If non-nil, #^ doesn't export symbols. Either T, NIL, or the package to be monitored.")
|
|
(defvar *exports* nil
|
|
"List of captured symbol exports.")
|
|
|
|
(defvar *package-files-table* (make-hash-table :weakness :key :synchronized t)
|
|
"Hashtable of per-package file lists which exported symbols via Syrup macros.")
|
|
|
|
(defun mark-package-file ()
|
|
(pushnew (or *compile-file-truename* *load-truename*)
|
|
(gethash *package* *package-files-table*)))
|
|
|
|
;; #^ - Inline symbol export macro
|
|
;; Use #^SYMBOL or #^(SYMBOL) to export a symbol at the location it's defined.
|
|
(defun read-exported-symbol (stream char arg)
|
|
"Read a symbol (optionally wrapped in parens) and export it"
|
|
(declare (ignore char arg))
|
|
(let ((sym (read stream t nil t)))
|
|
(when (and (consp sym) (not (cdr sym)))
|
|
(setf sym (car sym))) ;; allow wrapping symbol in parens
|
|
(unless (symbolp sym)
|
|
(error 'simple-reader-error
|
|
:stream stream
|
|
:format-control "Not a symbol: ~S"
|
|
:format-arguments (list sym)))
|
|
(if *capture-exports*
|
|
(when (or (eq t *capture-exports*) (eq *package* *capture-exports*))
|
|
(push sym *exports*))
|
|
(progn (mark-package-file)
|
|
(export sym)))
|
|
sym))
|
|
(set-dispatch-macro-character #\# #\^ #'read-exported-symbol)
|
|
|
|
(defun ensure-symbol (sym)
|
|
(etypecase sym
|
|
(symbol
|
|
(if (and (symbol-package sym) (not (keywordp sym)))
|
|
sym
|
|
(intern (symbol-name sym))))
|
|
(string
|
|
(intern sym))))
|
|
|
|
(defmacro export* (&rest symbols)
|
|
(mark-package-file)
|
|
`(export ',(mapcar #'ensure-symbol symbols)))
|
|
|
|
(defun read-stream-for-exports (stream &optional target-package)
|
|
"Read Lisp source code from STREAM to determine the list of symbols it exports."
|
|
(when target-package
|
|
(let ((pkg (find-package target-package)))
|
|
(assert pkg () "No such package ~S" target-package)
|
|
(setf target-package pkg)))
|
|
(let ((*package* *package*)
|
|
(*readtable* *readtable*)
|
|
(*capture-exports* (or target-package t))
|
|
(*exports* nil)
|
|
(eof-sentinel (make-symbol "eof-sentinel")))
|
|
(loop for form = (read stream nil eof-sentinel)
|
|
until (eq form eof-sentinel)
|
|
do (when (consp form)
|
|
(if (eql (car form) 'in-package)
|
|
(let ((pkg (find-package (cadr form))))
|
|
(assert pkg () "No such package ~S" (cadr form))
|
|
(setf *package* pkg)
|
|
(if (eq t *capture-exports*)
|
|
(setf *capture-exports* pkg)))
|
|
(when (and (eql (car form) 'export*)
|
|
(eq *package* *capture-exports*))
|
|
(setf *exports* (nconc (mapcar #'ensure-symbol (cdr form)) *exports*))))))
|
|
*exports*))
|
|
|
|
(defmacro defpackage* (package-name &rest options)
|
|
"Wrapper around uiop:define-package that tries to be aware of symbols exported in other files."
|
|
(let ((extra-exports nil)
|
|
(pkg (find-package package-name)))
|
|
(when pkg
|
|
(dolist (pathname (gethash pkg *package-files-table*))
|
|
(let ((exports (with-open-file (stream pathname :if-does-not-exist nil)
|
|
(read-stream-for-exports stream pkg))))
|
|
(format *error-output* "Exports from ~S:~% ~S~%" pathname exports)
|
|
(setf extra-exports (nconc exports extra-exports)))))
|
|
`(uiop:define-package ,package-name
|
|
(:export ,@(cdr (assoc :export options)) ,@extra-exports)
|
|
,@(remove :export options :key #'car))))
|