(module mzscheme-utils "mzscheme-core.ss"
  
  (require (all-except mzscheme
                       module
                       #%app
                       #%top
                       #%datum
                       #%plain-module-begin
                       #%module-begin
                       if
                       lambda
                       case-lambda
                       ;apply
                       reverse
                       list-ref
                       require
                       provide
                       letrec
                       match
                       cons car cdr pair? null?
                       caar cdar cadr cddr caddr cdddr cadddr cddddr
                       make-struct-type
                       make-struct-field-accessor
                       make-struct-field-mutator
                       vector
                       vector-ref
		       quasiquote
                       ;qq-append
                       define-struct
                       list
		       list*
		       list?
		       append
                       and
                       or
                       cond when unless ;case
                       map ormap andmap assoc member)
           (rename mzscheme mzscheme:if if)
           (rename "lang-ext.ss" lift lift)
           (rename "frp-core.ss" super-lift super-lift)
           (rename "frp-core.ss" behavior? behavior?)
           (rename "lang-ext.ss" undefined undefined)
           (rename "lang-ext.ss" undefined? undefined?))
  
  (require (lib "class.ss"))
  
  
  (define (list-ref lst idx)
    (if (lift #t positive? idx)
        (list-ref (cdr lst) (lift #t sub1 idx))
        (car lst)))
  
  ;(define (frp:eq? itm1 itm2)
  ;  (lift #t eq? itm1 itm2))

  
  (define-syntax cond
    (syntax-rules (else =>)
      [(_ [else result1 result2 ...])
       (begin result1 result2 ...)]
      [(_ [test => result])
       (let ([temp test])
         (if temp (result temp)))]
      [(_ [test => result] clause1 clause2 ...)
       (let ([temp test])
         (if temp
             (result temp)
             (cond clause1 clause2 ...)
             (cond clause1 clause2 ...)))]
      [(_ [test]) test]
      [(_ [test] clause1 clause2 ...)
       (let ((temp test))
         (if temp
             temp
             (cond clause1 clause2 ...)
             (cond clause1 clause2 ...)))]
      [(_ [test result1 result2 ...])
       (if test (begin result1 result2 ...))]
      [(_ [test result1 result2 ...]
          clause1 clause2 ...)
       (if test
           (begin result1 result2 ...)
           (cond clause1 clause2 ...)
           (cond clause1 clause2 ...))]))
  
  (define-syntax and
    (syntax-rules ()
      [(_) #t]
      [(_ exp) exp]
      [(_ exp exps ...) (if exp
                            (and exps ...)
                            #f)]))
  
  (define-syntax or
    (syntax-rules ()
      [(_) #f]
      [(_ exp) exp]
      [(_ exp exps ...) (let ([v exp])
                          (if v
                              v
                              (or exps ...)
                              (or-undef exps ...)))]))
  
  
    (define-syntax or-undef
    (syntax-rules ()
      [(_) undefined]
      [(_ exp) (let ([v exp]) (if v v undefined))]
      [(_ exp exps ...) (let ([v exp])
                          (if v
                              v
                              (or-undef exps ...)
                              (or-undef exps ...)))]))
  

  
  (define-syntax when
    (syntax-rules ()
      [(_ test body ...) (if test (begin body ...))]))
  
  (define-syntax unless
    (syntax-rules ()
      [(_ test body ...) (if (not test) (begin body ...))]))
  
  (define (ormap proc lst)
    (and (pair? lst)
         (or (proc (car lst)) (ormap proc (cdr lst)))))
  
  (define (andmap proc lst)
    (or (null? lst)
        (and (proc (car lst)) (andmap proc (cdr lst)))))
  
  (define (caar v)
    (car (car v)))
  
  (define (cdar v)
    (cdr (car v)))
  
  (define (cadr v)
    (car (cdr v)))
  
  (define (cddr v)
    (cdr (cdr v)))
  
  (define (caddr v)
    (car (cddr v)))
  
  (define (cdddr v)
    (cdr (cddr v)))
  
  (define (cadddr v)
    (car (cdddr v)))
  
  (define (cddddr v)
    (cdr (cdddr v)))
 
  #|
  (define-syntax frp:case
    (syntax-rules ()
      [(_ expr clause ...)
       (super-lift (lambda (v) (case v clause ...)) expr)]))
  |#
  (define (split-list acc lst)
    (if (null? (cdr lst))
        (values acc (car lst))
        (split-list (append acc (list (car lst))) (cdr lst))))
  
  (define frp:apply
    (lambda (fn . args)
      (if (behavior? args)
          (super-lift
           (lambda (args)
             (apply apply fn args))
           args)
          (apply apply fn args))))
  #|
  ;; taken from startup.ss
  (define-syntax frp:case
    (lambda (x)
      (syntax-case x (else)
	((_ v)
	 (syntax (begin v (cond))))
	((_ v (else e1 e2 ...))
	 (syntax/loc x (begin v e1 e2 ...)))
	((_ v ((k ...) e1 e2 ...))
	 (syntax/loc x (if (memv v '(k ...)) (begin e1 e2 ...))))
	((_ v ((k ...) e1 e2 ...) c1 c2 ...)
	 (syntax/loc x (let ((x v))
			 (if (memv x '(k ...))
			     (begin e1 e2 ...)
			     (frp:case x c1 c2 ...)))))
	((_ v (bad e1 e2 ...) . rest)
	 (raise-syntax-error 
	  #f
	  "bad syntax (not a datum sequence)"
	  x
	  (syntax bad)))
	((_ v clause . rest)
	 (raise-syntax-error 
	  #f
	  "bad syntax (missing expression after datum sequence)"
	  x
	  (syntax clause)))
	((_ . v)
	 (not (null? (syntax-e (syntax v))))
	 (raise-syntax-error 
	  #f
	  "bad syntax (illegal use of `.')"
	  x)))))
  
  
|#
  
  (define-syntax frp:case
    (syntax-rules ()
      [(_ exp clause ...)
       (let ([v exp])
         (vcase v clause ...))]))
  
  (define-syntax vcase
    (syntax-rules (else)
      [(_ v [else exp ...])
       (begin exp ...)]
      [(_ v [dl exp ...])
       (if (lift #t memv v (quote dl))
           (begin exp ...))]
      [(_ v [dl exp ...] clause ...)
       (if (lift #t memv v (quote dl))
           (begin exp ...)
           (vcase v clause ...))]))
  
  (define map
    (case-lambda
      [(f l) (if (pair? l)
                 (cons (f (car l)) (map f (cdr l)))
                 null)]
      [(f l1 l2) (if (and (pair? l1) (pair? l2))
                     (cons (f (car l1) (car l2)) (map f (cdr l1) (cdr l2)))
                     null)]
      [(f l . ls) (if (and (pair? l) (andmap pair? ls))
                      (cons (apply f (car l) (map car ls)) (apply map f (cdr l) (map cdr ls)))
                      null)]))
  

  (define (frp:length lst)
    (cond
     [(pair? lst) (lift #t add1 (frp:length (cdr lst)))]
     [(null? lst) 0]
     [else (error 'length (format "expects list, given ~a" lst))]))
  
  (define (reverse lst)
    (let loop ([lst lst] [acc ()])
      (if (pair? lst)
          (loop (cdr lst) (cons (car lst) acc))
          acc)))
  
  (define-syntax (lifted-send stx)
    (syntax-case stx ()
      [(_ obj meth arg ...)
       (with-syntax ([(obj-tmp) (generate-temporaries '(obj))]
                     [(arg-tmp ...) (generate-temporaries (syntax->list #'(arg ...)))])
         #'(lift #t 
                 (lambda (obj-tmp arg-tmp ...)
                   (send obj-tmp meth arg-tmp ...))
                 obj arg ...))])) 
  
  (provide cond 
           and 
           or 
           or-undef 
           when 
           unless
           map
           ormap 
           andmap
           caar
           cadr
           cddr
           caddr
           cdddr
           cadddr
           cddddr
           ;case
           build-path
           collection-path
           
           list-ref
           (rename frp:case case)
           (rename frp:apply apply)
           (rename frp:length length)
           reverse
           
           (lifted + - * / = 
                   eq? 
                   equal? eqv? < > <= >= 
                   add1 cos sin tan symbol->string symbol?
                   number->string string->symbol eof-object? exp expt even? odd? string-append eval ; list-ref
                   sub1 sqrt not number? string? zero? min max modulo
                   string->number void? rational? char? char-upcase char-ci>=? char-ci<=?
                   string>=? char-upper-case? char-alphabetic?
                   string<? string-ci=? string-locale-ci>?
                   string-locale-ci<? string-locale-ci=? atan asin acos exact? magnitude imag-part
                   real-part numerator abs log lcm gcd arithmetic-shift integer-sqrt make-rectangular
                   complex? char>? char<? char=?
                   char-numeric? date-time-zone-offset list->string substring string->list
                   string-ci<? string-ci>=? string<=? string-ci<=? string>? string-locale<? string=?
                   string-length string-ref
                   floor angle round
                   ceiling real? date-hour procedure? procedure-arity
                   rationalize date-year-day date-week-day date? date-dst? date-year date-month date-day
                   date-minute date-second make-date char-downcase char>=? char<=? char->integer integer->char boolean?
                   integer? quotient remainder positive? negative? inexact->exact exact->inexact
                   make-polar denominator truncate bitwise-not bitwise-xor bitwise-and bitwise-ior inexact?
                   char-whitespace? assq assv memq memv list-tail ;reverse
                   ;length
                   
                   regexp-match
                   
                   seconds->date
                   expand syntax-object->datum exn-message continuation-mark-set->list exn-continuation-marks
                   exn:fail?
                   list->vector make-vector)
            
           (rename eq? mzscheme:eq?)
           make-exn:fail  current-inspector make-inspector
           make-namespace namespace? namespace-symbol->identifier namespace-variable-value
           namespace-set-variable-value! namespace-undefine-variable! namespace-mapped-symbols
           parameterize current-seconds current-milliseconds current-inexact-milliseconds
           call-with-values make-parameter
           null
           gensym collect-garbage
           error set! printf fprintf current-error-port for-each void
           procedure-arity-includes? raise-type-error raise thread
           current-continuation-marks
           raise-mismatch-error require-for-syntax define-syntax syntax-rules syntax-case
          ; set-eventspace
	   ;install-errortrace-key
           (lifted:nonstrict format)
           print-struct
           ;lambda
           ;case-lambda
           define
           let
           let*
           values
           let*-values           
           let-values
           define-values
           begin
           begin0
           quote
           unquote
           unquote-splicing

           syntax
           unsyntax
           unsyntax-splicing
           
           current-security-guard
           make-security-guard
           dynamic-require
           path->complete-path
           string->path
           split-path
           current-directory
           exit
           system-type
           lifted-send
           
           
           
           let/ec
           with-handlers
           delay
           force
           random
           sleep
           read-case-sensitive
           file-exists?
           with-input-from-file
           read

         
           
          ; null
        ;   make-struct-field-mutator
           )
  
  ; from core
  (provide (all-from "mzscheme-core.ss"))
           
  )