blob: 986720108066eb5b56174253a8c47f9452963734 (
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
87
88
89
90
91
92
93
|
(ns lux.analyser.proc.js
(:require (clojure [template :refer [do-template]]
[string :as string])
clojure.core.match
clojure.core.match.array
(lux [base :as & :refer [|let |do return* return |case assert!]]
[type :as &type])
(lux.analyser [base :as &&])))
(do-template [<name> <proc>]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons ?function ?args) ?values]
=function (&&/analyse-1 analyse (&/$HostT "function" &/$Nil) ?function)
=args (&/map% (partial &&/analyse-1+ analyse) ?args)
_ (&type/check exo-type (&/$HostT "object" &/$Nil))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["js" <proc>]) (&/$Cons =function =args) (&/|list)))))))
^:private analyse-js-new "new"
^:private analyse-js-call "call"
)
(defn ^:private analyse-js-object-call [analyse exo-type ?values]
(|do [:let [(&/$Cons ?object (&/$Cons ?field ?args)) ?values]
=object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object)
=field (&&/analyse-1 analyse &type/Text ?field)
=args (&/map% (partial &&/analyse-1+ analyse) ?args)
_ (&type/check exo-type (&/$HostT "object" &/$Nil))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["js" "object-call"]) (&/$Cons =object (&/$Cons =field =args)) (&/|list)))))))
(defn ^:private analyse-js-ref [analyse exo-type ?values]
(|do [:let [(&/$Cons [_ (&/$Text ?ref-name)] (&/$Nil)) ?values]
_ (&type/check exo-type (&/$HostT "object" &/$Nil))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["js" "ref"]) (&/|list) (&/|list ?ref-name)))))))
(do-template [<name> <proc>]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Nil))) ?values]
=object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object)
=field (&&/analyse-1 analyse &type/Text ?field)
_ (&type/check exo-type (&/$HostT "object" &/$Nil))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["js" <proc>]) (&/|list =object =field) (&/|list)))))))
^:private analyse-js-get-field "get-field"
^:private analyse-js-delete-field "delete-field"
)
(defn ^:private analyse-js-set-field [analyse exo-type ?values]
(|do [:let [(&/$Cons ?object (&/$Cons ?field (&/$Cons ?value (&/$Nil)))) ?values]
=object (&&/analyse-1 analyse (&/$HostT "object" &/$Nil) ?object)
=field (&&/analyse-1 analyse &type/Text ?field)
=value (&&/analyse-1+ analyse ?value)
_ (&type/check exo-type (&/$HostT "object" &/$Nil))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["js" "set-field"]) (&/|list =object =field =value) (&/|list)))))))
(do-template [<name> <proc> <type>]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Nil) ?values]
:let [output-type (&/$HostT <type> &/$Nil)]
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["js" <proc>]) (&/|list) (&/|list)))))))
^:private analyse-js-object "object" "object"
^:private analyse-js-null "null" "object"
^:private analyse-js-undefined "undefined" "undefined"
)
(defn analyse-host [analyse exo-type proc ?values]
(case proc
"new" (analyse-js-new analyse exo-type ?values)
"call" (analyse-js-call analyse exo-type ?values)
"object-call" (analyse-js-object-call analyse exo-type ?values)
"ref" (analyse-js-ref analyse exo-type ?values)
"object" (analyse-js-object analyse exo-type ?values)
"get-field" (analyse-js-get-field analyse exo-type ?values)
"set-field" (analyse-js-set-field analyse exo-type ?values)
"delete-field" (analyse-js-delete-field analyse exo-type ?values)
"null" (analyse-js-null analyse exo-type ?values)
"undefined" (analyse-js-undefined analyse exo-type ?values)
;; else
(&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " ["js" proc])))
)
|
