44 lines
1.3 KiB
Racket
44 lines
1.3 KiB
Racket
#lang racket
|
|
|
|
(require (for-syntax syntax/parse)
|
|
rackunit)
|
|
|
|
(begin-for-syntax
|
|
(define-splicing-syntax-class element
|
|
(pattern (~seq as-list (~literal ...)))
|
|
(pattern (~seq single-value)
|
|
#:with as-list #'(list single-value))))
|
|
|
|
(define-match-expander path
|
|
(λ (stx)
|
|
(syntax-case stx ()
|
|
[(_ pat ...)
|
|
#'(app explode-path
|
|
(list #;(and (or (? path-for-some-system?) 'up 'same) pat)
|
|
pat ...))]))
|
|
(λ (stx)
|
|
(syntax-parse stx
|
|
[(_ e:element ...)
|
|
#'(apply build-path (append e.as-list ...))])))
|
|
|
|
(define-match-expander simple-path
|
|
(λ (stx)
|
|
(syntax-case stx ()
|
|
[(_ pat ...)
|
|
#'(app (λ (x) (simplify-path x #f)) (path pat ...))]))
|
|
(λ (stx)
|
|
(syntax-case stx ()
|
|
[(_ e ...)
|
|
#'(simplify-path (path e ...) #f)])))
|
|
|
|
(check-equal? (match (build-path "a/b/c/d/e/f" 'up "g/")
|
|
((path x y ... z) (path z y ... 'up x)))
|
|
(string->path "g/b/c/d/e/f/../../a"))
|
|
|
|
(check-not-equal? (match (build-path "a/b/c/d/e/f" 'up "g/")
|
|
((path x y ... z) (path z y ... 'up x)))
|
|
(string->path "g/b/c/d/a"))
|
|
|
|
(check-equal? (match (build-path "a/b/c/d/e/f" 'up "g/")
|
|
((simple-path x y ... z) (simple-path z y ... 'up x)))
|
|
(string->path "g/b/c/d/a")) |