87 lines
2.8 KiB
Scheme
87 lines
2.8 KiB
Scheme
(use-modules (hoot compile)
|
|
(ice-9 binary-ports)
|
|
(wasm assemble))
|
|
(define src
|
|
'(let ()
|
|
(define (sxml->dom exp)
|
|
(match exp
|
|
;; The simple case: a string representing a text node.
|
|
((? string? str)
|
|
(make-text-node str))
|
|
;; An element tree. The first item is the HTML tag.
|
|
(((? symbol? tag) . body)
|
|
;; Create a new element with the given tag.
|
|
(let ((elem (make-element (symbol->string tag))))
|
|
(define (add-children children)
|
|
;; Recursively call sxml->dom for each child node and
|
|
;; append it to elem.
|
|
(for-each (lambda (child)
|
|
(append-child! elem (sxml->dom child)))
|
|
children))
|
|
(match body
|
|
;; '@' denotes an attribute list. Child nodes follow.
|
|
((('@ . attrs) . children)
|
|
;; Set attributes.
|
|
(for-each (lambda (attr)
|
|
(match attr
|
|
;; Attributes are (symbol string) tuples.
|
|
(((? symbol? name) (? string? val))
|
|
(set-attribute! elem
|
|
(symbol->string name)
|
|
val))))
|
|
attrs)
|
|
(add-children children))
|
|
;; No attributes, just a list of child nodes.
|
|
(children (add-children children)))
|
|
elem))))
|
|
|
|
(define sxml
|
|
'(section
|
|
(h1 "Vivi rocks!")
|
|
(p "Vivi is the "
|
|
(b "best")
|
|
" and "
|
|
(i "rocks")
|
|
" :)")
|
|
(p "Go to " (a (@ (href "https://vvv.gay")) "vvv.gay") " now!")))
|
|
|
|
(define-foreign alert
|
|
"js" "alert"
|
|
(ref string) -> (ref null extern))
|
|
|
|
(define-foreign prompt
|
|
"js" "prompt"
|
|
(ref string) -> (ref string))
|
|
|
|
(define-foreign document-body
|
|
"document" "body"
|
|
-> (ref null extern))
|
|
|
|
(define-foreign make-text-node
|
|
"document" "createTextNode"
|
|
(ref string) -> (ref null extern))
|
|
|
|
(define-foreign append-child!
|
|
"element" "appendChild"
|
|
(ref null extern) (ref null extern) -> (ref null extern))
|
|
|
|
(define-foreign make-element
|
|
"document" "createElement"
|
|
(ref string) -> (ref null extern))
|
|
|
|
(define-foreign set-attribute!
|
|
"element" "setAttribute"
|
|
(ref null extern) (ref string) (ref string) -> none)
|
|
|
|
(append-child!
|
|
(document-body)
|
|
(if (> (string->number (prompt "What's your age?")) 2)
|
|
(sxml->dom sxml)
|
|
(make-text-node "You probably can't read! What are you doing here??")))
|
|
|
|
"hey :)"))
|
|
|
|
(call-with-output-file "hello.wasm"
|
|
(lambda (port)
|
|
(put-bytevector port (assemble-wasm (compile src)))))
|