Skip to content

Commit 19f4829

Browse files
tfebtfeb
committed
Add build-modules, feature-expressions
This will be v5.0.0
1 parent 0b08525 commit 19f4829

File tree

5 files changed

+312
-9
lines changed

5 files changed

+312
-9
lines changed

‎README.md

Lines changed: 112 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,10 @@
11
# [TFEB.ORG Lisp tools](https://github.com/tfeb/tfeb-lisp-tools "TFEB.ORG Lisp tools")
2-
This repo contains a system which will be a collection of fairly miscellaneous Common Lisp tools, which I have written over the years in order to generally get stuff done. Currently only two are published here:
2+
This repo contains a system which will be a collection of fairly miscellaneous Common Lisp tools, which I have written over the years in order to generally get stuff done. Here, a *tool* is a thing which helps with building programs, loading modules and similar things, rather than something you might use *in* a program.
33

44
- `require-module` provides variants of `require` which will search for modules, as well as the mechanisms to control the search, and also a variant of `provide` which keeps records of the file which provided a module;
55
- `install-providers` makes use of the records of module providers kept by `require-module` in order to copy them to places they will be found.
6+
- `build-modules` provides a way of compiling a collection of single-file modules, using `require-module` to locate their sources.
7+
- `feature-expressions` provides some tools for reasoning about implementation features after read time.
68

79
I hope to add more tools as I disentangle them from the things they're currently entangled with and modernise them where needed. All of the tools are intended to be portable CL except where documented.
810

@@ -265,6 +267,9 @@ Additionally, **`provides`** is a counterpart to `requires` and `needs`: it let
265267

266268
This is particularly useful for modules consisting of several files (with a 'loader' file to load them all): the forms given in `after-require-module` are run after the whole module is loaded.
267269

270+
### Errors
271+
**`require-module-error`** is a condition class, and all errors signalled directly by any of the functions in the packages are of this class or, potentially, subclasses of it. Currently it's a subclass of `simple-error` but it may not always be so. Errors signalled by things `require-module` may call, such as `require` may not be of this class however.
272+
268273
### Other functionality
269274
There is a mechanism for adding wrappers around the process of actually providing a module (after its file has been located). This is not yet documented here, but its main use has been to arrange to forget about system definitions for modules which involve some system definition tool, so the LispWorks development environment doesn't get cluttered up with system definitions that are not interesting. It's also used to implement `after-require-module`, above. This mechanism is subject to change.
270275

@@ -364,7 +369,7 @@ nil
364369

365370
This second example is betraying the fact that I'm on a Mac: the mac's filesystem is case-insensitive / case-preserving, so the file is being found with an uppercase filename, when its name is 'really' lowercase. If you provide the `debug`argument to `locate-module` you will get even more verbose output.
366371

367-
### A nice trick
372+
### Falling back to Quicklisp
368373
If you have Quicklisp, this works:
369374

