Paren datalog

collects/datalog/eval.rkt

@@ -19,11 +19,13 @@
    (format-literals ls)))
 
 (define (eval-program p)
-  (for-each (lambda (s)
+  (for-each eval-top-level-statement p))
-              (define v (eval-statement s))
+
-              (unless (void? v)
+(define (eval-top-level-statement s)
-                (print-literals v)))
+  (define v (eval-statement s))
-            p))
+  (unless (void? v)
+    (print-literals v)))
+
 (define (eval-statement s)
   (cond
     [(assertion? s)
@@ -53,5 +55,6 @@
 (provide/contract
  [current-theory (parameter/c mutable-theory/c)]
  [eval-program (program/c . -> . void)]
+ [eval-top-level-statement (statement/c . -> . void)]
  [eval-statement (statement/c . -> . (or/c void (listof literal?)))]
  [eval-program/fresh (program/c . -> . immutable-theory/c)])

collects/datalog/scribblings/racket.scrbl

@@ -175,7 +175,7 @@ This library provides the structures that represent Datalog syntax. It can be re
 }
                                         
 @defstruct[query ([srcloc srcloc/c]
-                  [clause clause?])]{
+                  [literal literal?])]{
  A Datalog query.
 }
 

collects/datalog/sexp/lang.rkt

@@ -0,0 +1,76 @@
+#lang racket
+(require (for-syntax syntax/parse)
+         "../eval.rkt"
+         "../ast.rkt")
+
+(define-syntax (top stx)
+  (syntax-parse 
+   stx
+   [(_ . sym:id)
+    (quasisyntax/loc stx
+      (constant #'#,stx 'sym))]))
+
+(define-syntax (unquote stx)
+  (syntax-parse 
+   stx
+   [(_ sym:id)
+    (quasisyntax/loc stx
+      (variable #'#,stx 'sym))]))
+
+(define-syntax (datum stx)
+  (syntax-parse 
+   stx
+   [(_ . sym:str)
+    (quasisyntax/loc stx
+      (constant #'#,stx 'sym))]))
+
+(define-syntax (->literal stx)
+  (syntax-parse 
+   stx
+   [(_ sym:id)
+    (quasisyntax/loc stx
+      (literal #'#,stx 'sym empty))]
+   [(_ (sym:id e ...))
+    (quasisyntax/loc stx
+      (literal #'#,stx 'sym (list e ...)))]))
+
+(define-syntax (->simple-clause stx)
+  (syntax-case stx ()
+    [(_ e)
+     (quasisyntax/loc stx
+       (clause #'#,stx (->literal e) empty))]))
+
+(define-syntax (:- stx)
+  (syntax-case stx ()
+    [(_ head body ...)
+     (quasisyntax/loc stx
+       (eval-top-level-statement 
+        (assertion #'#,stx 
+                   (clause #'#,stx (->literal head) 
+                           (list (->literal body) ...)))))]))
+
+(define-syntax-rule (define-paren-stx op struct)
+  (define-syntax (op stx)
+    (syntax-case stx ()
+      [(_ c)
+       (quasisyntax/loc stx
+         (eval-top-level-statement (struct #'#,stx (->simple-clause c))))])))
+
+(define-paren-stx ! assertion)
+(define-paren-stx ~ retraction)
+
+(define-syntax (? stx)
+  (syntax-case stx ()
+    [(_ c)
+     (quasisyntax/loc stx
+       (eval-top-level-statement (query #'#,stx (->literal c))))]))
+
+(provide (rename-out [top #%top]
+                     [datum #%datum]
+                     #;[module-begin #%module-begin]
+                     #;[top-interaction #%top-interaction])
+         
+         #%module-begin
+         ! ~ ?
+         :-
+         unquote)

collects/datalog/sexp/lang/reader.rkt

@@ -0,0 +1,2 @@
+(module reader syntax/module-reader
+  #:language 'datalog/sexp/lang)

collects/datalog/tests/eval.rkt

@@ -14,15 +14,16 @@
     (define test-rkt (build-path examples-dir (format "~a.rkt" t)))
     (define test-txt (build-path examples-dir (format "~a.txt" t)))
     (test-equal? t
-                 (filter (lambda (l)
-                           (not (string=? l "")))
-                         (file->lines test-txt))
                  (filter (lambda (l)
                            (not (string=? l "")))
                          (with-input-from-string
                              (with-output-to-string
                                  (lambda () (dynamic-require test-rkt #f)))
-                           port->lines))))
+                           port->lines))
+                 (filter (lambda (l)
+                           (not (string=? l "")))
+                         (file->lines test-txt))
+                 ))
   
   (test-suite
    (path->string examples-dir)

collects/datalog/tests/paren-examples/ancestor.txt

@@ -1,6 +1,6 @@
+ancestor(ebbon, douglas).
+ancestor(ebbon, john).
+ancestor(bob, douglas).
 ancestor(ebbon, bob).
 ancestor(bob, john).
 ancestor(john, douglas).
-ancestor(bob, douglas).
-ancestor(ebbon, john).
-ancestor(ebbon, douglas).

collects/datalog/tests/paren-examples/laps.rkt

@@ -2,7 +2,7 @@
 ; Laps Test
 (! (contains ca store rams_couch rams))
 (! (contains rams fetch rams_couch will))
-(:- (contains ca ,Fetch ,Name ,Watcher)
+(:- (contains ca fetch ,Name ,Watcher)
     (contains ca store ,Name ,Owner)
     (contains ,Owner fetch ,Name ,Watcher))
 (! (trusted ca))