Add "annotations" procedure

This commit is contained in:
Tony Garnock-Jones 2021-05-25 11:02:36 +02:00
parent 669d1b480d
commit 4ed8fd2c92
1 changed files with 6 additions and 0 deletions

View File

@ -2,6 +2,7 @@
(provide (struct-out annotated) (provide (struct-out annotated)
annotate annotate
annotations
strip-annotations strip-annotations
strip-annotations-proc strip-annotations-proc
peel-annotations peel-annotations
@ -37,6 +38,11 @@
[item [item
(annotated as #f item)])) (annotated as #f item)]))
(define (annotations v)
(match v
[(annotated annotations _ _) annotations]
[_ '()]))
(define (strip-annotations-proc v #:depth [depth +inf.0]) (define (strip-annotations-proc v #:depth [depth +inf.0])
(let walk* ((v v) (depth depth)) (let walk* ((v v) (depth depth))
(define next-depth (- depth 1)) (define next-depth (- depth 1))