X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=sam.git;a=blobdiff_plain;f=sam-macros.scm;fp=sam-macros.scm;h=16faba3f0ccf7e13f1cccad7dc2c39a0fb8d8608;hp=0000000000000000000000000000000000000000;hb=db875d2441ba67f863dc6e848d609f67d42eacf5;hpb=7a4abf91e47b6115f8ad006b9b1a5653894a115e

diff --git a/sam-macros.scm b/sam-macros.scm
new file mode 100644
index 0000000..16faba3
--- /dev/null
+++ b/sam-macros.scm
@@ -0,0 +1,32 @@
+;; Macro definitions used for SAM behaviour definition
+;;
+
+(module sam-macros
+    (make-beh define-beh)
+
+  (import scheme
+          (chicken base)
+          matchable)
+
+  (define-syntax make-beh
+    (syntax-rules (: => finally)
+      ((make-beh : parent (self) (pat => body ...) ... (finally after ...))
+       (cons (lambda (self . message)
+               (match message
+                 (pat body ...)
+                 ...
+                 (else 'pass))
+               after ...)
+             parent))
+      ((make-beh (self) (pat => body ...) ... (finally after ...))
+       (make-beh : root-beh (self) (pat => body ...) ... (finally after ...)))
+      ((make-beh : parent (self) (pat => body ...) ...)
+       (make-beh : parent (self) (pat => body ...) ... (finally)))
+      ((make-beh (self) (pat => body ...) ...)
+       (make-beh : root-beh (self) (pat => body ...) ... (finally)))))
+
+  (define-syntax define-beh
+    (syntax-rules ()
+      ((_ name rest ...)
+       (define name (make-beh rest ...))))))
+