; Standard library
(define (abs n)
	(if (real? n)
		(if (>= n 0) n (- n))
		(magnitude n)))
(define (%assoc test)
	(lambda (x ls)
	(letrec ((ahelp (lambda (l)
	(cond ((null? l) #f)
		((test x (caar l)) (car l))
		(else (ahelp (cdr l)))))))
	(ahelp ls))))
(define (assoc x ls)
	((%assoc equal?) x ls))
(define (assq x ls)
	((%assoc eq?) x ls))
(define (assv x ls)
	((%assoc eqv?) x ls))
(define (car x) (car x))
(define (cadr x) (cadr x))
(define (delete-record db n)
	(write-record db n #f))
(macro  (do expr)
  (let ((loop (gensym))
        (vars (cadr expr))
        (step (lambda (v) 
	(if (null? (cddr v)) (car v) 
		(caddr v)))))
    `(letrec ((,loop (lambda 
		,(map car vars)
       (cond ,(caddr expr)
         (else ,@(cdddr expr)
          (,loop ,@(map step vars)))))))
     (,loop ,@(map cadr vars)))))
(define (eq? a b) (eq? a b))
(define (eqv? a b) (eqv? a b))
(define (equal? a b)
	(cond ((eqv? a b) #t)
	((and (string? a) (string? b))
	    (string=? a b))
	((and (pair? a) (pair? b))
	    (and (equal? (car a) (car b))
		    (equal? (cdr a) (cdr b))))
	((and (vector? a) (vector? b))
	    (%vec-equal? a b))
	(else #f)))
(define (%vec-equal? a b)
  (letrec ((help (lambda (k)
	(if (eq? k -1) #t 
	(and (equal? (vector-ref a k)
			(vector-ref b k))
		(help (- k 1)))))))
  (let ((l (vector-length a)))
	(and (eq? l (vector-length b))
	  (help (- l 1))))))
(define (even? n)
	(= (remainder n 2) 0))
(define (exact? x) #f)
(define (expt x y) 
	(exp (* y (log x))))
(define (for-each f l)
	(if (null? l) #n
	(begin (f (car l))
		 (for-each f (cdr l)))))
(define (inexact? x) #t)
(define (input prompt)
  (string->object 
    (input-string prompt)))
(define (input-string prompt)
  (frm-popup 9993 (lambda (e . a)
    (case e
      ((frm-open) 
	(fld-set-text 9301 prompt)
	(frm-set-focus 9302))
      ((ctl-select)
	(case (car a)
	  ((9303) (frm-return 
		(fld-get-text 9302)))
	  ((9304) 
		(error "Interrupted"))))
      (else #f)))))
(define (length l)
	(letrec ((iter (lambda (l n)
		    (if (null? l) n
		      (iter (cdr l) (+ 1 n))))))
	(iter l 0)))
(macro  (let* expr)
  (if (null? (cadr expr))
    (cons 'begin (cddr expr))
    `(let (,(caadr expr))
       (let* ,(cdadr expr)
		,@(cddr expr)))))
(define (list-ref ls n)
	(if (eq? n 0) (car ls)
		(list-ref (cdr ls) (- n 1))))
(define (log10 x) (/ (log x) (log 10)))
(define (map f l)
  (letrec ((result (cons '() '()))
	(helper (lambda (p l)
	  (cond ((null? l)  p)
	    (else (set-cdr! p
			(cons (f (car l)) '()))
		(helper (cdr p) (cdr l)))))))
	(helper result l)
	(cdr result)))
(define (max n . l)
	(if (null? l) n
	  (let ((m (apply max l)))
	    (if (<= n m) m n))))
(define (%member test)
	(lambda (x ls)
	(letrec
	((mhelp (lambda (l)
	    (cond  ((null? l) #f)
		((test x (car l)) l)
		(else (mhelp (cdr l)))))))
 	(mhelp ls))))
(define (member x ls)
	((%member equal?) x ls))
(define (memq x ls)
	((%member eq?) x ls))
(define (memv x ls)
	((%member eqv?) x ls))
(define (min n . l)
	(if (null? l) n
	  (let ((m (apply min l)))
	    (if (<= n m) n m))))
(define (modulo a b)
	(let ((r (remainder a b)))
	(if (>= (* r b) 0) r
		(+ r b))))
(define (negative? x) (< x 0))
(define (newline . p)
	(if (null? p) (display ##0a)
		(display ##0a (car p))))
(define (odd? n)
	(= (remainder n 2) 1))
(define (port? p) (or (input-port? p)
	(output-port? p)))
(define (positive? x) (> x 0))
(define (reverse l) 
	(letrec
	((rev (lambda (a b)
		 (if (null? a) b
		(rev (cdr a)
			 (cons (car a) b))))))
 	(rev l '())))
(define (wait-pen)
  (let ((e (event #t)))
    (if (and (pair? e) 
		(eq? (car e) 'pen-down))
	(cons (cadr e) (caddr e))
	(wait-pen))))
(define (zero? x) (eqv? x 0))
(define (= x y) (eqv? x y))
