;;; -*-Scheme-*-
;;;
;;; Some C-Scheme compatibility hacks

(provide 'cscheme)

(define-macro (syntax-table-define table name mac)
  `(define ,(eval name) ,mac))

(define mapcar map)

(define user-initial-environment (global-environment))

(define (rep-environment) (global-environment))

(define (atom? x)
  (not (pair? x)))

(define nil '())

(define *the-non-printing-object* #v)

(define (integer->string i)
  (format #f "~s" i))

(define (get* sym prop)
  (let ((ret (get sym prop)))
    (if ret ret '())))

(define-macro (access sym env)
  `(eval ',sym ,env))

(define-macro (in-package env . body)
  `(eval '(begin ,@body) ,env))

(define-macro (without-interrupts thunk)
  `(,thunk))

(define-macro (rec var exp)
  `(letrec ((,var ,exp)) ,exp))

(define (caaaar x) (car (caaar x)))
(define (caaadr x) (car (caadr x)))
(define (caadar x) (car (cadar x)))
(define (caaddr x) (car (caddr x)))
(define (cadaar x) (car (cdaar x)))
(define (cadadr x) (car (cdadr x)))
(define (caddar x) (car (cddar x)))
(define (cadddr x) (car (cdddr x)))
(define (cdaaar x) (cdr (caaar x)))
(define (cdaadr x) (cdr (caadr x)))
(define (cdadar x) (cdr (cadar x)))
(define (cdaddr x) (cdr (caddr x)))
(define (cddaar x) (cdr (cdaar x)))
(define (cddadr x) (cdr (cdadr x)))
(define (cdddar x) (cdr (cddar x)))
(define (cddddr x) (cdr (cdddr x)))

(define (cons* first . rest)
  (let loop ((curr first) (rest rest))
    (if (null? rest)
	curr
	(cons curr (loop (car rest) (cdr rest))))))

(define sequence begin)

(define -1+ 1-)

(define close-input-port close-port)
(define close-output-port close-port)

(define (remq x y)
  (cond ((null? y) y)
	((eq? x (car y)) (remq x (cdr y)))
	(else (cons (car y) (remq x (cdr y))))))

(define (remv x y)
  (cond ((null? y) y)
	((eqv? x (car y)) (remv x (cdr y)))
	(else (cons (car y) (remv x (cdr y))))))

(define (remove x y)
  (cond ((null? y) y)
	((equal? x (car y)) (remove x (cdr y)))
	(else (cons (car y) (remove x (cdr y))))))

(define (remq! x y)
  (cond ((null? y) y)
	((eq? x (car y)) (remq! x (cdr y)))
	(else (let loop ((prev y))
		(cond ((null? (cdr prev))
		       y)
		      ((eq? (cadr prev) x)
		       (set-cdr! prev (cddr prev))
		       (loop prev))
		      (else (loop (cdr prev))))))))

(define (remv! x y)
  (cond ((null? y) y)
	((eqv? x (car y)) (remv! x (cdr y)))
	(else (let loop ((prev y))
		(cond ((null? (cdr prev))
		       y)
		      ((eqv? (cadr prev) x)
		       (set-cdr! prev (cddr prev))
		       (loop prev))
		      (else (loop (cdr prev))))))))

(define (remove! x y)
  (cond ((null? y) y)
	((equal? x (car y)) (remove! x (cdr y)))
	(else (let loop ((prev y))
		(cond ((null? (cdr prev))
		       y)
		      ((equal? (cadr prev) x)
		       (set-cdr! prev (cddr prev))
		       (loop prev))
		      (else (loop (cdr prev))))))))

(define delq remq)
(define delv remv)
(define delete remove)
(define delq! remq!)
(define delv! remv!)
(define delete! remove!)
