# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1474902712 0
# Node ID b261c086fa4eeb6bef15a76dd6d2e41a6a91b682
# Parent  167ffd6a7a6a4f8c486a1d7779223e1ea525975c
Start working on fluxplayer grounder

diff -r 167ffd6a7a6a -r b261c086fa4e package.lisp
--- a/package.lisp	Mon Sep 26 12:27:26 2016 +0000
+++ b/package.lisp	Mon Sep 26 15:11:52 2016 +0000
@@ -43,6 +43,17 @@
   (:export
     ))
 
+(defpackage #:scully.grounders.fluxplayer
+  (:use
+    #:cl
+    #:losh
+    #:iterate
+    #:cl-arrows
+    #:smug
+    #:scully.quickutils)
+  (:export
+    ))
+
 (defpackage #:scully.players.random
   (:use
     #:cl
diff -r 167ffd6a7a6a -r b261c086fa4e scully.asd
--- a/scully.asd	Mon Sep 26 12:27:26 2016 +0000
+++ b/scully.asd	Mon Sep 26 15:11:52 2016 +0000
@@ -12,6 +12,7 @@
                #:temperance
                #:hunchentoot
                #:trivia
+               #:smug
                #:cl-arrows
                #:cl-ggp)
 
@@ -25,7 +26,8 @@
                              (:module "reasoners" :serial t
                               :components ((:file "prolog")))
                              (:module "grounders" :serial t
-                              :components ((:file "prolog")))
+                              :components ((:file "prolog")
+                                           (:file "fluxplayer")))
                              (:module "players" :serial t
                               :components ((:file "random")
                                            (:file "random-ii")))))))
diff -r 167ffd6a7a6a -r b261c086fa4e src/grounders/fluxplayer.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/grounders/fluxplayer.lisp	Mon Sep 26 15:11:52 2016 +0000
@@ -0,0 +1,106 @@
+(in-package #:scully.grounders.fluxplayer)
+
+
+;;;; Data ---------------------------------------------------------------------
+(defstruct index-entry id term)
+(defstruct rule id positive negative)
+
+
+;;;; Parsing ------------------------------------------------------------------
+(defparameter *whitespace* '(#\space #\tab))
+
+(defun .whitespace (&optional result-type)
+  (.first (.map result-type (.is 'member *whitespace*))))
+
+(defun .whitespace-and (parser)
+  (.progn (.whitespace) parser))
+
+
+(defun .digit (&optional (radix 10))
+  (.is (rcurry #'digit-char-p radix)))
+
+(defun .positive-integer (&optional (radix 10))
+  (.let* ((digits (.first (.map 'string (.digit radix)))))
+    (.identity (parse-integer digits :radix radix))))
+
+(defun .eof ()
+  (.or (.not (.item))
+       (.fail)))
+
+
+(defun .actual-line ()
+  ;; zero or more chars, followed by a newline
+  (.let* ((contents (.optional
+                      (.first (.map 'string (.is-not #'char= #\newline)))))
+          (_ (.char= #\newline)))
+    (.identity (or contents ""))))
+
+(defun .final-non-terminated-line ()
+  ;; one or more chars at eof without a trailing newline
+  (.let* ((contents (.first (.map 'string (.is-not #'char= #\newline))))
+          (_ (.eof)))
+    (.identity contents)))
+
+(defun .line ()
+  (.or (.actual-line) (.final-non-terminated-line)))
+
+
+(defun .repeat (n parser)
+  (if (zerop n)
+    (.identity nil)
+    (.let* ((el parser)
+            (rest (.repeat (1- n) parser)))
+      (.identity (cons el rest)))))
+
+
+(defun .index-line ()
+  (.let* ((id (.positive-integer))
+          (_ (.whitespace))
+          (term (.line)))
+    (.identity (make-index-entry :id id :term (read-from-string term)))))
+
+(defun .rule-line ()
+  (.let* ((_ (.positive-integer)) ; type, not used here
+          (id (.whitespace-and (.positive-integer)))
+          (term-count (.whitespace-and (.positive-integer)))
+          (negative-term-count (.whitespace-and (.positive-integer)))
+          (positive-terms (.repeat (- term-count negative-term-count)
+                                   (.whitespace-and (.positive-integer))))
+          (negative-terms (.repeat negative-term-count
+                                   (.whitespace-and (.positive-integer))))
+          (_ (.char= #\newline)))
+    (.identity (make-rule :id id
+                          :positive positive-terms
+                          :negative negative-terms))))
+
+(defun .delimiter-line ()
+  (.progn (.char= #\0)
+          (.or (.char= #\newline)
+               (.eof))
+          (.identity nil)))
+
+(defun .grounded-gdl ()
+  (.let* ((rules (.first (.map 'list (.rule-line))))
+          (_ (.delimiter-line))
+          (index (.first (.map 'list (.index-line))))
+          (_ (.delimiter-line))
+          )
+    (.identity (list :rules rules :index index))))
+
+
+(defun parse-raw-grounded (raw)
+  (values (parse (.grounded-gdl) raw)))
+
+
+;;;; API ----------------------------------------------------------------------
+(defun ground-raw (filename)
+  (uiop/run-program:run-program
+    `("/Users/sjl/src/fluxplayer/trunk/src/groundgdl.sh" ,filename "-")
+    :force-shell nil
+    :output :string))
+
+(defun ground-gdl (filename)
+  (parse-raw-grounded (ground-raw filename)))
+
+
+; (ground-gdl "gdl/buttons.gdl")