;; $Id: main.ss,v 1.15 2009/05/16 23:50:11 neilpair Exp $

#lang r5rs

(#%require (only scheme/base
                 current-inexact-milliseconds
                 error
                 print-mpair-curly-braces
                 print-pair-curly-braces
                 random)
           (planet soegaard/sicp:2:=1/sicp)
           (only "uninstall.ss" uninstall-sicp))

(define-syntax sicp-error
  (syntax-rules ()
    ((_ REASON ARG ...) (error REASON ARG ...))))

(define true #t)

(define false #f)

(define nil '())

(define (identity x) x)

(define (inc x) (+ x 1))

(define (dec x) (- x 1))

(define (runtime)
  (inexact->exact (truncate (* 1000 (current-inexact-milliseconds)))))

(define (sicp-random x)
  (if (zero? x)
      (error 'random
             "You called \"(random 0)\".  If you're doing SICP section 1.2.6, don't use 1 for the first argument of \"fast-prime?\".")
      (random x)))

(define-syntax sicp-syntax-error
  (syntax-rules ()
    ((_) #f)))

;; Note: This only works with top-level "define" in PLT.
;;
;; (define-syntax sicp-define
;;   (syntax-rules ()
;;     ((_ A B0 B1 ...)
;;      (sicp-define:1 (define A B0 B1 ...) A))))
;;
;; (define-syntax sicp-define:1
;;   (syntax-rules ()
;;     ((_ DEF (X0 X1 ...))
;;      (sicp-define:1 DEF  X0))
;;     ((_ DEF ())
;;      (%sicp-syntax-error "Invalid define form"))
;;     ((_ DEF X0)
;;      (begin DEF (quote X0)))))

(define-syntax check-expect
  (syntax-rules ()
    ((_ VAL EXPECT)
     (check-expect-internal 'check-expect
                            equal?
                            (quote VAL)
                            VAL
                            EXPECT))))

(define-syntax check-expect-approx
  (syntax-rules ()
    ((_ VAL EXPECT)
     (check-expect-internal 'check-expect-approx
                            approx-equal?
                            (quote VAL)
                            VAL
                            EXPECT))))

(define (check-expect-internal name check-proc val-syntax val expected)
  (display name)
  (display ": ")
  (write (quote VAL))
  (display " \u21D2 ")
  (let ((v VAL)
        )
    (display val)
    (newline)
    (if (check-proc val expected)
        (values)
        (error name
               "Test failed: expected ~S"
               expected))))

(define (approx-equal? a b)
  (< (abs (- a b)) 1/10000))

(#%provide
 (for-syntax syntax-rules ...)
 (all-from r5rs)
 (all-from (planet soegaard/sicp:2:=1/sicp))
 (all-from "uninstall.ss")
 (rename sicp-error  error)
 (rename sicp-random random)
 check-expect
 check-expect-approx
 dec
 false
 identity
 inc
 nil
 runtime
 true)