#lang scheme/base

(provide s-exp->fasl
         fasl->s-exp)

(define (s-exp->fasl v [out #f])
  (when out
    (unless (output-port? out)
      (raise-type-error 'fasl->s-exp "output-port or #f" out)))
  (let ([p (or out
               (open-output-bytes))])
    (parameterize ([current-namespace (make-base-namespace)])
      (write (compile `(quote ,v)) p))
    (if out
        (void)
        (get-output-bytes p))))

(define (fasl->s-exp b)
  (unless (or (bytes? b)
              (input-port? b))
    (raise-type-error 'fasl->s-exp "bytes or input-port" b))
  (let ([p (if (bytes? b)
               (open-input-bytes b)
               b)])
    (let ([e (parameterize ([read-accept-compiled #t])
               (read p))])
      (if (compiled-expression? e)
          (parameterize ([current-namespace (make-base-namespace)])
            (eval e))
          e))))