diff --git a/graph-lib/make/make-lib-2.rkt b/graph-lib/make/make-lib-2.rkt new file mode 100644 index 0000000..35484e5 --- /dev/null +++ b/graph-lib/make/make-lib-2.rkt @@ -0,0 +1,44 @@ +#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")) \ No newline at end of file