javascript generator syntax
This commit is contained in:
2
main.rkt
2
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
|
||||
|
||||
@@ -1,69 +1,390 @@
|
||||
#lang racket/base
|
||||
|
||||
(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 ()
|
||||
((_ 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 js-func
|
||||
(syntax-rules ()
|
||||
((_ f)
|
||||
(format "~a()" 'f)
|
||||
)
|
||||
((_ f a ...)
|
||||
(string-append (format "~a(" 'f)
|
||||
(js-infix \, (a ...))
|
||||
")")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(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))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define-syntax js-lambda
|
||||
(syntax-rules ()
|
||||
((_ () a ...)
|
||||
(string-append
|
||||
"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)
|
||||
";"
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(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 " (js1 a) " = " (js1 b) ";\n")
|
||||
(string-append "let " (format "~a" 'a) " = " (js1 b) ";\n")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define-syntax js1
|
||||
(syntax-rules (if let* *)
|
||||
((_ (if cond body1 body2))
|
||||
(string-append "if (" (js1 cond) ") then {\n"
|
||||
(js1 body1) "; }\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 body2)
|
||||
(js1 b2)
|
||||
"; }\n"
|
||||
)
|
||||
)
|
||||
((_ (let (a ...)))
|
||||
(string-append
|
||||
(js-let a)
|
||||
...)
|
||||
)
|
||||
((_ a)
|
||||
(format "~a" 'a))
|
||||
)
|
||||
)
|
||||
|
||||
#|
|
||||
((_ (if cond
|
||||
body1
|
||||
body2))
|
||||
(string-append "if ("
|
||||
(js1 cond) ") then {\n"
|
||||
(js1 body1) " }\n"
|
||||
"else { \n"
|
||||
(js1 body2)
|
||||
|
||||
(define-syntax js-begin
|
||||
(syntax-rules ()
|
||||
((_ a ...)
|
||||
(string-append "{\n"
|
||||
(js a)
|
||||
...
|
||||
" }\n"
|
||||
)
|
||||
)
|
||||
((_ (let ((a b) ...)
|
||||
body))
|
||||
(string-append "let " (js1 a)
|
||||
" = " (js1 b) ";\n")
|
||||
...
|
||||
)
|
||||
((_ (* a b ...))
|
||||
(string-append (js1 a) "*" (js1 b) ...))
|
||||
)
|
||||
|
||||
|
||||
(define-syntax js-return
|
||||
(syntax-rules ()
|
||||
((_ a)
|
||||
(format "~a" '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
|
||||
"{ \n"
|
||||
(js1 js-statement)
|
||||
(js-dotcomma (js1 js-statement))
|
||||
...
|
||||
"}\n"
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|#
|
||||
|
||||
|
||||
|
||||
|
||||
42
private/syntax-helpers.rkt
Normal file
42
private/syntax-helpers.rkt
Normal file
@@ -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))
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user