Skip to content

Instantly share code, notes, and snippets.

@samth
Created June 5, 2019 15:21
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save samth/683042c4754c1c5ce284794b19dd37e3 to your computer and use it in GitHub Desktop.
Save samth/683042c4754c1c5ce284794b19dd37e3 to your computer and use it in GitHub Desktop.
#lang racket/base
(#%module-begin
(#%require racket/math)
(#%require racket/list racket/flonum racket/unsafe/ops)
(define (check-list v) (unless (list? v) (error 'check-list)))
(define-values (*iteration-limit*) '50)
(define-values
(mandel)
(lambda (c)
(let-values (((op)
(letrec-values (((mandel-iter)
(#%plain-lambda
(unboxed-real-6 unboxed-imag-7 i)
(let-values (((z) 'check-syntax-binding))
(if (let-values (((or-part)
(#%app
>=
i
*iteration-limit*)))
(if or-part
or-part
(#%app
fl>
(let-values ()
(let-values (((r)
(#%app
flabs
unboxed-real-6)))
(let-values (((i)
(#%app
flabs
unboxed-imag-7)))
(if (#%app zero? i)
r
(if (#%app
fl<
i
r)
(let-values (((q)
(#%app
fl/
i
r)))
(#%app
fl*
r
(#%app
flsqrt
(#%app
fl+
'1.0
(#%app
fl*
q
q)))))
(let-values (((q)
(#%app
fl/
r
i)))
(#%app
fl*
i
(#%app
flsqrt
(#%app
fl+
'1.0
(#%app
fl*
q
q))))))))))
'2.0)))
i
(let-values (((g8) c))
(let-values (((unboxed-real-9)
(#%app
flreal-part
g8)))
(let-values (((unboxed-imag-10)
(#%app
flimag-part
g8)))
(let-values (((g11)
(#%app
sqr
(#%app
unsafe-make-flrectangular
unboxed-real-6
unboxed-imag-7))))
(let-values (((unboxed-real-12)
(#%app
flreal-part
g11)))
(let-values (((unboxed-imag-13)
(#%app
flimag-part
g11)))
(let-values (((unboxed-real-14)
(#%app
fl+
(#%app
real->double-flonum
unboxed-real-9)
unboxed-real-12)))
(let-values (((unboxed-imag-15)
(#%app
fl+
(#%app
real->double-flonum
unboxed-imag-10)
unboxed-imag-13)))
(let-values (((boxed-binding16)
(#%app
+
i
'1)))
(#%app
mandel-iter
unboxed-real-14
unboxed-imag-15
boxed-binding16)))))))))))))))
mandel-iter)))
(let-values (((unboxed-real-3) '0.0))
(let-values (((unboxed-imag-4) '0.0))
(let-values (((boxed-binding5) '0))
(#%app op unboxed-real-3 unboxed-imag-4 boxed-binding5)))))))
(define-values
(brot)
(lambda (xs ys)
(#%app
reverse
(let-values (((lst) ys))
(if (#%app variable-reference-from-unsafe? (#%variable-reference))
(#%app void)
(let-values () (#%app check-list lst)))
(#%app
(letrec-values (((for-loop)
(lambda (acc lst)
(if (#%app pair? lst)
(let-values (((y) (#%app car lst)))
(let-values (((rest) (#%app cdr lst)))
(if (begin '#t '#t)
(let-values (((acc)
(let-values (((acc) acc))
(if (begin '#t '#t)
(let-values (((lst) xs))
(if (#%app
variable-reference-from-unsafe?
(#%variable-reference))
(#%app void)
(let-values ()
(#%app
check-list
lst)))
(#%app
(letrec-values (((for-loop)
(lambda (acc
lst)
(if (#%app
pair?
lst)
(let-values (((x)
(#%app
car
lst)))
(let-values (((rest)
(#%app
cdr
lst)))
(if (begin
'#t
'#t)
(let-values (((acc)
(let-values (((acc)
acc))
(if (begin
'#t
'#t)
(let-values (((acc)
acc))
(let-values (((acc)
(let-values ()
(let-values (((new)
(let-values ()
(#%app
mandel
(#%app
make-flrectangular
x
y)))))
(#%app
(lambda (x
y)
(#%app
cons
y
x))
acc
new)))))
(#%app
values
acc)))
acc))))
(if (begin
(if (begin
'#t
'#t)
(#%app
not
'#f)
'#f)
'#t)
(#%app
for-loop
acc
rest)
acc))
acc)))
acc))))
for-loop)
acc
lst))
acc))))
(if (begin
(if (begin '#t '#t)
(#%app not '#f)
'#f)
'#t)
(#%app for-loop acc rest)
acc))
acc)))
acc))))
for-loop)
null
lst)))))
(define-values
(make-ticks)
(lambda (min max resolution)
(#%app
range
min
max
(#%app / (#%app fl- max min) resolution))))
(define-values (*xs*) (#%app make-ticks '-1.5 '0.5 '300))
(define-values (*ys*) (#%app make-ticks '-1.0 '1.0 '300))
(#%app void (#%app brot *xs* *ys*))
(#%provide)
(#%app void))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment