; KANREN prelude specific to PLT-Scheme
;
; $Id: $
(module plt-specific mzscheme
  
  ;(define plt-error error)
  ;(define error
  ;  (lambda (msg . args)
  ;    (plt-error "myerror" msg args)))
  (define errorf error)
  
  ; like cout << arguments << args
  ; where argument can be any Scheme object. If it's a procedure
  ; (without args) it's executed rather than printed (like newline)
  (define (cout . args)
    (for-each (lambda (x)
                (if (procedure? x) (x) (display x)))
              args))
  
  (define (cerr . args)
    (for-each (lambda (x)
                (if (procedure? x) (x (current-error-port)) (display x (current-error-port))))
              args))
  
  (define nl (string #\newline))
  
  ; Implementation of SRFI-0
  (define-syntax cond-expand
    (syntax-rules (else mzscheme srfi-0 and or not)
      ((cond-expand)
       (error "Unfulfilled cond-expand"))
      ((cond-expand (else . cmd-or-defs*))
       (begin . cmd-or-defs*))
      ((cond-expand "feature-id" mzscheme kt kf) kt)
      ((cond-expand "feature-id" srfi-0 kt kf) kt)
      ((cond-expand "feature-id" x kt kf) kf)
      ((cond-expand "satisfies?" (and) kt kf) kt)
      ((cond-expand "satisfies?" (and clause) kt kf)
       (cond-expand "satisfies?" clause kt kf))
      ((cond-expand "satisfies?" (and clause . rest) kt kf)
       (cond-expand "satisfies?" clause
                    (cond-expand "satisfies?" (and . rest) kt kf) kf))
      ((cond-expand "satisfies?" (or) kt kf) kf)
      ((cond-expand "satisfies?" (or clause) kt kf)
       (cond-expand "satisfies?" clause kt kf))
      ((cond-expand "satisfies?" (or clause . rest) kt kf)
       (cond-expand "satisfies?" clause kt
                    (cond-expand "satisfies?" (or . rest) kt kf)))
      ((cond-expand "satisfies?" (not clause) kt kf)
       (cond-expand "satisfies?" clause kf kt))
      ((cond-expand "satisfies?" x kt kf)
       (cond-expand "feature-id" x kt kf))
      
      ((cond-expand (feature-req . cmd-or-defs*) . rest-clauses)
       (cond-expand "satisfies?" feature-req
                    (begin . cmd-or-defs*)
                    (cond-expand . rest-clauses)))))
  
  (provide (all-defined)))