While hacking on Denxi I found a need for s-exp programs that can functionally refactor their enclosing source files. I defined a blossom as a kind of whole-program macro, and an experimental approach to self-hosting using only racket/base
.
Each (blossom _)
expands to start a search for its own call site. Any inconsistency in position information is treated as a sign the file has changed before the search started.
This version is not well-tested, but you can evaluate the commented require
expressions in a REPL to observe how blossoms navigate upward from a call site. The last case, demonstrates how a blossom omits code by "burning away" the module+
forms. Notice that the match
clause in burn
is really simple, because it does not have to care about preserving syntax that does not literally contain a blossom.
In the context of a self-hosting module, a blossom is a way to refactor code in terms of runtime information. How often have you added details to a program to make it shrink?
; A blossom is a unit of self-hosting functionality. It incrementally
; transforms code starting from the position of a macro call site. A
; blossom may consume code "beneath" it as it grows to encompass the
; entire source program.
;
; Revision date: May 6, 2022. Not thoroughly tested.
; Author: Sage Gerard (http://sagegerard.com)
(module blossoms racket/base
(require (for-syntax racket/base))
(define (bind-blossom form at continue fail)
(let/ec return
(define (root-plan)
(values form values root-plan))
(let loop ([suspect form] [plan root-plan])
(if (equal? at (sub1 (syntax-position suspect)))
(call-with-values
(lambda () (call-with-values plan continue))
return)
(let ([e (syntax-e suspect)])
(when (list? e)
(for ([(subform index) (in-indexed (in-list e))])
(loop subform
(lambda ()
(values subform
(lambda forms
(let loop ([i 0] [leading null] [trailing e])
(if (= i index)
(call-with-values plan
(λ (form* replace* plan*)
(values
(datum->syntax suspect
(append (reverse leading)
forms
(cdr trailing)))
replace*
plan*)))
(loop (add1 i)
(cons (car trailing) leading)
(cdr trailing)))))
plan))))))))
(fail)))
(define (bind-blossom/file path at continue fail)
(bind-blossom (call-with-input-file path
(lambda (i)
(port-count-lines! i)
(read-syntax (object-name i) i)))
at
continue
fail))
(define-syntax (blossom stx)
(define (coordinate accessor)
(or (accessor stx)
(raise-syntax-error 'blossom "cannot find position for use site" stx)))
(syntax-case stx ()
[(_ continue)
#`(bind-blossom/file #,(coordinate syntax-source)
#,(coordinate syntax-position)
continue
(lambda () (error 'blossom "use site moved")))]))
(module+ demo
(require racket/match
racket/pretty)
(define (show v)
(parameterize ([error-print-width 80])
(printf "~.s~n" (syntax->datum v))))
(define (grow-completely form replace plan)
(show form)
(call-with-values plan
(lambda (form* replace* plan*)
(if (eq? plan* plan)
(show form*)
(grow-completely form* replace* plan*)))))
(define (burn form replace plan)
(define dat (syntax->datum form))
(match dat
[`(module ,_ ...)
(writeln dat)]
[_
(call-with-values replace burn)]))
; C-x C-e after each of these in racket-mode, in a fresh REPL
; (require (submod "." demo bush branch twigs bloom))
; (require (submod "." demo bush branch bloom))
; (require (submod "." demo bush bloom))
; (require (submod "." demo bush branch twigs fire))
(module+ bush
(module+ branch
(module+ twigs
(module+ bloom
(blossom grow-completely))
(module+ fire
(blossom burn)))
(module+ bloom
(blossom grow-completely)))
(module+ bloom
(blossom grow-completely)))))