;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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))
"done"))
(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))
"done"))
;; 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)
str)))))
(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))))
(init)
(view)
(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 :)