lang.ss
#lang scheme
(require (for-syntax scheme/list)
         "parenlog.ss"
         "core.ss")

(provide (except-out (all-from-out scheme)
                     #%module-begin
                     #%top-interaction)
         ? next 
         :-
         (rename-out
          [pl-top-interaction #%top-interaction]
          [pl-module-begin #%module-begin]))

(define current-model (box #f))
(define current-generator (box #f))

(define-syntax (? stx)
  (raise-syntax-error '? "Cannot be used outside parenlog language" stx))
(define-syntax (next stx)
  (raise-syntax-error 'next "Cannot be used outside parenlog language" stx))

(define-syntax (pl-module-begin stx)
  (syntax-case stx ()
    [(_ e ...)
     (let-values ([(stmts queries)
                   (partition (lambda (stx)
                                (syntax-case stx (?)
                                  [(? e) #f]
                                  [_ #t]))
                              (syntax->list #'(e ...)))])
       (with-syntax ([(e-stmt ...) stmts]
                     [(e-query ...) 
                      (map (lambda (stx)
                             (syntax-case stx (?)
                               [(? e) #'e]))
                           queries)])
         (quasisyntax/loc stx
           (#%module-begin 
            (define-model this-model
              e-stmt ...)
            (init-generator/find-one this-model e-query)
            ...
            (set-box! current-model this-model)))))]))

(define-syntax (pl-top-interaction stx)
  (syntax-case stx (next)
    [(_ . next)
     (syntax/loc stx
       (get-next-ans))]
    [(_ . form)
     (quasisyntax/loc stx
       (init-generator/find-one (unbox current-model) form))]))

(define-syntax (init-generator/find-one stx)
  (syntax-case stx ()
    [(_ model-expr query-stx)
     (syntax/loc stx
       (begin (set-box! current-generator
                        (query-answer-generator model-expr (compile-query query-stx)))
              (get-next-ans)))]))

(define (get-next-ans)
  (define gen (unbox current-generator))
  (unless gen
    (error 'parenlog "No active query"))
  (call-with-values gen
                    (case-lambda
                      [() (printf "done~n")]
                      [(ans) (print-ans ans)])))

(define (print-ans ans)
  (cond
    [(eq? generator-done ans)
     (printf "no~n")]
    [else
     (if (zero? (hash-count ans))
         (printf "yes~n")
         (for ([(k v) (in-hash ans)])
           (printf "~a=~a~n" k v)))]))