blob: 39bdb99c15190fcf0f990674e434df13a6594a5f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
(ns lux.compiler.js.proc.host
(:require (clojure [template :refer [do-template]])
clojure.core.match
clojure.core.match.array
(lux [base :as & :refer [|do return* return |let |case]])))
(defn ^:private compile-js-ref [compile ?values special-args]
(|do [:let [(&/$Cons ?name (&/$Nil)) special-args]]
(return ?name)))
(defn ^:private compile-js-new [compile ?values special-args]
(|do [:let [(&/$Cons ?function ?args) ?values]
=function (compile ?function)
=args (&/map% compile ?args)]
(return (str "new (" =function ")("
(->> =args
(&/|interpose ",")
(&/fold str ""))
")"))))
(defn ^:private compile-js-call [compile ?values special-args]
(|do [:let [(&/$Cons ?function ?args) ?values]
=function (compile ?function)
=args (&/map% compile ?args)]
(return (str "(" =function ")("
(->> =args
(&/|interpose ",")
(&/fold str ""))
")"))))
(defn ^:private compile-js-object-call [compile ?values special-args]
(|do [:let [(&/$Cons ?object (&/$Cons ?field ?args)) ?values]
=object (compile ?object)
=field (compile ?field)
=args (&/map% compile ?args)]
(return (str "LuxRT$" "jsObjectCall"
"(" =object
"," =field
"," (str "[" (->> =args (&/|interpose ",") (&/fold str "")) "]")
")"))))
(defn ^:private compile-js-object [compile ?values special-args]
(|do [:let [(&/$Nil) ?values]]
(return "{}")))
(defn ^:private compile-js-get-field [compile ?values special-args]
(|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Nil))) ?values]
=object (compile ?object)
=field (compile ?field)]
(return (str "(" =object ")" "[" =field "]"))))
(defn ^:private compile-js-set-field [compile ?values special-args]
(|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Cons ?input (&/$Nil)))) ?values]
=object (compile ?object)
=field (compile ?field)
=input (compile ?input)]
(return (str "LuxRT$" "jsSetField" "(" =object "," =field "," =input ")"))))
(defn ^:private compile-js-delete-field [compile ?values special-args]
(|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Nil))) ?values]
=object (compile ?object)
=field (compile ?field)]
(return (str "LuxRT$" "jsDeleteField" "(" =object "," =field ")"))))
(do-template [<name> <value>]
(defn <name> [compile ?values special-args]
(return <value>))
^:private compile-js-null "null"
^:private compile-js-undefined "undefined"
)
(defn compile-proc [compile proc-name ?values special-args]
(case proc-name
"new" (compile-js-new compile ?values special-args)
"call" (compile-js-call compile ?values special-args)
"object-call" (compile-js-object-call compile ?values special-args)
"ref" (compile-js-ref compile ?values special-args)
"object" (compile-js-object compile ?values special-args)
"get-field" (compile-js-get-field compile ?values special-args)
"set-field" (compile-js-set-field compile ?values special-args)
"delete-field" (compile-js-delete-field compile ?values special-args)
"null" (compile-js-null compile ?values special-args)
"undefined" (compile-js-undefined compile ?values special-args)
;; else
(&/fail-with-loc (str "[Compiler Error] Unknown host procedure: " ["js" proc-name]))))
|
