
(module kw-file "pre-base.ss" 

  (provide -open-input-file
           -open-output-file
           -open-input-output-file
           -call-with-input-file
           -call-with-output-file
           -with-input-from-file
           -with-output-to-file
           call-with-input-file*
           call-with-output-file*)

  (define exists-syms
    '(error append update can-update replace truncate must-truncate truncate/replace))

  (define exists-desc
    "'error, 'append, 'update, 'can-update, 'replace, 'truncate, 'must-truncate, or 'truncate/replace")

  (define -open-input-file
    (let ([open-input-file (lambda (path #:mode [mode 'binary])
                             (unless (path-string? path)
                               (raise-type-error 'open-input-file "path or string" path))
                             (unless (memq mode '(binary text))
                               (raise-type-error 'open-input-file "'binary or 'text" mode))
                             (open-input-file path mode))])
      open-input-file))

  (define -open-output-file
    (let ([open-output-file (lambda (path #:mode [mode 'binary]
                                          #:exists [exists 'error])
                             (unless (path-string? path)
                               (raise-type-error 'open-output-file "path or string" path))
                             (unless (memq mode '(binary text))
                               (raise-type-error 'open-output-file "'binary or 'text" mode))
                             (unless (memq exists exists-syms)
                               (raise-type-error 'open-output-file exists-desc exists))
                             (open-output-file path mode exists))])
      open-output-file))

  (define -open-input-output-file
    (let ([open-input-output-file (lambda (path #:mode [mode 'binary]
                                                #:exists [exists 'error])
                                    (unless (path-string? path)
                                      (raise-type-error 'open-input-output-file "path or string" path))
                                    (unless (memq mode '(binary text))
                                      (raise-type-error 'open-input-output-file "'binary or 'text" mode))
                                    (unless (memq exists exists-syms)
                                      (raise-type-error 'open-input-output-file exists-desc exists))
                                    (open-input-output-file path mode exists))])
      open-input-output-file))

  (define -call-with-input-file
    (let ([call-with-input-file (lambda (path proc #:mode [mode 'binary])
                             (unless (path-string? path)
                               (raise-type-error 'call-with-input-file "path or string" path))
                             (unless (and (procedure? proc)
                                          (procedure-arity-includes? proc 1))
                               (raise-type-error 'call-with-input-file "procedure (arity 1)" proc))
                             (unless (memq mode '(binary text))
                               (raise-type-error 'call-with-input-file "'binary or 'text" mode))
                             (call-with-input-file path proc mode))])
      call-with-input-file))

  (define -call-with-output-file
    (let ([call-with-output-file (lambda (path proc 
                                               #:mode [mode 'binary]
                                               #:exists [exists 'error])
                             (unless (path-string? path)
                               (raise-type-error 'call-with-output-file "path or string" path))
                             (unless (and (procedure? proc)
                                          (procedure-arity-includes? proc 1))
                               (raise-type-error 'call-with-output-file "procedure (arity 1)" proc))
                             (unless (memq mode '(binary text))
                               (raise-type-error 'call-with-output-file "'binary or 'text" mode))
                             (unless (memq exists exists-syms)
                               (raise-type-error 'call-with-output-file exists-desc exists))
                             (call-with-output-file path proc mode exists))])
      call-with-output-file))
  
  (define -with-input-from-file
    (let ([with-input-from-file (lambda (path proc #:mode [mode 'binary])
                             (unless (path-string? path)
                               (raise-type-error 'with-input-from-file "path or string" path))
                             (unless (and (procedure? proc)
                                          (procedure-arity-includes? proc 0))
                               (raise-type-error 'with-input-from-file "procedure (arity 0)" proc))
                             (unless (memq mode '(binary text))
                               (raise-type-error 'with-input-from-file "'binary or 'text" mode))
                             (with-input-from-file path proc mode))])
      with-input-from-file))

  (define -with-output-to-file
    (let ([with-output-to-file (lambda (path proc
                                             #:mode [mode 'binary]
                                             #:exists [exists 'error])
                             (unless (path-string? path)
                               (raise-type-error 'with-output-to-file "path or string" path))
                             (unless (and (procedure? proc)
                                          (procedure-arity-includes? proc 0))
                               (raise-type-error 'with-output-to-file "procedure (arity 0)" proc))
                             (unless (memq mode '(binary text))
                               (raise-type-error 'with-output-to-file "'binary or 'text" mode))
                             (unless (memq exists exists-syms)
                               (raise-type-error 'with-output-to-file exists-desc exists))
                             (with-output-to-file path proc mode exists))])
      with-output-to-file))

  (define call-with-input-file*
    (lambda (path proc #:mode [mode 'binary])
      (unless (path-string? path)
        (raise-type-error 'call-with-input-file* "path or string" path))
      (unless (and (procedure? proc)
                   (procedure-arity-includes? proc 1))
        (raise-type-error 'call-with-input-file* "procedure (arity 1)" proc))
      (unless (memq mode '(binary text))
        (raise-type-error 'call-with-input-file* "'binary or 'text" mode))
      (let ([p (open-input-file path mode)])
        (dynamic-wind
            void
            (lambda () (proc p))
            (lambda () (close-input-port p))))))

  (define call-with-output-file*
    (lambda (path proc 
                  #:mode [mode 'binary]
                  #:exists [exists 'error])
      (unless (path-string? path)
        (raise-type-error 'call-with-output-file* "path or string" path))
      (unless (and (procedure? proc)
                   (procedure-arity-includes? proc 1))
        (raise-type-error 'call-with-output-file* "procedure (arity 1)" proc))
      (unless (memq mode '(binary text))
        (raise-type-error 'call-with-output-file* "'binary or 'text" mode))
      (unless (memq exists exists-syms)
        (raise-type-error 'call-with-output-file* exists-desc exists))
      (let ([p (open-output-file path mode exists)])
        (dynamic-wind
            void
            (lambda () (proc p))
            (lambda () (close-output-port p)))))))
