From 9347aa6766e68285f1a1b22394b775264bd22bba Mon Sep 17 00:00:00 2001
From: Eric Holk <eholk@cs.indiana.edu>
Date: Tue, 25 Feb 2014 12:33:42 -0500
Subject: [PATCH] Allow irrefutable patterns in arguments to define (Issue
 #127)

---
 harlan/front/expand-macros.scm |  2 +-
 lib/harlan/core.kfc            | 16 ++++++++++++++++
 2 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/harlan/front/expand-macros.scm b/harlan/front/expand-macros.scm
index f8b6b8d..6f0127b 100644
--- a/harlan/front/expand-macros.scm
+++ b/harlan/front/expand-macros.scm
@@ -248,7 +248,7 @@
                                        x*)
                                   env)))
                  `(lambda ,(reify x* env) . ,(reify b* env))))))
-           ((define)
+           ((prim-define)
             (match x
               ((,define (,name ,x* ...) ,b* ...)
                (let ((env^ (cons (cons name (ident-symbol name))
diff --git a/lib/harlan/core.kfc b/lib/harlan/core.kfc
index adc2bf6..db99211 100644
--- a/lib/harlan/core.kfc
+++ b/lib/harlan/core.kfc
@@ -9,6 +9,22 @@
   (extern open_outfile (str) -> (ptr ofstream))
   (extern str->vec (str) -> (vec char))
   (extern time-s () -> float)
+
+  (define-macro define-binders ()
+    ((_ name ((tag x ...) binder ...) (arg ...) (e ...))
+     (define-binders name (binder ...)
+       (arg ... match-tmp)
+       ((match match-tmp
+          ((tag x ...)
+           (begin e ...))))))
+    ((_ name (x binder ...) (arg ...) (e ...))
+     (define-binders name (binder ...) (arg ... x) (e ...)))
+    ((_ name () (arg ...) (e ...))
+     (prim-define (name arg ...) e ...)))
+  
+  (define-macro define ()
+    ((_ (name binder ...) e ...)
+     (define-binders name (binder ...) () (e ...))))
   
   (define-macro cond (else)
     ((_ (else body))