From a0d3481b739b75ef4221f0a679bcf02516b4197d Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay.mccarthy@gmail.com>
Date: Tue, 28 Jul 2015 15:24:36 -0600
Subject: [PATCH] fix for new syntax expander, thanks mflatt!

---
 lang/reader.rkt      | 15 +++++++++++----
 private/compiler.rkt | 24 ++++++++++++++++--------
 2 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/lang/reader.rkt b/lang/reader.rkt
index 1821176..7d277a1 100644
--- a/lang/reader.rkt
+++ b/lang/reader.rkt
@@ -2,7 +2,8 @@
   #:language 'datalog/sexp/lang
   #:read (lambda ([in (current-input-port)]) (this-read-syntax #f in))
   #:read-syntax this-read-syntax
-  #:whole-body-readers? #t  
+  #:whole-body-readers? #t
+  #:module-wrapper call-with-intro
   #:language-info
   '#(datalog/lang/lang-info get-info #f)
   #:info (lambda (key defval default)
@@ -17,8 +18,14 @@
              [else (default key defval)]))
   (require datalog/parse
            datalog/private/compiler)
+
+  (define (call-with-intro thunk)
+    (define intro (make-syntax-introducer #t))
+    (parameterize ([current-datalog-introducer intro])
+      (intro (thunk))))
   
   (define (this-read-syntax [src #f] [in (current-input-port)])
-    (compile-program
-     (parameterize ([current-source-name src])
-       (parse-program in)))))
+    (quasisyntax/loc src
+      #,(compile-program
+         (parameterize ([current-source-name src])
+           (parse-program in))))))
diff --git a/private/compiler.rkt b/private/compiler.rkt
index 78d2bae..cb54182 100644
--- a/private/compiler.rkt
+++ b/private/compiler.rkt
@@ -5,27 +5,35 @@
          datalog/stx)
 (require (for-template datalog/stx))
 
-(provide/contract
- [compile-program (program/c . -> . (listof syntax?))]
- [compile-statement (statement/c . -> . syntax?)])
+(provide
+ current-datalog-introducer
+ (contract-out
+  [compile-program (program/c . -> . (listof syntax?))]
+  [compile-statement (statement/c . -> . syntax?)]))
 
 (define (compile-program p)
   (map compile-statement p))
 
+(define current-datalog-introducer
+  (make-parameter (λ (x) x)))
+
+(define (intro x)
+  ((current-datalog-introducer) x))
+
 (define compile-statement
   (match-lambda
     [(assertion srcloc c)
      (define srcstx (datum->syntax #f 'x srcloc))
      (quasisyntax/loc srcstx
-       (! #,(compile-clause c)))]
+       (#,(intro #'!) #,(compile-clause c)))]
     [(retraction srcloc c)
      (define srcstx (datum->syntax #f 'x srcloc))
      (quasisyntax/loc srcstx
-       (~ #,(compile-clause c)))]
+       (#,(intro #'~) #,(compile-clause c)))]
     [(query srcloc l)
      (define srcstx (datum->syntax #f 'x srcloc))
      (quasisyntax/loc srcstx
-       (? #,(compile-literal l)))]))
+       (#,(intro #'?) #,(compile-literal l)))]))
 
 (define compile-clause
   (match-lambda
@@ -35,14 +43,14 @@
     [(clause srcloc head body)
      (define srcstx (datum->syntax #f 'x srcloc))
      (quasisyntax/loc srcstx
-       (:- #,@(map compile-literal (list* head body))))]))
+       (#,(intro #':-) #,@(map compile-literal (list* head body))))]))
 
 (define compile-literal
   (match-lambda
     [(literal srcloc '= (and ts (app length 2)))
      (define srcstx (datum->syntax #f 'x srcloc))
      (quasisyntax/loc srcstx
-       (= #,@(map compile-term ts)))]
+       (#,(intro #'=) #,@(map compile-term ts)))]
     [(literal srcloc pred ts)
      (define srcstx (datum->syntax #f 'x srcloc))
      (define pred-stx (if (predicate-sym? pred)