mirror of
https://github.com/edeproject/ede.git
synced 2023-08-10 21:13:03 +03:00
150 lines
2.7 KiB
Scheme
150 lines
2.7 KiB
Scheme
;;
|
|
;; common functions for capone
|
|
;;
|
|
|
|
(define first car)
|
|
(define rest cdr)
|
|
|
|
;; inc/dec family
|
|
(define (inc n)
|
|
(+ 1 n))
|
|
|
|
(define (dec n)
|
|
(- n 1))
|
|
|
|
(define-macro (inc! n)
|
|
`(set! ,n (+ 1 ,n)))
|
|
|
|
(define-macro (dec! n)
|
|
`(set! ,n (- ,n 1)))
|
|
|
|
(define-macro (if-not . body)
|
|
`(if (not ,(car body))
|
|
,@(cdr body)))
|
|
|
|
;;
|
|
;; Allow defining functions like:
|
|
;; (def name (param1 param2)
|
|
;; ...
|
|
;; )
|
|
(define-macro (def name . rest)
|
|
;; name - function name
|
|
;; (car rest) - function params
|
|
;; (cdr rest)- function body
|
|
`(define ,(cons name (car rest))
|
|
,@(cdr rest)))
|
|
|
|
;;
|
|
;; Flexible printing e.g.:
|
|
;; (define num 3)
|
|
;; (print "This number is: " num "\n")
|
|
;;
|
|
(define (print arg . rest)
|
|
(display arg)
|
|
(let loop ((rest rest))
|
|
(if (not (null? rest))
|
|
(begin
|
|
(display (car rest))
|
|
(loop (cdr rest))))))
|
|
|
|
;;
|
|
;; (print) with newline
|
|
;;
|
|
(define-macro (println . body)
|
|
`(print ,@body "\n"))
|
|
|
|
;;
|
|
;; while loop macro; used like:
|
|
;; (while (> a 2)
|
|
;; ...
|
|
;; )
|
|
;;
|
|
(define-macro (while . body)
|
|
`(let loop ()
|
|
;; fetch condition
|
|
(if ,(car body)
|
|
(begin
|
|
;; evaluate body
|
|
,@(cdr body)
|
|
(loop)))))
|
|
|
|
;;
|
|
;; A python-like 'for' loop, works only on lists, like:
|
|
;; (for i in '(1 2 3 4 5)
|
|
;; (print "Number is " i "\n")
|
|
;; )
|
|
(define-macro (for . expr)
|
|
;; (car expr) is 'i'
|
|
;; (caddr expr) is list
|
|
;; (cdddr expr) is body
|
|
(let* (( lst (gensym) ))
|
|
`(let (( ,lst ,(caddr expr) ))
|
|
(cond
|
|
((list? ,lst)
|
|
(map (lambda (,(car expr))
|
|
,@(cdddr expr))
|
|
,lst))
|
|
(else
|
|
(throw "Unsupported type in 'for' loop"))))))
|
|
|
|
;;
|
|
;; range function; returns a list of numbers in form [start end)
|
|
;;
|
|
;; Althought we could wrote this function cleanly without decrementors
|
|
;; using recursion call after 'cons', we would loose tail call optimization
|
|
;; yielding much slower function.
|
|
;;
|
|
(define (range start end)
|
|
(let loop ((s (- start 1))
|
|
(e (- end 1))
|
|
(lst '()))
|
|
(if (>= s e)
|
|
lst
|
|
(loop s (- e 1) (cons e lst)))))
|
|
|
|
;;
|
|
;; iota function; returns a list of numbers
|
|
;;
|
|
(define (iota n)
|
|
(range 0 n))
|
|
|
|
;;
|
|
;; Inplace vector shuffle via Fisher-Yates algorithm
|
|
;;
|
|
(define (shuffle-vector! v)
|
|
(let ((i (vector-length v))
|
|
(k 0)
|
|
(tmp 0))
|
|
(while (> i 1)
|
|
(set! k (modulo (random-next) i))
|
|
(dec! i)
|
|
(set! tmp (vector-ref v i))
|
|
(vector-set! v i (vector-ref v k))
|
|
(vector-set! v k tmp)
|
|
)))
|
|
|
|
;;
|
|
;; function for easier timing
|
|
;;
|
|
(define (timeit proc)
|
|
(let ((v1 0)
|
|
(v2 0))
|
|
|
|
(set! v1 (clock))
|
|
(proc)
|
|
(set! v2 (clock))
|
|
;; 1000000 is value of CLOCKS_PER_SEC
|
|
(/ (- v2 v1) 1000000)))
|
|
|
|
(define *timeit-start-value* 0)
|
|
(define *timeit-end-value* 0)
|
|
|
|
(define (timeit-start)
|
|
(set! *timeit-start-value* (clock)))
|
|
|
|
(define (timeit-end)
|
|
(set! *timeit-end-value* (clock)))
|
|
|
|
(define (timeit-result)
|
|
(/ (- *timeit-end-value* *timeit-start-value*) 1000000))
|