(module util scheme/base

  (require scheme/pretty)
  ;;(lib "pretty.ss")
  ;;(lib "list.ss")

  ;; UTILITY
  (provide (all-defined-out))

  (define-syntax forever
    (syntax-rules ()
      ((_ (e . e+))
       (let next ()
         (e . e+)
         (next)))))
  
  (define (error->false thunk)
    (with-handlers
        (((lambda (ex) #t)
          (lambda (ex) #f)))
      (thunk)))

  ;; DEBUG

  (define *debug* #f)
  (define (debug . args)
    (if (null? args)
        *debug*
        (set! *debug* #t)))


  ;; ERRORS
  
  ;; For interactive use only, we don't propagate errors upstream, but
  ;; print them to console. Just wrap an expression with this
  ;; macro. This uses the default error printer.

  (define ((error-print prefix) ex)
    (display prefix)
    (if (exn? ex)
        ((error-display-handler)
         (exn-message ex)
         ex)
        (printf "~a\n" ex)))
  
  (define-syntax with-error-print
    (syntax-rules ()
      ((_ prefix expr)
       (with-handlers
           ((void (error-print prefix)))
         expr))))


  ;; CONSOLE
  
  ;; Create a completer function from a symbol generator.
  (define ((make-completer symbols-thunk) str)
    (let ((n (string-length str)))
      (filter
       (lambda (symbol-name)
         (error->false
          (lambda ()
            (equal? str (substring symbol-name 0 n)))))
       (map symbol->string
            (symbols-thunk)))))
    
  ;; utilities for interfacing to scheme languages
  
  ;; string reader
  (define (string->expressions str)
    (define e '())
    (let ((port (open-input-string str)))
      (let next ()
        (let ((expr
               (parameterize
                   ((read-accept-reader #t))
                 (read port))))
          (unless (eof-object? expr)
            (set! e (cons expr e))
            (next)))))
    (reverse e))

  (define (eval-values eval-lang expr)
    (call-with-values
        (lambda () (eval-lang expr))
      (lambda v v)))

  (define pp pretty-print)
  (define (eval-repl eval-lang str)
    (for-each
     (lambda (e)
       (for-each 
        (lambda (ee)
          (when (not (void? ee))
            (pp ee)))
        (eval-values eval-lang e)))
     (string->expressions str)))
  
  
  )