#lang racket

(require "../../printer.rkt")

(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)))
    (current-read-interaction even-read)))

(require "../parser.rkt"
         "../lexer.rkt")

; XXX This is taken from datalog, and is therefore almost certainly wrong.

; ok, so /this/ isn't taken from datalog
(define (handler exn)
  ; we have to switch back to even-read
  #;(displayln "the code that was generated raised an exception!")
  #;(displayln "switching to even-read")
  (current-read-interaction even-read)
  (raise exn))
; neither is this
(define (wrap-with-handler stx)
  (syntax-case stx (define-values)
    [(define-values . rest)
     stx]
    [else
     (quasisyntax/loc stx
       (with-handlers ([exn:fail? handler])
         #,stx))]))

; _this_ is
(define (even-read src ip)
  (begin
    #;(displayln "switching to odd-read")
    (current-read-interaction odd-read)
    (let ([srcname (if (string? src)
                         src
                         (if (symbol? src)
                             src
                             (if (path? src)
                                 src
                                 (begin
                                   (printf "using false as source name\n")
                                   #f))))])
        (parameterize ([lexer-source-name srcname]
                       [parser-source-name srcname])
          (with-handlers ([exn:fail?
                           (lambda (exn)
                             ; switch back to even-read
                             ; (displayln "caught a lexer/parser exception -- switching back to even-read")
                             (current-read-interaction even-read)
                             ; and raise the exception
                             (raise exn))])
            (wrap-with-handler (expand (repl-parser (lambda () (expression-lexer ip))))))))))
(define (odd-read src ip)
  #;(displayln "switching to even-read")
  (current-read-interaction even-read)
  eof)