init commit

.gitignore

@@ -0,0 +1,3 @@
+build/
+*.go
+Makefile

Makefile.in

@@ -0,0 +1,15 @@
+.PHONY: all clean test install todo
+
+all: d-.go
+clean:
+	rm -rf d-.go
+test:
+	guile -L . test.scm
+install: d-.scm d-.go
+	install -D -t "$(INSTALL_PREFIX)/share/guile/site/3.0/" d-.scm
+	install -D -t "$(INSTALL_PREFIX)/lib/guile/3.0/site-ccache/" d-.go
+uninstall:
+	rm -f "$(INSTALL_PREFIX)/share/guile/site/3.0/d-.scm"
+	rm -f "$(INSTALL_PREFIX)/lib/guile/3.0/site-ccache/d-.go"
+%.go: %.scm
+	guild compile $^ -o $@

configure

@@ -0,0 +1,8 @@
+#!/usr/bin/bash
+
+case $1 in
+    --prefix)
+	sed '1i\'INSTALL_PREFIX="$2" < Makefile.in > Makefile
+	shift 2
+	;;
+esac

d-.scm

@@ -0,0 +1,20 @@
+(define-module (d-)
+  #:export
+  (~>
+   ~>>
+   partial))
+
+(define-syntax ~>
+  (syntax-rules ()
+    [(_ v) v]
+    [(_ v (fn args ...) more ...) (~> (fn v args ...) more ...)]
+    [(_ v fn more ...) (~> (fn v) more ...)]))
+
+(define-syntax ~>>
+  (syntax-rules ()
+    [(_ v) v]
+    [(_ v (fn args ...) more ...) (~> (fn args ... v) more ...)]
+    [(_ v fn more ...) (~> (fn v) more ...)]))
+
+(define (partial fn . args)
+  (lambda x (apply fn (append args x))))

test.scm

@@ -0,0 +1,32 @@
+(use-modules (d-)
+	     (rnrs base))
+
+(define-syntax-rule (define-unit-test (test-name body ...))
+  (let () body ...))
+
+(define-syntax-rule (define-test module-name tests ...)
+  (begin (define-unit-test tests) ...))
+
+(define-test ~>
+  (unwrapped
+   (define value (~> 1 1+ 1+))
+   (assert (= value 3)))
+  (wrapped
+   (define value (~> 1 (/ 2) (/ 2)))
+   (assert (= value 1/4))))
+
+(define-test ~>>
+  (unwrapped
+   (define value (~>> 1 1+ 1+))
+   (assert (= value 3)))
+  (wrapped
+   (define value (~>> 1 (/ 2) (/ 2)))
+   (assert (= value 1))))
+
+(define-test partial
+  (test
+   (define value (partial / 2))
+   (assert (= (value 4) 1/2))
+   (assert (= (value 1) 2))))
+
+