(module ft-define "mzscheme-core.ss" 
  
  ;this require block was a side effect of changing the language from #%kernel to mzscheme-core
  (require (rename #%kernel require-for-syntax require-for-syntax)
           (rename #%kernel define-syntaxes define-syntaxes)
           (rename #%kernel define-values define-values))
  
  ; the all-except was added around the existing require-for-syntax of #%kernel
  (require-for-syntax (all-except #%kernel #%module-begin lambda letrec) #%stxcase-scheme #%stx #%qqstx)

  (provide define define-syntax define-for-syntax begin-for-syntax)

  (define-syntaxes (define define-syntax define-for-syntax)
    (let ([mk
	   (lambda (define-values-stx)
	     (lambda (stx)
	       (when (memq (syntax-local-context) '(expression))
		 (raise-syntax-error 
		  #f
		  "not allowed in an expression context"
		  stx))
	       (syntax-case stx ()
		 [(_ id expr)
		  (identifier? #'id)
		  (quasisyntax/loc stx (#,define-values-stx (id) expr))]
		 [(_ id . rest)
		  (identifier? #'id)
		  (raise-syntax-error
		   #f
		   (syntax-case stx ()
		     [(_ id expr ...)
		      "bad syntax (multiple expressions after identifier)"]
		     [(_ id)
		      "bad syntax (zero expressions after identifier)"]
		     [(_ id . rest)
		      "bad syntax (illegal use of `.')"])
		   stx)]
		 [(_ something . rest)
		  (not (stx-pair? #'something))
		  (raise-syntax-error
		   #f
		   "bad syntax"
		   stx
		   #'something)]
		 [(_ proto . body)
		  (let-values ([(id mk-rhs)
				(letrec ([simple-proto
					  ;; check the args and set up a proc-maker; we return
					  ;;  a proc maker instead of a final proc to enable
					  ;;  left-to-right checking of the function protos
					  (lambda (proto)
					    (let-values ([(args mk-rhs)
							  (syntax-case proto ()
							    [(id arg ...)
							     (values (syntax->list #'(arg ...))
								     (lambda (body)
								       (quasisyntax/loc stx (lambda (arg ...)
											      . #,body))))]
							    [(id arg ... . rest)
							     (values (syntax->list #'(arg ... rest))
								     (lambda (body)
								       (quasisyntax/loc stx 
									 (lambda (arg ... . rest)
									   . #,body))))])])
					      (for-each (lambda (a)
							  (unless (identifier? a)
							    (raise-syntax-error
							     #f
							     "not an identifier for procedure argument"
							     stx
							     a)))
							args)
					      (let ([dup (check-duplicate-identifier args)])
						(when dup
						  (raise-syntax-error
						   #f
						   "duplicate argument identifier"
						   stx
						   dup)))
					      mk-rhs))]
					 [general-proto
					  ;; proto is guaranteed to be a stx-pair
					  (lambda (proto)
					    (syntax-case proto ()
					      [(id . rest)
					       (identifier? #'id)
					       (values #'id
						       (simple-proto proto))]
					      [((something . more) . rest)
					       ;; Here's where left-to-right checking comes in:
					       ;;  first check the (something . more), then
					       ;;  the rest.
					       (let-values ([(id mk-rhs) (general-proto #'(something . more))])
						 (let ([mk-inner (simple-proto proto)])
						   (values id
							   (lambda (body)
							     (mk-rhs (list (mk-inner body)))))))]
					      [(other . rest)
					       (raise-syntax-error
						#f
						"bad syntax (not an identifier for procedure name, and not a nested procedure form)"
						stx
						#'other)]))])
				  (general-proto #'proto))])
		    (unless (stx-list? #'body)
		      (raise-syntax-error
		       #f
		       "bad syntax (illegal use of `.' for procedure body)"
		       stx))
		    (when (stx-null? #'body)
		      (raise-syntax-error
		       #f
		       "bad syntax (no expressions for procedure body)"
		       stx))
		    (quasisyntax/loc stx (#,define-values-stx (#,id) #,(mk-rhs #'body))))])))])
      (values (mk #'define-values)
	      (mk #'define-syntaxes)
	      (mk #'define-values-for-syntax))))

  (define-syntaxes (begin-for-syntax)
    (lambda (stx)
      (let ([ctx (syntax-local-context)])
	(unless (memq ctx '(module module-begin top-level))
	  (raise-syntax-error #f "allowed only at the top-level or a module top-level" stx))
	(syntax-case stx ()
	  [(_) #'(begin)]
	  [(_ elem)
	   (not (eq? ctx 'module-begin))
	   (let ([e (local-transformer-expand/capture-lifts
		     #'elem
		     ctx
		     (syntax->list
		      #'(begin
			  define-values
			  define-syntaxes
			  define-values-for-syntax
			  set!
			  let-values
			  let*-values
			  letrec-values
			  lambda
			  case-lambda
			  if
			  quote
			  letrec-syntaxes+values
			  fluid-let-syntax
			  with-continuation-mark
			  #%app
			  #%top
			  #%datum)))])
	     (syntax-case* e (begin define-values define-syntaxes require require-for-template) 
			   module-transformer-identifier=?
	       [(begin v ...)
		#'(begin-for-syntax v ...)]
	       [(define-values (id ...) expr)
		#'(define-values-for-syntax (id ...) expr)]
	       [(require v ...)
		#'(require-for-syntax v ...)]
	       [(require-for-template v ...)
		#'(require v ...)]
	       [(define-syntaxes (id ...) expr)
		(raise-syntax-error
		 #f
		 "syntax definitions not allowed within begin-for-syntax"
		 #'elem)]
	       [other 
		#'(define-values-for-syntax () (begin other (values)))]))]
	  [(_ elem ...)
	   ;; We split up the elems so that someone else can
	   ;;  worry about the fact that properly expanding the second
	   ;;  things might depend somehow on the first thing.
	   ;; This also avoids a problem when `begin-for-syntax' is the
	   ;;  only thing in a module body, and `module' has to expand
	   ;;  it looking for #%module-begin.
	   (syntax/loc stx (begin (begin-for-syntax elem) ...))])))))