From c247a29af71295e5aec29c08ac7b9e8a76743629 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 30 Mar 2016 16:05:47 -0700
Subject: [PATCH] use `normalize-definition`

---
 sugar/define.rkt               |  3 +--
 sugar/private/syntax-utils.rkt | 20 +++++++++-----------
 2 files changed, 10 insertions(+), 13 deletions(-)

diff --git a/sugar/define.rkt b/sugar/define.rkt
index 722eaea..28bdea3 100644
--- a/sugar/define.rkt
+++ b/sugar/define.rkt
@@ -21,8 +21,7 @@
   (with-syntax ([(id contract lambda-exp) (lambdafy-with-contract stx)])
     #'(begin
         (define id lambda-exp)
-        (provide id)
-        (make-safe-module [id contract]))))
+        (provide+safe [id contract]))))
 
 
 ;; for previously defined identifiers
diff --git a/sugar/private/syntax-utils.rkt b/sugar/private/syntax-utils.rkt
index e0464a6..3e47666 100644
--- a/sugar/private/syntax-utils.rkt
+++ b/sugar/private/syntax-utils.rkt
@@ -1,5 +1,5 @@
 #lang racket/base
-(require (for-syntax racket/base) syntax/strip-context)
+(require (for-syntax racket/base) syntax/define)
 (provide (all-defined-out))
 
 
@@ -14,18 +14,16 @@
 
 
 ;; convert calling pattern to form (id contract body-exp)
+;; hoist contract out of lambda-exp entirely
 (define-syntax-rule (lambdafy-with-contract stx)
-  (syntax-case stx ()
-    [(_ (id arg (... ...) . rest-arg) contract body0 body (... ...))
-     (replace-context #'id  #'(id contract (λ (arg (... ...) . rest-arg) body0 body (... ...))))]
-    [(_ id contract lambda-exp)
-     (replace-context #'id #'(id contract lambda-exp))]))
+  (with-syntax ([(id (lambda args contract body-exp (... ...))) (let*-values ([(id-stx rhs-exp-stx) (normalize-definition stx (datum->syntax stx 'λ) #t #t)])
+                                                                  (list id-stx (syntax->list rhs-exp-stx)))])
+    ;; lambda-exp = #'(lambda args body-exp (... ...))
+    #'(id contract (lambda args body-exp (... ...)))))
 
 
 ;; convert calling pattern to form (id body-exp)
 (define-syntax-rule (lambdafy stx)
-  (syntax-case stx ()
-    [(_ (id arg (... ...) . rest-arg) body0 body (... ...))
-     (replace-context #'id #'(id (λ (arg (... ...) . rest-arg) body0 body (... ...))))]
-    [(_ id lambda-exp)
-     (replace-context #'id #'(id lambda-exp))]))
\ No newline at end of file
+  (with-syntax ([(id lambda-exp) (let-values ([(id-stx body-exp-stx) (normalize-definition stx (datum->syntax stx 'λ) #t #t)])
+                                 (list id-stx body-exp-stx))])
+    #'(id lambda-exp)))
\ No newline at end of file