;; Some simple examples compiling scheme -> x86



;; something simple to start

(define my-sqr

   (lambda (x)

      (* x x)))

;; first we compile the closure my-sqr and define the result

(define my-compiled-sqr (sys:compile my-sqr))

;; now we can call my-compiled-sqr

(my-compiled-sqr 7.0)

;; also runs fine as a normal scheme call

(my-sqr 7.0)

;; print will show us the difference but both do the same thing

;; my-sqr is a scheme closure

;; my-compiled-sqr is an ffi call (x86 code)

(print my-sqr my-compiled-sqr)

;; of course we can use our compiled function anywhere

;; that we could usually use a scheme function

(define proof

   (lambda (x)

      (dotimes (i x)

         (my-compiled-sqr i))


(proof 100)

;; what happens if we try to compile proof

(define my-compiled-proof (sys:compile proof))

;; you should have a compiler warning 

;; this warning basically states that the compiler doesn't know what 'my-compiled-sqr' is

;; this is fare enough as it's a scheme closure and not native x86 code


;; however the compiler has kindly offered to interpret this expression for us at runtime

;; so we can still call my-compiled-proof

(my-compiled-proof 1000)

;; this is quite slow however, let's time it with 1000000 iterations

(let ((t (now)))

   (my-compiled-proof 1000000)

   (print 'done-in (rational->real (/ (- (now) t) *samplerate*)) 'seconds))

;; however, we can remove the scheme call to my-compiled-sqr by using the compiled

;; version of my-compiled-sqr. Somewhat confusingly this version is called my-sqr.

;; When you called (sys:compile my-sqr) internally the compiler remembers this compiled

;; code by the name of the closure you pass it.

;; Don't be confused by the fact that there is also a scheme definition of this function.

;; The compiler will always try to use a compiled definiton before using a scheme 

;; definition if possible.  


;;So let's rewrite and recompile proof using the compiled my-sqr function.

(define proof

   (lambda (x)

      (dotimes (i x)

         (my-sqr i))


;; recompile and redefine my-compiled-proof

(define my-compiled-proof (sys:compile proof))

;; and re-run the performance test

(let ((t (now)))

   (my-compiled-proof 1000000)

   (print 'done-in (rational->real (/ (- (now) t) *samplerate*)) 'seconds))

;; wow! that's quite a difference!

;; So, the moral of the story is try to compile functions without using any scheme

;; interpretation ... and if you must use a scheme call then make sure it's outside

;; of any tight loops etc...


;; You can also tell the compiler to expliclty NOT ALLOW scheme calls by calling

;; (sys:compiler-allow-interpreted-code #f).  This will force a compiler error

;; if you try to use calls not understood by the compiler


;; So the main purpose of including compilation support in impromptu is for fast

;; data processing.  For the impromptu compiler this means working with the calls

;; objc:data:set* objc:data:get* objc:data:make objc:data:subref

;; a simple little array test

(define data-test

   (lambda (x)

      ;; first create an array of 1000 floats

      (let ((a (objc:data:make (* 1000 4))))

         ;; index our float array by writing in i

         (dotimes (i 1000)

            (objc:data:set-double x i i)

            (objc:data:set-float a i i))

         ;; get a subref of 'a' 

         ;; (equivelent to the C code '&a[100]' but increment must be in bytes)

         (define b (objc:data:subref a (* 100 4) (* 900 4)))

         ;; get a subref of 'x' 

         ;; (equivelent to the C code '&x[200]' but increment must be in bytes)

         (define c (objc:data:subref x (* 200 8) (* 800 8)))            

         ;; this should return 20000.0

         ;; (i.e. the 101st float value of 'a' multiplied by the 201st double value of 'x'

         ;; or 100.0 * 200.0)

         (* (objc:data:get-double c 0) (objc:data:get-float b 0)))))

;; first make a data object to pass into data-test

(define my-data (objc:data:make (* 1000 8)))

;; runs fine as a scheme call

(data-test my-data)

;; let's compile it

(define datatest (sys:compile data-test))

;; and runs fine as compiled code

(datatest my-data)


;; We can also do string manipulation

(define string-test

   (lambda (a b)

      (let ((str (string-append a b)))

         (if (string=? str "imprompturocks")

             (substring str 

                        (* (string-length str) 0.25)

                        (* (string-length str) 0.75))

             (begin (string-set! str 0 48)

                    (string-set! str 2 48)

                    (string-set! str 4 48)



(define string-code (sys:compile string-test))

(string-code "impromptu" "rocks")


;; And a small opengl example

(define *gl* (gl:make-opengl))

(gl:open-opengl *gl* '(200 200 640 480))

(define init

   (lambda ()

      (gl:clear-color *gl* 0.0 0.0 0.0 0.0)

      (gl:enable *gl* *gl:depth-test*)))

(define view

   (lambda ()

      (gl:viewport *gl* 0 0 640 480)

      (gl:matrix-mode *gl* *gl:projection*)

      (gl:load-identity *gl*)

      (glu:perspective *gl* 40.0 (/ 640 480) 1.0 10.0)

      (gl:matrix-mode *gl* *gl:modelview*)))

(define draw

   (lambda (angle gl)     

      (gl:clear gl (+ *gl:depth-buffer-bit* *gl:color-buffer-bit*))

      (gl:load-identity gl)

      (glu:look-at gl (* -5 (cos (* .05 angle))) 0 2 0 0 0 0 1 0)

      (dotimes (i 50)     

         (gl:rotate gl angle 1 .1 1)

         (dotimes (k 50)

            (gl:push-matrix gl)

            (gl:color gl .2 (/ k 50) (/ i 30) 1)

            (gl:rotate gl (* .01 angle k) 0 1.0 1.0)

            (gl:translate gl (/ k 50) (/ k 100) (/ i 20))            

            (glut:wire-cube gl 0.1)

            (gl:pop-matrix gl)))))


;; fast as we can

(define draw-loop

   (lambda (angle)

      (gl:lock-context *gl*)

      (draw angle *gl*)

      (gl:unlock-context *gl*)

      (gl:flush *gl*)      

      (callback (now) 'draw-loop (fmod (+ angle .25) 360))))



(draw-loop 0)

;; redefine draw to a compiled version of itself

(define draw (sys:compile draw))

;; try re-evaluating draw back to a scheme function

;; and then recompile it again :)