Improve in-file symbol exports

This commit is contained in:
~keith 2024-06-12 17:37:57 -04:00
parent 174f6e5452
commit 4449774b73
Signed by: keith
GPG key ID: 5BEBEEAB2C73D520
4 changed files with 93 additions and 19 deletions

View file

@ -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
View 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))))

View file

@ -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)

View file

@ -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)