A couple of function that will be useful in future makefiles.

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"))