370375
```lisp
@@ -375,6 +380,19 @@ If you have Quicklisp, this works:
375380

376381
Which means you can write small programs which rely on Quicklisp to fetch and load things without either an ASDF system definition, or a bunch of explicit `eval-when`s in the sources to load things at compile time. In fact it is pretty much possible to use `needs` to informally define systems without a central system definition, even when those systems have dependencies on Quicklisp or other systems.
377382

383+
Another way of doing this, more globally, is
384+
385+
```lisp
386+
(defun load-module/ql (m)
387+
(handler-case
388+
(ql:quickload m :verbose nil :silent t)
389+
(ql:system-not-found () nil)))
390+
391+
(pushnew 'load-module/ql *module-fallback-loaders*)
392+
```
393+
394+
I have essentially this code in my init files.
395+
378396
### Deficiencies
379397
There are no docstrings for anything: there should at least be brief ones. There are no error or warning conditions defined which there should be. Wrappers are not documented.
380398

@@ -429,9 +447,100 @@ Would
429447
nil
430448
```
431449

450+
## Building installed modules: `build-modules`
451+
I have a significant collection of single-file modules which generally don't have overriding ASDF or other system definitions. `require-module` and its wrappers – `needs` is the interface I use most commonly – will arrange for modules which exist only as sources or for which the FASLs are out of date to be compiled on demand if needed. Sometimes it's nice to point at a whole collection of module files in a source directory and say 'compile all of the installed versions of these that need to be compiled': that's what `build-modules` is for.
452+
453+
**`compile-installed-modules`** ensures installed copies of a number of single-file modules are compiled, using `locate-module` to find the installed modules to consider. Arguments:
454+
455+
- `prefix`is a string designator for the module prefix, canonicalised to an upper-case string;
456+
- `files`is a list of pathname designators (typically source files, but only the name components of the pathnames are used) corresponding to the modules to be compiled.
457+
458+
Keyword arguments:
459+
460+
`omit` is a list of pathname designators (or a single pathname designator) of files to omit – generally these will be wild pathnames – default `()`;
461+
`only` is the opposite of `omit` – if given it means consider only these files – default `()`;
462+
`force`, if true, says to compile the modules even if the compiled files seems already to be up to date, default `nil`;
463+
`verbose` says to be more verbose, default `nil`;
464+
`pretend` says to pretend, default `nil`.
465+
466+
`compile-installed-modules` returns a list of the things it compiled. Each element of the list is a list of the local source file, the corresponding module source file, and the module name.
467+
468+
### An example
469+
Pretending to compile the modules in the tools source directory.
470+
471+
```lisp
472+
> (compile-installed-modules
473+
"org.tfeb.tools" (directory "*.lisp")
474+
:omit '("sysdcl" "*-cometh" "*-loader")
475+
:pretend t :verbose t)
476+
Would skip /System/Volumes/Data/Local/tfb/packages/quicklisp/local-projects/org/tfeb/tools/ensuring-features.lisp
477+
for ORG.TFEB.TOOLS.ENSURING-FEATURES
478+
from /Users/tfb/src/lisp/systems/tools/ensuring-features.lisp
479+
as fasl is newer
480+
Would skip /System/Volumes/Data/Local/tfb/packages/quicklisp/local-projects/org/tfeb/tools/require-module.lisp
481+
for ORG.TFEB.TOOLS.REQUIRE-MODULE
482+
from /Users/tfb/src/lisp/systems/tools/require-module.lisp
483+
as fasl is newer
484+
Would compile /System/Volumes/Data/Local/tfb/packages/quicklisp/local-projects/org/tfeb/tools/build-modules.lisp
485+
for ORG.TFEB.TOOLS.BUILD-MODULES
486+
from /Users/tfb/src/lisp/systems/tools/build-modules.lisp
487+
Would skip /System/Volumes/Data/Local/tfb/packages/quicklisp/local-projects/org/tfeb/tools/install-providers.lisp
488+
for ORG.TFEB.TOOLS.INSTALL-PROVIDERS
489+
from /Users/tfb/src/lisp/systems/tools/install-providers.lisp
490+
as fasl is newer
491+
((#P"/Users/tfb/src/lisp/systems/tools/build-modules.lisp"
492+
#P"/System/Volumes/Data/Local/tfb/packages/quicklisp/local-projects/org/tfeb/tools/build-modules.lisp"
493+
"ORG.TFEB.TOOLS.BUILD-MODULES"))
494+
```
495+
496+
Here only `build-modules` itself would need to be compiled, as the FASL is out of date with the source.
497+
498+
### Notes
499+
`build-modules` is only really useful for single-file modules which deal with their own interdependencies: it's not anything like a replacement for a system definition tool. I have lots of these however, so it's useful for me.
500+
501+
### Package, module
502+
`build-modules` lives in`org.tfeb.tools.build-modules` and provides `:org.tfeb.tools.build-modules`.
503+
504+
## Implementation features: `feature-expressions`
505+
CL's `#+` and `#-` syntax lets you evaluate [feature expressions](https://www.lispworks.com/documentation/HyperSpec/Body/24_aba.htm "Feature Expressions") – boolean expressions based on the [`*features*` variable](https://www.lispworks.com/documentation/HyperSpec/Body/v_featur.htm#STfeaturesST "*features*") – at *read* time, but without cleverness no later than that. This is ideal to cope with syntax that can't be read unless some feature is present, such as packages which may not exist, or for differences between implementations, as a compiled file whose source was read by one implementation is not likely to be useful in another.
506+
507+
But sometimes you want to check features of the implementation later than read time, or you want to know that a feature expression that was true at read time (and hence probably at compile time) is still true at load time (and hence probably at run time). Sometimes also you might want to evaluate a feature expression directly, or to more generally write conditionals based on feature expressions. This is what `feature-expressions` lets you do.
508+
509+
**`evaluate-feature-expression`** is a function which evaluates feature expressions as described in [the spec](http://www.lispworks.com/documentation/HyperSpec/Body/24_aba.htm "Feature Expressions"), with the possible restriction that operators (`or`, `and` etc) need to be symbols in the `CL` package. It has a compiler macro which will compile feature expressions which satisfy `constantp` into equivalent code.
510+
511+
**`feature-case`** is a macro which dispatches on feature expressions. It is like `typecase` rather than `case`: its body is a series of clauses of which the first elements are either feature expressions or one of the symbols `otherwise` or `t`, and whose remaining elements are forms to be evaluated if the feature expression is true, or in the case of `otherwise` or `t`, in any case. An example:
512+
513+
```lisp
514+
(feature-case
515+
(:LispWorks
516+
...)
517+
((or :SBCL :CMUCL)
518+
...)
519+
(otherwise
520+
...))
521+
```
522+
523+
One result of these rules is that, if you expect there to be features named `otherwise` or `t` (which seems unlikely), you would need to check for them by a feature expression like, for instance `(or otherwise)`.
524+
525+
**`ensuring-features`** is a macro designed to be used at top level, and whose purpose is to make assertions about various features at various times in the processing of the file. Its body consists of number of clauses. Each clause consists of `(<time> [<feature-expression> ...])`, where `<time>` either a specification suitable for [`eval-when`](https://www.lispworks.com/documentation/HyperSpec/Body/s_eval_w.htm "eval-when") or `t`, which is a shorthand for `(:compile-toplevel :load-toplevel :execute)`. Each `<feature-expression>` is a feature expression, to be evaluated by `evaluate-feature-expression` as above.
526+
527+
`ensuring-features` expands into suitable `eval-when` expressions which will ensure that the specified feature expressions are true at the appropriate times, signalling an informative error if not.
528+
529+
### Example
530+
```lisp
531+
(ensuring-features
532+
((:load-toplevel)
533+
:org.tfeb.tools.feature-expressions))
534+
```
535+
536+
This will ensure that `:org.tfeb.tools.feature-expressions` is present as a feature at load time (but it need not be at compile time or any other time). `feature-expressions` contains this form in its own source code: the feature will not be present when it is being compiled, but will be when it is being loaded.
537+
538+
### Package, module, feature
539+
`feature-expressions` lives in `org.tfeb.tools.feature-expressions`, provides `:org.tfeb.tools.feature-expressions` and also pushes a feature with this name onto `*features*`.
540+
432541
---
433542

434-
The TFEB.ORG tools are copyright 2002, 2012, 2020-2021 Tim Bradshaw. See `LICENSE` for the license.
543+
The TFEB.ORG tools are copyright 2002, 2012, 2020-2022 Tim Bradshaw. See `LICENSE` for the license.
435544

436545
---
437546

‎build-modules.lisp

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
;;;; Some rudimentary support for building modules
2+
;;;
3+
4+
#-org.tfeb.tools.require-module
5+
(eval-when (:compile-toplevel :load-toplevel :execute)
6+
(error "No require-module"))
7+
8+
(defpackage :org.tfeb.tools.build-modules
9+
(:use :cl :org.tfeb.tools.require-module)
10+
(:export
11+
#:compile-installed-modules))
12+
13+
(in-package :org.tfeb.tools.build-modules)
14+
15+
(provide :org.tfeb.tools.build-modules)
16+
17+
(defun pathname-matches-any-p (pathname wilds)
18+
;; Does PATHNAME match any of a number of possible wildcards?
19+
(dolist (wild wilds nil)
20+
(when (pathname-match-p pathname
21+
(merge-pathnames (pathname wild) pathname))
22+
(return-from pathname-matches-any-p t))))
23+
24+
(defun compile-installed-modules (prefix files &key
25+
(omit '() omitp)
26+
(only '() onlyp)
27+
(force nil)
28+
(verbose nil) (pretend nil))
29+
(let ((pfx (string-upcase (string prefix)))
30+
(compiled '()))
31+
(dolist (file files (nreverse compiled))
32+
(let ((path (pathname file)))
33+
(unless (and omitp (pathname-matches-any-p path
34+
(if (listp omit)
35+
omit
36+
(list omit))))
37+
(when (or (not onlyp) (pathname-matches-any-p path
38+
(if (listp only)
39+
only
40+
(list only))))
41+
(let ((module-name (format nil "~A.~A"
42+
pfx
43+
(string-upcase (pathname-name
44+
(pathname file))))))
45+
(multiple-value-bind (load-file source-file source-date
46+
fasl-file fasl-date)
47+
(locate-module module-name)
48+
(declare (ignore source-date fasl-date))
49+
(cond
50+
((not load-file)
51+
(error "found nothing for ~A, from ~A" module-name file))
52+
((not source-file)
53+
(warn "no source for ~A, from ~A, but fasl ~A"
54+
module-name file fasl-file))
55+
((and (not force)
56+
(equal load-file fasl-file))
57+
(when verbose
58+
(format *debug-io*
59+
"~&~A ~A~% for ~A~% from ~A~% as fasl is newer~%"
60+
(if pretend "Would skip" "Skipping")
61+
source-file module-name file)))
62+
(t
63+
(when verbose
64+
(format *debug-io*
65+
"~&~A ~A~% for ~A~% from ~A~%"
66+
(if pretend "Would compile" "Compiling")
67+
source-file module-name path))
68+
(push (list path source-file module-name) compiled)
69+
(unless pretend
70+
(compile-file source-file))))))))))))

‎feature-expressions.lisp

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
;;;; Ensuring features are present
2+
;;;
3+
4+
(defpackage :org.tfeb.tools.feature-expressions
5+
(:use :cl)
6+
(:export
7+
#:evaluate-feature-expression
8+
#:feature-case
9+
#:ensuring-features))
10+
11+
(in-package :org.tfeb.tools.feature-expressions)
12+
13+
(provide :org.tfeb.tools.feature-expressions)
14+
15+
;;; This is useful so you can conditionalise this code itself
16+
(pushnew :org.tfeb.tools.feature-expressions *features*)
17+
18+
(defun featurep (thing)
19+
;; evaluate an atomic feature expression
20+
(and (member (string thing) *features*
21+
:test #'string-equal :key #'symbol-name)
22+
t))
23+
24+
(defun evaluate-feature-expression (expression)
25+
;; This should implement what #+ / #- implement, with the possible
26+
;; exception that OR, AND and NOT need to be CL:OR, CL:AND, CL:NOT
27+
(typecase expression
28+
(cons
29+
(destructuring-bind (op . arguments) expression
30+
(case op
31+
(or
32+
(some #'evaluate-feature-expression arguments))
33+
(and
34+
(every #'evaluate-feature-expression arguments))
35+
(not
36+
(unless (= (length arguments) 1)
37+
(error "Bad feature expression"))
38+
(not (evaluate-feature-expression (first arguments))))
39+
(otherwise
40+
(error "unknown feature operator ~S" op)))))
41+
(t
42+
(featurep expression))))
43+
44+
(define-compiler-macro evaluate-feature-expression (&whole form expression)
45+
(if (constantp expression)
46+
(labels ((compile-expression (expression)
47+
(typecase expression
48+
(cons
49+
(destructuring-bind (op . arguments) expression
50+
(case op
51+
((or and)
52+
`(,op ,@(mapcar #'compile-expression arguments)))
53+
((not)
54+
(unless (= (length arguments) 1)
55+
(error "Bad feature expression"))
56+
`(not ,(compile-expression (first arguments))))
57+
(otherwise
58+
(error "unknown feature operator ~S" op)))))
59+
(t `(featurep ',expression)))))
60+
(compile-expression (if (and (listp expression)
61+
(eql (first expression) 'quote)
62+
(= (length expression) 2))
63+
(second expression)
64+
expression)))
65+
form))
66+
67+
(defmacro feature-case (&body clauses)
68+
`(cond
69+
,@(mapcar (lambda (clause)
70+
(unless (consp clause)
71+
(error "illegal atomic clause"))
72+
(destructuring-bind (expression &rest forms) clause
73+
(case expression
74+
((otherwise t)
75+
`(t ,@forms))
76+
(otherwise
77+
`((evaluate-feature-expression ',expression)
78+
,@forms)))))
79+
clauses)))
80+
81+
(define-condition feature-error (error)
82+
((feature :initarg :feature
83+
:reader feature-error-feature)
84+
(time :initarg :time
85+
:reader feature-error-time))
86+
(:report
87+
(lambda (mfe stream)
88+
(format stream "Feature expression ~S failed at ~S time"
89+
(feature-error-feature mfe)
90+
(feature-error-time mfe)))))
91+
92+
(defmacro ensuring-features (&body clauses)
93+
;; The interface
94+
`(progn
95+
,@(mapcar (lambda (clause)
96+
(destructuring-bind (time . feature-expressions) clause
97+
`(eval-when ,(if (eq time t)
98+
'(:compile-toplevel :load-toplevel :execute)
99+
time)
100+
,@(mapcar (lambda (feature-expression)
101+
`(unless (evaluate-feature-expression
102+
',feature-expression)
103+
(error 'feature-error
104+
:feature ',feature-expression
105+
:time ',time)))
106+
feature-expressions))))
107+
clauses)))
108+
109+
(ensuring-features
110+
((:load-toplevel)
111+
:org.tfeb.tools.feature-expressions))

‎org.tfeb.tools.asd

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,12 +5,16 @@
55

66
(defsystem "org.tfeb.tools"
77
:description "TFEB tools"
8-
:version "4.2"
8+
:version "5.0.0"
99
:author "Tim Bradshaw"
1010
:licence "MIT"
1111
:homepage "https://github.com/tfeb/tfeb-lisp-tools"
1212
:components
1313
((:file "require-module")
1414
(:file "install-providers" :depends-on ("require-module"))
15+
(:file "build-modules" :depends-on ("require-module"))
16+
(:file "feature-expressions")
1517
(:file "tools-cometh" :depends-on ("require-module"
16-
"install-providers"))))
18+
"install-providers"
19+
"build-modules"
20+
"feature-expressions"))))

0 commit comments

Comments
 (0)