From 9f4ca54103b887f987d5d005cacc9fda2c2b7125 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Sat, 11 Jul 2026 11:03:18 -0700 Subject: [PATCH 1/2] Add a tree diagram to the syntax paths grimoire section Co-Authored-By: Claude Fable 5 --- grimoire/syntax-path.scrbl | 57 +++++++++++++++++++++++++++++++++++++- info.rkt | 3 +- 2 files changed, 58 insertions(+), 2 deletions(-) diff --git a/grimoire/syntax-path.scrbl b/grimoire/syntax-path.scrbl index 4347a82..d4eed5f 100644 --- a/grimoire/syntax-path.scrbl +++ b/grimoire/syntax-path.scrbl @@ -1,7 +1,8 @@ #lang scribble/manual -@(require (for-label racket/base +@(require pict + (for-label racket/base racket/contract/base racket/sequence racket/treelist @@ -11,6 +12,53 @@ resyntax/grimoire/syntax-path)) +@; A tree diagram showing how the syntax path /2/0 addresses a node: labeled +@; nodes show their own paths, and the doubly-circled node is the one the +@; path refers to. +@(define syntax-path-tree-diagram + (let () + (define node-diameter 42) + (define (node #:label [label #false] #:highlight? [highlight? #false]) + (define base + (if highlight? + (cc-superimpose (circle node-diameter) (circle (- node-diameter 8))) + (circle node-diameter))) + (if label + (cc-superimpose base (text label '(bold . modern) 10)) + base)) + (define root (node #:label "/")) + (define child0 (node)) + (define child1 (node)) + (define child2 (node #:label "/2")) + (define grandchild10 (node)) + (define grandchild11 (node)) + (define grandchild20 (node #:label "/2/0" #:highlight? #true)) + (define grandchild21 (node)) + (define level-gap 45) + (define sibling-gap 25) + (define subtree1 + (vc-append level-gap child1 (ht-append sibling-gap grandchild10 grandchild11))) + (define subtree2 + (vc-append level-gap child2 (ht-append sibling-gap grandchild20 grandchild21))) + (define bottom-row (ht-append 45 child0 subtree1 subtree2)) + (define tree (vc-append level-gap root bottom-row)) + (define (connect base parent child i #:x-adjust [x-adjust 0]) + (pin-line base parent cb-find child ct-find + #:label (text (number->string i) 'modern 11) + #:x-adjust-label x-adjust)) + (define diagram + (let* ([p tree] + [p (connect p root child0 0 #:x-adjust -8)] + [p (connect p root child1 1 #:x-adjust -8)] + [p (connect p root child2 2 #:x-adjust 8)] + [p (connect p child1 grandchild10 0 #:x-adjust -8)] + [p (connect p child1 grandchild11 1 #:x-adjust 8)] + [p (connect p child2 grandchild20 0 #:x-adjust -8)] + [p (connect p child2 grandchild21 1 #:x-adjust 8)]) + p)) + (inset diagram 10))) + + @title[#:tag "syntax-path"]{Syntax Paths} @defmodule[resyntax/grimoire/syntax-path] @@ -23,6 +71,13 @@ print in a filesystem-like notation --- the path @racket[(syntax-path (list 1 2 program in a way that doesn't depend on exact source locations or syntax object identity, and which is relatively stable when structure-preserving edits are made to source text. +For example, the path @racket[(syntax-path (list 2 0))] refers to the doubly-circled node in the +syntax tree below: starting from the root, it descends into the root's child at index @racket[2], +then into that form's child at index @racket[0]. Each labeled node is annotated with the syntax +path that refers to it. + +@centered[syntax-path-tree-diagram] + The children of a syntax object are determined by the shape of its datum: @itemlist[ diff --git a/info.rkt b/info.rkt index b969d4a..04a887e 100644 --- a/info.rkt +++ b/info.rkt @@ -26,7 +26,8 @@ (define build-deps - (list "racket-doc" + (list "pict-lib" + "racket-doc" "rackunit-lib" "scribble-lib")) From 6f240caf9b6021cd05485150b6150e3e8bb3d8cb Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Sat, 11 Jul 2026 14:07:11 -0700 Subject: [PATCH 2/2] Use pict/tree-layout for the syntax path tree diagram The manual layout pinned edges to the tops and bottoms of nodes, which looked odd. Tree layouts draw edges between node centers, so the nodes now have opaque fills to mask the lines, and the child-index labels are pinned onto the edges after layout since tree layouts can't label edges themselves. Co-Authored-By: Claude Fable 5 --- grimoire/syntax-path.scrbl | 53 ++++++++++++++++++++++++-------------- 1 file changed, 33 insertions(+), 20 deletions(-) diff --git a/grimoire/syntax-path.scrbl b/grimoire/syntax-path.scrbl index d4eed5f..870aeb6 100644 --- a/grimoire/syntax-path.scrbl +++ b/grimoire/syntax-path.scrbl @@ -2,6 +2,7 @@ @(require pict + pict/tree-layout (for-label racket/base racket/contract/base racket/sequence @@ -19,10 +20,14 @@ (let () (define node-diameter 42) (define (node #:label [label #false] #:highlight? [highlight? #false]) - (define base + (define outline (if highlight? (cc-superimpose (circle node-diameter) (circle (- node-diameter 8))) (circle node-diameter))) + ; The opaque fill hides the edge lines, which tree layouts draw from node center to node + ; center underneath the node picts. + (define base + (cc-superimpose (disk node-diameter #:color "white" #:draw-border? #false) outline)) (if label (cc-superimpose base (text label '(bold . modern) 10)) base)) @@ -34,27 +39,35 @@ (define grandchild11 (node)) (define grandchild20 (node #:label "/2/0" #:highlight? #true)) (define grandchild21 (node)) - (define level-gap 45) - (define sibling-gap 25) - (define subtree1 - (vc-append level-gap child1 (ht-append sibling-gap grandchild10 grandchild11))) - (define subtree2 - (vc-append level-gap child2 (ht-append sibling-gap grandchild20 grandchild21))) - (define bottom-row (ht-append 45 child0 subtree1 subtree2)) - (define tree (vc-append level-gap root bottom-row)) - (define (connect base parent child i #:x-adjust [x-adjust 0]) - (pin-line base parent cb-find child ct-find - #:label (text (number->string i) 'modern 11) - #:x-adjust-label x-adjust)) + (define layout + (tree-layout #:pict root + (tree-layout #:pict child0) + (tree-layout #:pict child1 + (tree-layout #:pict grandchild10) + (tree-layout #:pict grandchild11)) + (tree-layout #:pict child2 + (tree-layout #:pict grandchild20) + (tree-layout #:pict grandchild21)))) + (define tree (naive-layered layout #:x-spacing 25 #:y-spacing 45)) + ; Tree layouts can't label edges, so each child's index is pinned onto the finished tree at + ; the midpoint of the edge leading to that child, nudged sideways off the line by x-adjust. + (define (label-edge base parent child i #:x-adjust [x-adjust 0]) + (define-values (parent-x parent-y) (cc-find base parent)) + (define-values (child-x child-y) (cc-find base child)) + (define label (text (number->string i) 'modern 11)) + (pin-over base + (+ (/ (+ parent-x child-x) 2) x-adjust (- (/ (pict-width label) 2))) + (- (/ (+ parent-y child-y) 2) (/ (pict-height label) 2)) + label)) (define diagram (let* ([p tree] - [p (connect p root child0 0 #:x-adjust -8)] - [p (connect p root child1 1 #:x-adjust -8)] - [p (connect p root child2 2 #:x-adjust 8)] - [p (connect p child1 grandchild10 0 #:x-adjust -8)] - [p (connect p child1 grandchild11 1 #:x-adjust 8)] - [p (connect p child2 grandchild20 0 #:x-adjust -8)] - [p (connect p child2 grandchild21 1 #:x-adjust 8)]) + [p (label-edge p root child0 0 #:x-adjust -8)] + [p (label-edge p root child1 1 #:x-adjust -8)] + [p (label-edge p root child2 2 #:x-adjust 8)] + [p (label-edge p child1 grandchild10 0 #:x-adjust -8)] + [p (label-edge p child1 grandchild11 1 #:x-adjust 8)] + [p (label-edge p child2 grandchild20 0 #:x-adjust -8)] + [p (label-edge p child2 grandchild21 1 #:x-adjust 8)]) p)) (inset diagram 10)))