aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux
blob: bb3d6138d510f8871d04057a9f456890ea5b9771 (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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
(.module:
  [lux #*
   [abstract
    ["." monad (#+ do)]]
   [control
    ["." function]
    ["<>" parser
     ["<s>" synthesis (#+ Parser)]]]
   [data
    ["." error]
    [collection
     ["." dictionary]]]
   [target
    ["_" js (#+ Expression)]]]
  ["." // #_
   ["#." common]
   ["/#" // #_
    ["#." runtime (#+ Operation Phase Handler Bundle
                      with-vars)]
    ["#." primitive]
    ["/#" // #_
     [extension (#+ Nullary Unary Binary Trinary
                    nullary unary binary trinary)]
     ["/#" //
      ["." extension
       ["." bundle]]
      [//
       [synthesis (#+ %synthesis)]]]]]])

(def: #export (custom [parser handler])
  (All [s]
    (-> [(Parser s)
         (-> Text Phase s (Operation Expression))]
        Handler))
  (function (_ extension-name phase input)
    (case (<s>.run input parser)
      (#error.Success input')
      (handler extension-name phase input')

      (#error.Failure error)
      (/////.throw extension.invalid-syntax [extension-name %synthesis input]))))

(def: array::new
  (Unary Expression)
  (|>> ///runtime.i64//to-number list (_.new (_.var "Array"))))

(def: array::length
  (Unary Expression)
  (|>> (_.the "length") ///runtime.i64//from-number))

(def: (array::read [indexG arrayG])
  (Binary Expression)
  (_.at indexG arrayG))

(def: (array::write [indexG valueG arrayG])
  (Trinary Expression)
  (///runtime.array//write indexG valueG arrayG))

(def: (array::delete [indexG arrayG])
  (Binary Expression)
  (///runtime.array//delete indexG arrayG))

(def: array
  Bundle
  (<| (bundle.prefix "array")
      (|> bundle.empty
          (bundle.install "new" (unary array::new))
          (bundle.install "length" (unary array::length))
          (bundle.install "read" (binary array::read))
          (bundle.install "write" (trinary array::write))
          (bundle.install "delete" (binary array::delete))
          )))

(def: object::new
  (..custom
   [($_ <>.and <s>.any (<>.some <s>.any))
    (function (_ extension phase [constructorS inputsS])
      (do /////.monad
        [constructorG (phase constructorS)
         inputsG (monad.map @ phase inputsS)]
        (wrap (_.new constructorG inputsG))))]))

(def: object::get
  Handler
  (custom
   [($_ <>.and <s>.text <s>.any)
    (function (_ extension phase [fieldS objectS])
      (do /////.monad
        [objectG (phase objectS)]
        (wrap (_.the fieldS objectG))))]))

(def: object::do
  Handler
  (custom
   [($_ <>.and <s>.text <s>.any (<>.some <s>.any))
    (function (_ extension phase [methodS objectS inputsS])
      (do /////.monad
        [objectG (phase objectS)
         inputsG (monad.map @ phase inputsS)]
        (wrap (_.do methodS inputsG objectG))))]))

(template [<!> <?> <unit>]
  [(def: <!> (Nullary Expression) (function.constant <unit>))
   (def: <?> (Unary Expression) (_.= <unit>))]

  [object::null object::null? _.null]
  [object::undefined object::undefined? _.undefined]
  )

(def: object
  Bundle
  (<| (bundle.prefix "object")
      (|> bundle.empty
          (bundle.install "new" object::new)
          (bundle.install "get" object::get)
          (bundle.install "do" object::do)
          (bundle.install "null" (nullary object::null))
          (bundle.install "null?" (unary object::null?))
          (bundle.install "undefined" (nullary object::undefined))
          (bundle.install "undefined?" (unary object::undefined?))
          )))

(def: js::constant
  (..custom
   [<s>.text
    (function (_ extension phase name)
      (do /////.monad
        []
        (wrap (_.var name))))]))

(def: js::apply
  (..custom
   [($_ <>.and <s>.any (<>.some <s>.any))
    (function (_ extension phase [abstractionS inputsS])
      (do /////.monad
        [abstractionG (phase abstractionS)
         inputsG (monad.map @ phase inputsS)]
        (wrap (_.apply/* abstractionG inputsG))))]))

(def: #export bundle
  Bundle
  (<| (bundle.prefix "js")
      (|> bundle.empty
          (bundle.install "constant" js::constant)
          (bundle.install "apply" js::apply)
          (dictionary.merge ..array)
          (dictionary.merge ..object)
          )))