bsl/lang/configure-runtime.rkt
#lang racket

(require syntax/strip-context)

(require (planet wrturtle/pyret/bsl/printer))
(require (planet wrturtle/pyret/bsl/parse))
(require (planet wrturtle/pyret/bsl/lex))
(require (planet wrturtle/pyret/bsl/form-1))
(require (planet wrturtle/pyret/bsl/check))

(provide configure)

(define (configure data)
  (let ([old-current-print (current-print)]
        [old-current-read-interaction (current-read-interaction)])
    (current-print (lambda (v)
                     (pyret-print v)
                     #;[printf "rerouting to old current print\n"]
                     #;[old-current-print v]))
    (current-read-interaction even-read))
  
  )

; XXX This is taken from Datalog, and so, is almost certainly wrong
(define (even-read src ip)
  (begin0
    (parameterize ([current-source-name src])
      (let ([parse
             (program-parser
              (lambda ()
                (expression-lexer ip)))])
        (if (stage-1-parse? parse)
            (let ([val (check-and-compile parse)])
              (if (list? val)
                  (begin #;(printf "parse is a list\n") (strip-context (datum->syntax #f val)))
                  val))
            eof)))
    (current-read-interaction odd-read)))
(define (odd-read src ip)
  (current-read-interaction even-read)
  eof)