From 1619bfb0ef9697dfa4d29bb5a5142c242f059762 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Wed, 20 Jan 2016 21:18:18 +0100
Subject: [PATCH] A couple of function that will be useful in future makefiles.

---
 graph-lib/make/make-lib-2.rkt | 44 +++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)
 create mode 100644 graph-lib/make/make-lib-2.rkt

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