;;; -*-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 (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 (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!)

(empty-list-is-false-for-backward-compatibility #t)
