(module syntax-errors mzscheme

  (require (lib "contract.ss")
           (lib "plt-match.ss")
           "../../private/planet.ss")
  (require-cce/scheme)

  (provide syntax-case/error syntax-case/name)

  (define raised-exn/c
    (flat-named-contract "raised-exception" (lambda (v) #f)))

  (provide/contract
   [current-syntax (parameter/c (or/c syntax? false/c))]
   [syntax-error (->* [(or/c syntax? symbol?) string?] list? [raised-exn/c])]
   [nyi (-> syntax? raised-exn/c)])

  (define current-syntax (make-parameter #f))

  (define (syntax-error stx fmt . args)
    (unless (syntax? stx)
      (error 'syntax-error "not a syntax object: ~s" stx))
    (let* ([parent (current-syntax)]
           [message (apply format fmt args)])
      (if parent
          (raise-syntax-error #f message parent stx)
          (raise-syntax-error '? message stx))))

  (define-syntax (syntax-case/name stx)
    (syntax-case stx ()
      [(scn expr lits . clauses)
       (syntax/loc stx
         (syntax-case* expr lits text=? . clauses))]))

  (define-syntax (syntax-case/error stx)
    (syntax-case stx ()
      [(sce expr lits . clauses)
       (syntax/loc stx
         (parameterize ([current-syntax expr])
           (syntax-case/name (current-syntax) lits . clauses)))]))

  (define (nyi stx) (raise-syntax-error #f "not yet implemented" stx))

  )