Self-Hosting racket/base programs with Blossoms

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? :slight_smile:

; 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)))))
2 Likes