Commits

Moritz Heidkamp  committed 98e3e39

initial commit

  • Participants
  • Tags 0.0.1

Comments (0)

Files changed (5)

File clojurian-syntax.scm

+(module clojurian-syntax
+
+(doto -> ->* ->> ->>*)
+
+(import chicken scheme)
+
+(define-syntax doto
+  (syntax-rules ()
+    ((_ x) x)
+    ((_ x (fn args ...) ...)
+     (let ((y x))
+       (fn y args ...)
+       ...
+       y))))
+
+(define-syntax ->
+  (syntax-rules ()
+    ((_ x) x)
+    ((_ x (y z ...) rest ...)
+     (-> (y x z ...) rest ...))))
+
+(define-syntax ->>
+  (syntax-rules ()
+    ((_ x) x)
+    ((_ x (y ...) rest ...)
+     (->> (y ... x) rest ...))))
+
+(define-syntax ->*
+  (syntax-rules ()
+    ((_ x) x)
+    ((_ x (y z ...) rest ...)
+     (->* (receive args x
+            (apply y (append args (list z ...))))
+          rest ...))))
+
+(define-syntax ->>*
+  (syntax-rules ()
+    ((_ x) x)
+    ((_ x (y z ...) rest ...)
+     (->>* (receive args x
+             (apply y (append (list z ...) args)))
+           rest ...))))
+
+)

File clojurian.meta

+((author "Moritz Heidkamp") 
+ (synopsis "Syntax and utility functions inspired by Clojure")
+ (category lang-exts)
+ (license "BSD")
+ (test-depends test))

File clojurian.setup

+(compile -s -O2 -d0 clojurian-syntax.scm -J)
+(compile -s -O2 -d0 clojurian-syntax.import.scm)
+
+(install-extension
+ 'clojurian
+ '("clojurian-syntax.so"
+   "clojurian-syntax.import.so")
+ '((version "0.0.1")))

File tests/run.scm

+(use test)
+
+(test-begin)
+(load-relative "syntax.scm")
+(test-end)

File tests/syntax.scm

+(use test srfi-1)
+
+(load-relative "../clojurian-syntax")
+(import clojurian-syntax)
+
+(test (vector 1 2)
+      (doto (make-vector 2)
+            (vector-set! 0 1)
+            (vector-set! 1 2)))
+
+(test 'foo (doto 'foo))
+
+(test 1 (-> 99 (/ 11) (/ 9)))
+
+(test '(1 2 3 4)
+      (->* (values 1 2)
+           (list 3)
+           (append '(4))))
+
+(test 7 (-> 10 (- 3)))
+(test -7 (->> 10 (- 3)))
+
+(test 9 (->> 1 (+ 2) (* 3)))
+
+(test 9 (->> '(1 2 3)
+             (map add1)
+             (fold + 0)))
+
+(test '((foo . 100) (bar . 200))
+      (->>* (values '(foo bar) '(100 200))
+            (map cons)))