From 4b50c03c9767750fbbd857121d500c3afbfdfdf2 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Sat, 2 May 2020 18:26:32 -0700
Subject: Clojure-inspired scheme macros

---
 Alpha/Core.scm | 64 +++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 37 insertions(+), 27 deletions(-)

(limited to 'Alpha')

diff --git a/Alpha/Core.scm b/Alpha/Core.scm
index 3a5ac6e..b785a13 100644
--- a/Alpha/Core.scm
+++ b/Alpha/Core.scm
@@ -10,6 +10,9 @@
             ;; booleans
             true? false? nil nil?
 
+            ;; control flow
+            -> ->> fn /.
+
             ;; dev helpers
             comment
             ))
@@ -40,7 +43,7 @@
     (cons init (unfold f (f init) pred))))
 
 (define (sum lst)          (fold + 0 lst))
-(define (produce lst)      (fold * 1 lst))
+(define (product lst)      (fold * 1 lst))
 
 (define count length)
 
@@ -128,31 +131,38 @@
     ((_ s args ...)
      (format #f s args ...))))
 
-;; If I implement ML-like interface abstractions in scheme, what would it look like?
-
-;; 
-;; ;; seq
-
-;; (define-class <seq> () (_first))
-
-;; 
-;; ;; Functor
-
-;; (define-class <functor> ())
-
-;; (define-method (fmap (f <procedure>) (coll <functor>)))
-
-;; 
-;; ;; Applicative
-
-;; ;; a -> f a
-;; (define-method (pure (a <any>)))
-
-;; ;; f (a -> b) -> f a -> f b
-;; (define-method (<*> (f <procedure>) (a <applicative>) (b <applicative>)))
+(define-syntax fn
+  (syntax-rules ()
+    ((_ args body ...)
+     (lambda args body ...))))
 
-;; ;; f a -> f b -> f b
-;; (define-method (*> (a <applicative>) (b <applicative>)))
+(define-syntax ->
+  (syntax-rules ()
+    [(_ a) a]
+    [(_ a (b c ...))
+     (b a c ...)]
+    [(_ a b)
+     (-> a (b))]
+    [(_ a b c ...)
+     (-> (-> a b) c ...)]))
+
+(define-syntax ->>
+  (syntax-rules ()
+    [(_ a) a]
+    [(_ a (b ...))
+     (b ... a)]
+    [(_ a b)
+     (b a)]
+    [(_ a b c ...)
+     (->> (->> a b) c ...)]))
+
+;; Shen-like lambda
+(define-syntax /.
+  (syntax-rules ()
+    [(/. a b)
+     (lambda (a) b)]
+    [(/. a ... (b ...))
+     (lambda (a ...) (b ...))]))
 
-;; ;; f a -> f b -> f a
-;; (define-method (<* (a <applicative>) (b <applicative>)))
+(define (inc a) (+ 1 a))
+(define (dec a) (- a 1))
-- 
cgit v1.2.3