Improve in-file symbol exports
This commit is contained in:
parent
174f6e5452
commit
4449774b73
4 changed files with 93 additions and 19 deletions
|
@ -5,4 +5,5 @@ Syrup is a simple package providing syntax enhancements to Common Lisp.
|
||||||
Right now it doesn't do much, but I'll add new features as I think of them.
|
Right now it doesn't do much, but I'll add new features as I think of them.
|
||||||
|
|
||||||
- `#^sym` to export a symbol inline
|
- `#^sym` to export a symbol inline
|
||||||
|
- Multi-file projects using this syntax should probably also use `(syrup:defpackage*)`
|
||||||
- `[]` and `{}` can be used in place of normal parentheses
|
- `[]` and `{}` can be used in place of normal parentheses
|
||||||
|
|
86
exports.lisp
Normal file
86
exports.lisp
Normal file
|
@ -0,0 +1,86 @@
|
||||||
|
(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))))
|
|
@ -4,4 +4,6 @@
|
||||||
:author "~keith <keith@keithhacks.cyou>"
|
:author "~keith <keith@keithhacks.cyou>"
|
||||||
:homepage "https://bytes.keithhacks.cyou/keith/syrup"
|
:homepage "https://bytes.keithhacks.cyou/keith/syrup"
|
||||||
:license "Public Domain/CC0"
|
:license "Public Domain/CC0"
|
||||||
:components ((:file "syrup")))
|
:components ((:file "syrup")
|
||||||
|
(:file "exports"))
|
||||||
|
:serial t)
|
||||||
|
|
21
syrup.lisp
21
syrup.lisp
|
@ -1,26 +1,11 @@
|
||||||
(defpackage #:syrup
|
(defpackage #:syrup
|
||||||
(:use #:cl))
|
(:use #:cl)
|
||||||
|
(:export
|
||||||
|
#:*capture-exports* #:*exports* #:export* #:defpackage* #:mark-package-file))
|
||||||
(in-package #:syrup)
|
(in-package #:syrup)
|
||||||
|
|
||||||
(define-condition simple-reader-error (simple-condition reader-error) ())
|
(define-condition simple-reader-error (simple-condition reader-error) ())
|
||||||
|
|
||||||
;; #^ - 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)))
|
|
||||||
(export sym)
|
|
||||||
sym))
|
|
||||||
(set-dispatch-macro-character #\# #\^ #'read-exported-symbol)
|
|
||||||
|
|
||||||
;; Use [] and {} like normal parentheses
|
;; Use [] and {} like normal parentheses
|
||||||
;; NOTE: You'll have to add superfluous-parentheses.el to Emacs to get it to recognize this syntax
|
;; NOTE: You'll have to add superfluous-parentheses.el to Emacs to get it to recognize this syntax
|
||||||
(defun read-bracketed-list (stream begin-char)
|
(defun read-bracketed-list (stream begin-char)
|
||||||
|
|
Loading…
Reference in a new issue