diff --git a/main.rkt b/main.rkt index 0336203..121ed09 100644 --- a/main.rkt +++ b/main.rkt @@ -10,6 +10,7 @@ (require "rgba.rkt") (require "mimetypes.rkt") (require "menu.rkt") +(require "private/js-transform.rkt") (provide (all-from-out "wv-context.rkt" "wv-window.rkt" @@ -21,6 +22,7 @@ "menu.rkt" "racket-webview-downloader.rkt" "racket-webview.rkt" + "private/js-transform.rkt" ) webview-set-loglevel webview-version diff --git a/private/js-transform.rkt b/private/js-transform.rkt index dd8fa6b..36857bb 100644 --- a/private/js-transform.rkt +++ b/private/js-transform.rkt @@ -1,69 +1,390 @@ #lang racket/base -(define-syntax js-let +(require "utils.rkt" + (for-syntax racket/base) + (for-syntax racket/string) + (for-syntax "syntax-helpers.rkt") + (for-syntax "utils.rkt") + "syntax-helpers.rkt" + racket/string + ) + +(provide js) + +(define-syntax js-infix (syntax-rules () - ((_ (a b)) - (string-append "let " (js1 a) " = " (js1 b) ";\n") + ((_ op (a ...)) + (string-join (list (js1 a) ...) (format "~a~a " (if (eq? 'op '\,) "" " ") 'op))) + ) + ) + + +(define-syntax (if-defined stx) + (syntax-case stx () + [(_ id iftrue iffalse) + (let ([where (identifier-binding #'id)]) + (if where #'iftrue #'iffalse))])) + + +(define-syntax js-prim-1 + (syntax-rules () + ((_ a) + (symstr 'a)))) + +(define-syntax (js-primitive stx) + (syntax-case stx () + ((js-primitive a) + (cond + ((number? (syntax->datum #'a)) #'(format "~a" a)) + ((string? (syntax->datum #'a)) #'(format "\"~a\"" (esc-double-quote (format "~a" a)))) + ((identifier? #'a) #'(js-prim-1 a)) + (else #'(js-prim-1 a))) ) ) ) -(define-syntax js1 - (syntax-rules (if let* *) - ((_ (if cond body1 body2)) - (string-append "if (" (js1 cond) ") then {\n" - (js1 body1) "; }\n" - "else {\n" - (js1 body2) - "; }\n" - ) + +(define-syntax js-func + (syntax-rules () + ((_ f) + (format "~a()" 'f) ) - ((_ (let (a ...))) - (string-append - (js-let a) - ...) + ((_ f a ...) + (string-append (format "~a(" 'f) + (js-infix \, (a ...)) + ")") ) - ((_ a) - (format "~a" 'a)) ) ) -#| - ((_ (if cond - body1 - body2)) - (string-append "if (" - (js1 cond) ") then {\n" - (js1 body1) " }\n" - "else { \n" - (js1 body2) - " }\n" - ) + +(define-syntax js-def + (syntax-rules () + ((_ (f) (b ...)) + (string-append + (format "function ~a()" 'f) + " {\n" + (js b ...) + "\n}\n" + )) + ((_ (f a1) (b ...)) + (string-append + (format "function ~a(~a)" 'f 'a1) + " {\n" + (js b ...) + "\n}\n")) + ((_ (f a1 ...) (b ...)) + (string-append + (string-append (format "function ~a(" 'f) + (js-infix \, (a1 ...)) + ")") + " {\n" + (js b ...) + "\n}\n")) + ((_ a (b)) + (format "~a = ~a;" 'a (js1 b)) ) - ((_ (let ((a b) ...) - body)) - (string-append "let " (js1 a) - " = " (js1 b) ";\n") - ... - ) - ((_ (* a b ...)) - (string-append (js1 a) "*" (js1 b) ...)) - ((_ a) - (format "~a" 'a)) ) ) -|# - -(define-syntax js + +(define-syntax js-lambda (syntax-rules () - ((_ js-statement ...) + ((_ () a ...) (string-append - "{ \n" - (js1 js-statement) - ... - "}\n" + "function () { " + (js a ...) + " }\n" + ) + ) + ((_ (a ...) b1 ...) + (string-append + (string-append + "function (" + (js-infix \, (a ...)) + ")" + ) + " { " + (js b1 ...) + " }\n") + ) + ) + ) + +(define-syntax js-set + (syntax-rules () + ((_ a b) + (string-append + (format "~a = " 'a) + (js1 b) + ";" ) ) ) ) - \ No newline at end of file + +(define-syntax js-send* + (syntax-rules () + ((_ a b) + (format "~a.~a()" (js1 a) (js1 b))) + ((_ a b (a1)) + (format "~a.~a(~a)" (js1 a) (js1 b) (js1 a1))) + ((_ a b (a1 a2 ...)) + (format "~a.~a(~a)" (js1 a) (js1 b) + (js-infix \, (a1 a2 ...)))) + ) + ) + +(define-syntax js-send + (syntax-rules () + ((_ (a b)) + (js-send* a b)) + ((_ (a b c ...)) + (js-send* a b (c ...)) + ) + ) + ) + +(define (make-cons a b) + (format "(~a.unshift(~a),~a)" b a b)) + + + +(define-syntax js-let + (syntax-rules () + ((_ (a b)) + (string-append "let " (format "~a" 'a) " = " (js1 b) ";\n") + ) + ) + ) + +(define-syntax js2-let* + (syntax-rules () + ((_ (a ...) b1 ...) + (string-append "{\n" + (string-append (js-let a) ...) + (js b1) + ... + "\n}\n") + ) + ) + ) + +(define-syntax js2-if + (syntax-rules () + ((_ c b1 b2) + (string-append "if (" (js1 c) ") {\n" + (js1 b1) "; }\n" + "else {\n" + (js1 b2) + "; }\n" + ) + ) + ) + ) + + +(define-syntax js-begin + (syntax-rules () + ((_ a ...) + (string-append "{\n" + (js a) + ... + " }\n" + ) + ) + ) + ) + + +(define-syntax js-return + (syntax-rules () + ((_ a) + (string-append "return (" (js1 a) ");\n")) + ) + ) + +(define-syntax js-list + (syntax-rules () + ((_ ()) + (format "[ ]")) + ((_ (a ...)) + (string-append "[ " + (js-infix \, (a ...)) + "]") + ) + ) + ) + +(define-syntax js-cons + (syntax-rules () + ((_ (a b)) + (format "~a.concat(~a)" (js-list (a)) (js1 b))) + ) + ) + +(define-syntax js-quote + (syntax-rules () + ((_ (a ...)) + (js-primitive (a ...))) + ((_ a) + (string-append "\"" (js-primitive a) "\"") + ) + ) + ) + + +(define-syntax (js-op stx) + (syntax-case stx () + ((_ a . args) + (cond + ((eq? (syntax->datum #'a) '+) #'(js-infix + args)) + ((eq? (syntax->datum #'a) '*) #'(js-infix * args)) + ((eq? (syntax->datum #'a) '/) #'(js-infix / args)) + ((eq? (syntax->datum #'a) '-) #'(js-infix - args)) + ((eq? (syntax->datum #'a) 'and) #'(js-infix && args)) + ((eq? (syntax->datum #'a) 'or) #'(js-infix || args)) + ((eq? (syntax->datum #'a) 'send) #'(js-send args)) + ((eq? (syntax->datum #'a) 'list) #'(js-list args)) + ((eq? (syntax->datum #'a) 'cons) #'(js-cons args)) + (else + #'(error (format "Not support by js-op: a = ~a" (syntax->datum #'a))) + ) + ) + ) + ) + ) + +(define-for-syntax js-ops '(+ * / - and or send list cons)) + +(define-syntax (js1 stx) + (syntax-case stx () + ((_ (a c b1 b2)) + (cond + ((eq? (syntax->datum #'a) 'if) #'(js2-if c b1 b2)) + ((memq (syntax->datum #'a) js-ops) #'(js-op a c b1 b2)) + ((eq? (syntax->datum #'a) 'let*) #'(js2-let* c b1 b2)) + ((eq? (syntax->datum #'a) 'begin) #'(js-begin c b1 b2)) + (else + ; could be a function call + #'(js-func a c b1 b2) + ;#'(error (format "Not supported by js macro (a c b1 b2), a = ~a" (syntax->datum #'a))) + ) + ) + ) + ((_ (a b c)) + (cond + ((eq? (syntax->datum #'a) '>) #'(js-infix > (b c))) + ((eq? (syntax->datum #'a) '<) #'(js-infix < (b c))) + ((eq? (syntax->datum #'a) '>=) #'(js-infix >= (b c))) + ((eq? (syntax->datum #'a) '<=) #'(js-infix <= (b c))) + ((eq? (syntax->datum #'a) '=) #'(js-infix = (b c))) + ((memq (syntax->datum #'a) js-ops) #'(js-op a b c)) + ((eq? (syntax->datum #'a) 'define) #'(js-def b (c))) + ((eq? (syntax->datum #'a) 'lambda) #'(js-lambda b c)) + ((eq? (syntax->datum #'a) 'λ) #'(js-lambda b c)) + ((eq? (syntax->datum #'a) 'set!) #'(js-set b c)) + ((eq? (syntax->datum #'a) 'let*) #'(js2-let* b c)) + ((eq? (syntax->datum #'a) 'begin) #'(js-begin b c)) + ((eq? (syntax->datum #'a) 'let) #'(error "let is not supported in js context, use let*")) + (else + ; could be a function call + #'(js-func a b c) + ;#'(error (format "Not supported by js macro (a b c), a = ~a" (syntax->datum #'a))) + ) + ) + ) + ((_ (a b)) + (cond + ((eq? (syntax->datum #'a) 'return) #'(js-return b)) + ((eq? (syntax->datum #'a) 'quote) #'(js-quote b)) + ;string-append + ; "\"" (esc-double-quote (format "~a" 'b)) "\"")) + (else + ; could be a function call + #'(js-func a b) + ;#'(error (format "Not supported by js macro (a b c), a = ~a" (syntax->datum #'a))) + ) + ) + ) + ((_ (a c b1 ...)) + (cond + ((eq? (syntax->datum #'a) 'let*) #'(js2-let* c b1 ...)) + ((eq? (syntax->datum #'a) 'define) #'(js-def c (b1 ...))) + ((memq (syntax->datum #'a) js-ops) #'(js-op a c b1 ...)) + ((eq? (syntax->datum #'a) 'begin) #'(js-begin c b1 ...)) + ((eq? (syntax->datum #'a) 'let) #'(error "let is not supported in js context, use let*")) + ((eq? (syntax->datum #'a) 'js2-if) #'(error "Unexpected")) + (else + ; could be a function call + #'(js-func a c b1 ...) + ;#'(error (format "Not supported by js macro (a c b1 ...) a = ~a" (syntax->datum #'a))) + ) + ) + ) + ((_ (a b ...)) + (cond + ((memq (syntax->datum #'a) js-ops) #'(js-op a b ...)) + (else + ; could be a function call + #'(js-func a b ...) + ;#'(error "Not supported by js macro (a b ...)")) + ) + ) + ) + ((_ (a)) + #'(js-func a) + ) + ((_ a) + #'(js-primitive a) + ) + ) + ) + +(define-syntax js-dotcomma + (syntax-rules () + ((_ s) + (string-append s ";\n")) + ) + ) + + +(define-syntax js + (syntax-rules () + ((_ js-statement ...) + (string-append + (js-dotcomma (js1 js-statement)) + ... + ) + ) + ) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +#| +(define t1 + (js (set! window.myfunc (λ (x) + (let* ((el (document.getElementById 'hi)) + (y (* x x))) + (el.setAttribute "x" (+ y "")) + ) + ) + ))) + +(define t2 (js (define (f x) + (if (and (> x 10) (< x 15)) + (begin (console.log x) + (return x)) + (return (* x x)) + ) + ) + ) + ) +|# + + + diff --git a/private/syntax-helpers.rkt b/private/syntax-helpers.rkt new file mode 100644 index 0000000..5ff7537 --- /dev/null +++ b/private/syntax-helpers.rkt @@ -0,0 +1,42 @@ +#lang racket/base + +(require racket/string + "utils.rkt" + ) +(provide symbol?? + symstr + symstr-eval + is-if?) + + +(define (symbol?? a) + (let ((r (symbol? a))) + r)) + +(define (symstr x) + (cond + ((list? x) + (string-append "[ " + (string-join (map symstr-eval x) ", ") + " ]")) + ((vector? x) + (symstr (vector->list x))) + (else + (let ((r (format "~a" x))) + (let ((r* (if (string-prefix? r "(quote") + (let ((s (substring r 7))) + (substring s 0 (- (string-length s) 1))) + r))) + r*))) + ) + ) + + +(define (symstr-eval x) + (cond + ((string? x) (format "\"~a\"" (esc-double-quote x))) + (else (symstr x)))) + +(define (is-if? x) + (displayln x) + (eq? x 'if)) \ No newline at end of file diff --git a/racket-webview.rkt b/racket-webview.rkt index 1fddb04..5ae53f8 100644 --- a/racket-webview.rkt +++ b/racket-webview.rkt @@ -720,8 +720,9 @@ (define/contract (webview-call-js wv js) - (-> wv-win? string? (or/c string? list? boolean? hash? symbol?)) + (-> wv-win? string? (or/c string? list? boolean? hash? symbol? number?)) (let ((result (rkt-webview-call-js (wv-win-handle wv) js))) + ;(displayln result) (if (webview-call-js-result? result) (if (eq? (car result) 'oke) (hash-ref (fromJson (cadr result)) 'result #f)