Macro to Make Identifiers from String Diagram

Hi, Racket Discourse.

I am trying to write a macro using some bits of beautiful-racket so that I can provide a string encoding of a diagram and convert the letter names in the diagram to identifiers which are used to define metapict pts (points) bearing their coordinates. It ignores any empty spaces or dots.

When I call the macro, however, the resulting definitions do not seem to be correct, since I receive unbound identifier warnings when trying to reference them.

I am not very well-versed in writing macros, so take the code with a bit of salt, but the intent should be clear enough.

#lang br

(require metapict
         (for-syntax racket/list
                     racket/string))

(define-macro-cases parse-diagram
  [(parse-diagram WHOLE)
   (with-syntax* ([(ROW ...) ;; split the diagram up into rows and reverse them
                   (reverse (filter non-empty-string? (string-split (syntax->datum #'WHOLE) "\n")))]
                  [(Y   ...) ;; count the number of rows
                   (range (length (syntax->datum #'(ROW ...))))])
     #'(begin
         (parse-diagram ROW Y) ...))]
  
  [(parse-diagram ROW Y)
   (with-syntax* ([(COL ...) ;; split the row into columns
                   (filter non-empty-string? (string-split (syntax->datum #'ROW) ""))]
                  [(X   ...) ;; count the number of columns
                   (range (length (syntax->datum #'(COL ...))))])
     #'(begin
         (name-pt COL X Y) ...))])

(define-macro-cases name-pt
  [(name-pt " " X Y)
   #'(void)]

  [(name-pt "." X Y)
   #'(void)]
  
  [(name-pt SYM X Y) ;; name the pt at X Y by the symbol at X Y if it is not a space or a dot
   (with-pattern ([$NAME (prefix-id '$ #'SYM)])
     #'(define $NAME (pt X Y)))])

(parse-diagram
"
Z.....A....B................................    N
      .    .       .           .           .    .
      .    .       .           .           .    .
      .    .       .           .           .    .
      C.....   D...E...F   G...H...I   J...K    L
      .    .       .           .           .    .
      .    .       .           .           .    .
      .    .       .           .           .    .
      O    .....................................M
")

$Z

$Z: unbound identifier in: $Z

I can make identifiers well-enough with the name-pt macro, but it seems as if some of the information is being hidden, or lost along the way.

(name-pt "Z" 0 0) ;; this works fine
$Z

(pt 0 0)

Any help would be appreciated.

1 Like

Great idea for making it easier to draw diagrams.

In your name-pt the template is #'(define $NAME (pt X Y))).
The identifier $NAME is "new" so it will get the context (scope) from that macro invocation.
However, the intention is to refer to $NAME where the macro call (name-pt ..) is.
Therefore, the context of $NAME needs to change. You can do this with format-id.

Note that most of the bookkeping in your macro can be done as normal functions.
It simplifies your macro, if the bookkeeping is outsourced to helper functions.
See below.

#lang racket

(require metapict
         (for-syntax racket/list
                     racket/string
                     racket/syntax
                     syntax/parse))

(begin-for-syntax
  (define (split-diagram-into-rows whole)
    (reverse (filter non-empty-string? (string-split whole "\n"))))

  (define (split-row-into-columns row)
    (filter non-empty-string? (string-split row "")))

  (define ($sym s)
    (string->symbol
     (string-append "$" s)))
  
  (define (find-ids-and-positions whole)
    ; returns a list of elements of the form ($name x y)    
    (define rows (split-diagram-into-rows whole))
    (append*
     (for/list ([row rows]
                [y   (in-naturals)])
       (for/list ([col (split-row-into-columns row)]
                  [x   (in-naturals)]
                  #:unless (member col '(" " ".")))
         (list ($sym col) x y)))))

  (define (change-context lctx id)
    (format-id lctx "~a" id))

  (define (change-contexts lctx ids)
    (for/list ([id (syntax->list ids)])
      (change-context lctx id))))


(define-syntax (parse-diagram stx)
  (syntax-parse stx
    [(parse-diagram WHOLE)     
     (with-syntax ([((id x y) ...) (find-ids-and-positions (syntax->datum #'WHOLE))])       
       (with-syntax ([(id ...) (change-contexts stx #'(id ...))])
         #'(begin
             (define id (pt x y))
             ...)))]))

(parse-diagram
"
Z.....A....B................................    N
      .    .       .           .           .    .
      .    .       .           .           .    .
      .    .       .           .           .    .
      C.....   D...E...F   G...H...I   J...K    L
      .    .       .           .           .    .
      .    .       .           .           .    .
      .    .       .           .           .    .
      O    .....................................M
")

1 Like

Thanks, @soegaard!

That's really cool. I like how easy it is to draw diagrams using curves in metapict and being able to build off of a 2D "schematic" like this will be fun.

All the best.

Btw, you might be interested in the path operations:

 /-      ; p /- q   connect p and q with line(s) first vertical, then horizontal
 -/      ; p -/ p   connect p and q with line(s) first horizontal, then vertical

Example:

(require metapict metapict/path-operations)
(def A (pt 0 0))
(def B (pt 1 1))
(draw (curve A /- B))

will draw up, then right from A to B.

1 Like

Very nice; I saw that the path operations are mentioned in the documentation, but I haven't looked at them any further than -- and ... They will probably be most useful--I have been doing something similar although not quite as ergonomic to find these joints using:

(define (cross P Q)
  (pt (pt-x P) (pt-y Q))) ;; swap P and Q for the up-then-right vs. right-then-up joint

I will definitely have a look :100:.

Here’s my version:

#lang racket

(require metapict
         (for-syntax racket/string
                     racket/syntax
                     syntax/parse))

(begin-for-syntax
  (define (split-diagram-into-rows whole)
    (reverse (string-split whole "\n")))

  (define (split-row-into-columns row)
    (map string (string->list row)))

  (define ($sym s lctx)
    (format-id lctx "$~a" s))

  (define (find-ids-and-positions whole lctx)
    ; returns a list of elements of the form ($name x y)    
    (define rows (split-diagram-into-rows whole))
    (for*/list ([(row y) (in-indexed rows)]
                [(col x) (in-indexed (split-row-into-columns row))]
                #:unless (member col '(" " ".")))
      (list ($sym col lctx) x y))))

(define-syntax (parse-diagram stx)
  (syntax-parse stx
    [(parse-diagram WHOLE)
     #:with ((id x y) ...) (find-ids-and-positions (syntax-e #'WHOLE) stx)
     #'(begin (define id (pt 'x 'y)) ...)]))

(parse-diagram #<<EOF
Z.....A....B................................    N
      .    .       .           .           .    .
      .    .       .           .           .    .
      .    .       .           .           .    .
      C.....   D...E...F   G...H...I   J...K    L
      .    .       .           .           .    .
      .    .       .           .           .    .
      .    .       .           .           .    .
      O    .....................................M
EOF
               )

This version:

  1. Uses #:with instead of with-syntax.
  2. Uses for*/list to replace append* + multiple for/list.
  3. Uses herestring instead of string. This removes the spurious empty lines.
1 Like

Thank you for the contribution, @sorawee. I haven't seen herestrings in Racket before, although I have come across them in Powershell.

The use of in-indexed is news to me! TIL, much obliged.

I’m still interested in a clear answer to the original question about why giving $NAME the lexical context of the passed-in syntax object is not enough.

(define-macro-cases name-pt
  ;; …
  [(name-pt SYM X Y) ;; name the pt at X Y by the symbol at X Y if it is not a space or a dot
   (with-pattern ([$NAME (prefix-id '$ #'SYM)])
     #'(define $NAME (pt X Y)))])

@soegaard mentions that

The identifier $NAME is "new" so it will get the context (scope) from that macro invocation. However, the intention is to refer to $NAME where the macro call (name-pt ..) is.

The call to prefix-id would appear to be an attempt to do exactly that, so I don’t feel this answer is sufficient. (Though maybe I misunderstand what soegaard is trying to say here.)

Tracing back, the SYM in (prefix-id '$ #'SYM) is coming from a with-syntax pattern in another macro — specifically COL ... in parse-diagram … which itself is coming from ROW ... further up in the same macro.

Is this in fact where the lexical context is being “lost” as OP originally supposed? It’s not obvious to me what happens when you use a syntax object derived from a with-syntax pattern as the lexical context for another syntax object.

Hi, @joeld. I understood it in terms of the following, although I am obviously unclear about the matter at large:

The context being passed to prefix-id in my original attempt is "removed" from where I want it to be, because I am not referencing the original scope, i.e. the context inside of (name-pt ...) is "fresh", but in the answers from @soegaard and @sorawee, the context is the same as the original call to the macro, i.e., the stx in the code below.

(define-syntax (parse-diagram stx)
  (syntax-parse stx
    [(parse-diagram WHOLE)     
     (with-syntax ([((id x y) ...) (find-ids-and-positions (syntax->datum #'WHOLE))])       
       (with-syntax ([(id ...) (change-contexts stx #'(id ...))])
         #'(begin
             (define id (pt x y))
             ...)))]))

For what it's worth, I have gotten a similar thing to work before, to name desired directory paths so that I can reference the paths more easily when creating files and folders, by way of this code:

#lang br

(define (normalize elements)
  (map (lambda (x)
         (if (path? x) x (symbol->string x)))
       (reverse elements)))

(define-macro-cases make-named-paths
  [(make-named-paths in ROOT using SIGIL [DIR ...] ...)
   #'(begin
       (walk-paths SIGIL `[,ROOT] [DIR ...])
       ...)]
  
  [(make-named-paths in ROOT [DIR ...] ...)
   #'(begin
       (make-named-paths in ROOT using @ [DIR ...])
       ...)])

(define-macro-cases walk-paths
  [(walk-paths SIGIL PATH [.. CONTENT ...])
   #'(begin
       (walk-paths SIGIL PATH CONTENT)
       ...)]
  
  [(walk-paths SIGIL PATH [NAME CONTENT0 CONTENT ...])
   (with-pattern ([$NAME (prefix-id #'SIGIL #'NAME)])
     #'(begin
         (define $NAME
           (path->directory-path
            (apply build-path (normalize (cons 'NAME PATH)))))
         
         (walk-paths SIGIL (cons 'NAME PATH) CONTENT0)
         (walk-paths SIGIL (cons 'NAME PATH) CONTENT)
         ...))]
  
  [(walk-paths SIGIL PATH [NAME])
   (with-pattern ([$NAME (prefix-id #'SIGIL #'NAME)])
     #'(define $NAME
         (path->directory-path
          (apply build-path (normalize (cons 'NAME PATH))))))]
  
  [(walk-paths SIGIL PATH NAME)
   (with-pattern ([$NAME (prefix-id #'SIGIL #'NAME)])
     #'(define $NAME
         (apply build-path (normalize (cons 'NAME PATH)))))])

;; here I use these definitions
(make-named-paths
 in    (find-system-path 'temp-dir)
 using $
 [.. archive.zip hide-wallpaper.jpg]
 [HOME self.exe spaghetti.exe data.txt data.zip live.ps1 yeet.ps1 wallpaper.jpg])

(make-named-paths
 in    (find-system-path 'doc-dir)
 using $
 [.. logs.txt hide-self.exe])

$self.exe

#path:C:\Users\CHRIST~1\AppData\Local\Temp\HOME\self.exe

Perhaps it is as you say, because of the derived syntax object when using the with-syntax* in my original attempt. I can see the outline but not necessarily all the details.

I don't know if this makes it clearer or not, but if you look at this bit of code (I'm trying to write some functionality to walk the paths in the diagram using some "guardrails"), you'll see that the single identifiers I use for diagram and in-diagram? have to be put through change-context as well before they are usable in the manner I wish.

(define-syntax (parse-diagram stx)
  (syntax-parse stx
    [(parse-diagram WHOLE)     
     (with-syntax ([(((u v sym) ...) ((x y id) ...))
                    (all-pts-and-pts-with-ids (syntax->datum #'WHOLE))])    
       (with-syntax ([(id ...)    (change-contexts stx #'(id ...))]
                     [diagram     (change-context stx #'diagram)]
                     [in-diagram? (change-context stx #'in-diagram?)])
         #'(begin
             (define diagram
               (make-hash (list (cons (pt u v) 'sym) ...)))

             (define (in-diagram? a-pt)
               (hash-ref diagram a-pt #f))
             
             (define id (pt x y))
             ...)))]))

I would hazard that this lends credence to the fact that with-syntax introduces a fresh scope without carrying over the context from the enclosing macro's stx. But, I'm just guessing :sweat_smile:.

Edit: changed 'diagram and 'in-diagram? to #'diagram and #'in-diagram? to make my intent clearer, whether it is correct or not.

Reading the documentation about with-syntax, I notice the following:

"A with-syntax form is roughly equivalent to the following syntax-case form:

(syntax-case (list stx-expr ...) ()
  [(pattern ...) (let () body ...+)])

However, if any individual stx-expr produces a non-syntax object, then it is converted to one using datum->syntax and the lexical context and source location of the individual stx-expr."

So, if I'm understanding this correctly, it means that because of the non-syntax objects matched with (ROW ...) and (COL ...) and friends, the objects are converted to syntax-objects using the context and source location of the stx-expr, which would be in the RHS of the arguments to the with-syntax form itself, as opposed to the enclosing macro's context.

I’m still interested in a clear answer to the original question about why giving $NAME the lexical context of the passed-in syntax object is not enough.

I have attempted to give an explanation here:

The problem in the original was the macro expansion used name-pt without
adjusting the context. The identifiers were given a scope, so they could be used
in the code returned from parse-diagram, but not where parse-diagram was called.