128 lines
3.2 KiB
Racket
128 lines
3.2 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/string
|
|
racket/port
|
|
json
|
|
)
|
|
|
|
(provide while
|
|
until
|
|
get-lib-path
|
|
do-for
|
|
esc-quote
|
|
esc-double-quote
|
|
fromJson
|
|
mk-js-array
|
|
js-code
|
|
kv?
|
|
list-of-kv?
|
|
list-of-symbol?
|
|
list-of?
|
|
)
|
|
|
|
(define-syntax while
|
|
(syntax-rules ()
|
|
((_ cond body ...)
|
|
(letrec ((while-f (lambda (last-result)
|
|
(if cond
|
|
(let ((last-result (begin
|
|
body
|
|
...)))
|
|
(while-f last-result))
|
|
last-result))))
|
|
(while-f #f))
|
|
)
|
|
))
|
|
|
|
(define-syntax until
|
|
(syntax-rules ()
|
|
((_ cond body ...)
|
|
(letrec ((until-f (lambda (last-result)
|
|
(if cond
|
|
last-result
|
|
(let ((last-reult (begin
|
|
body
|
|
...)))
|
|
(until-f last-result))))))
|
|
(until-f #f)))))
|
|
|
|
(define-syntax do-for
|
|
(syntax-rules ()
|
|
((_ (init cond next) body ...)
|
|
(begin
|
|
init
|
|
(letrec ((do-for-f (lamba ()
|
|
(if cond
|
|
(begin
|
|
(begin
|
|
body
|
|
...)
|
|
next
|
|
(do-for-f))))))
|
|
(do-for-f))))))
|
|
|
|
(define (get-lib-path lib)
|
|
(let ((platform (system-type)))
|
|
(cond
|
|
[(eq? platform 'windows)
|
|
(let ((try1 (build-path (current-directory) ".." "lib" "dll" lib))
|
|
(try2 (build-path (current-directory) "lib" "dll" lib)))
|
|
(if (file-exists? try1)
|
|
try1
|
|
try2)
|
|
)]
|
|
[else
|
|
(error (format "Install the shared library: ~a" lib))]
|
|
)))
|
|
|
|
(define (esc-quote str)
|
|
(string-replace str "'" "\\'"))
|
|
|
|
(define (esc-double-quote str)
|
|
(string-replace str "\"" "\\\""))
|
|
|
|
(define (fromJson str)
|
|
(with-input-from-string str read-json))
|
|
|
|
(define (mk-js-array l)
|
|
(if (list-of-kv? l)
|
|
(string-append "[ " (string-join (map (λ (e) (mk-js-array e)) l) ", ") " ]")
|
|
(if (list? l)
|
|
(string-append "[ " (string-join (map (λ (e) (format "'~a'"
|
|
(esc-quote (format "~a" e)))) l) ", ") " ]")
|
|
(if (pair? l)
|
|
(format "[ '~a', '~a' ]" (car l) (cdr l))
|
|
(format "[ '~a' ]" (esc-quote (format "~a" l)))))))
|
|
|
|
(define (js-code . a)
|
|
(define (code* l)
|
|
(if (null? l)
|
|
""
|
|
(string-append (car l) "\n" (code* (cdr l)))
|
|
)
|
|
)
|
|
(code* a))
|
|
|
|
(define (kv? e)
|
|
(or
|
|
(and (list? e) (= (length e) 2) (symbol? (car e)))
|
|
(and (pair? e) (symbol? (car e)))))
|
|
|
|
(define (list-of? pred? l)
|
|
(define (all-pred? l)
|
|
(if (null? l)
|
|
#t
|
|
(if (pred? (car l))
|
|
(all-pred? (cdr l))
|
|
#f)))
|
|
(if (list? l)
|
|
(all-pred? l)
|
|
#f))
|
|
|
|
(define (list-of-kv? l)
|
|
(list-of? kv? l))
|
|
|
|
(define (list-of-symbol? l)
|
|
(list-of? symbol? l))
|
|
|