aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/js/function.jvm.lux
blob: b3c6761cd2f6aba773625f83de97cdac14fec13e (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
(.module:
  lux
  (lux (control [monad #+ do])
       (data [text]
             text/format
             (coll [list "list/" Functor<List>]))
       [macro])
  (luxc ["&" lang]
        (lang ["ls" synthesis]
              [".L" variable #+ Variable]
              (host [js #+ JS Expression Statement])))
  [//]
  (// [".T" reference]
      [".T" loop]))

(def: #export (translate-apply translate functionS argsS+)
  (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression))
  (do macro.Monad<Meta>
    [functionJS (translate functionS)
     argsJS+ (monad.map @ translate argsS+)]
    (wrap (format functionJS "(" (text.join-with "," argsJS+) ")"))))

(def: (input-declaration register)
  (format "var " (referenceT.variable (n/inc register)) " = arguments[" (|> register nat-to-int %i) "];"))

(def: (with-closure inits function)
  (-> (List Expression) Expression Expression)
  (let [closure (case inits
                  #.Nil
                  (list)

                  _
                  (|> (list.n/range +0 (n/dec (list.size inits)))
                      (list/map referenceT.closure)))]
    (format "(function(" (text.join-with "," closure) ") {"
            "return " function
            ";})(" (text.join-with "," inits) ")")))

(def: #export (translate-function translate env arity bodyS)
  (-> (-> ls.Synthesis (Meta Expression))
      (List Variable) ls.Arity ls.Synthesis
      (Meta Expression))
  (do macro.Monad<Meta>
    [[function-name bodyJS] (//.with-sub-context
                              (do @
                                [function-name //.context]
                                (//.with-anchor [function-name +1]
                                  (translate bodyS))))
     closureJS+ (monad.map @ referenceT.translate-variable env)
     #let [args-initsJS+ (|> (list.n/range +0 (n/dec arity))
                             (list/map input-declaration)
                             (text.join-with ""))
           selfJS (format "var " (referenceT.variable +0) " = " function-name ";")
           arityJS (|> arity nat-to-int %i)]]
    (wrap (<| (with-closure closureJS+)
              (format "(function " function-name "() {"
                      "\"use strict\";"
                      "var num_args = arguments.length;"
                      "if(num_args == " arityJS ") {"
                      selfJS
                      args-initsJS+
                      (format "while(true) {"
                              "return " bodyJS ";"
                              "}")
                      "}"
                      "else if(num_args > " arityJS ") {"
                      "return " function-name ".apply(null, [].slice.call(arguments,0," arityJS "))"
                      ".apply(null, [].slice.call(arguments," arityJS "));"
                      "}"
                      ## Less than arity
                      "else {"
                      "var curried = [].slice.call(arguments);"
                      "return function() { "
                      "return " function-name ".apply(null, curried.concat([].slice.call(arguments)));"
                      " };"
                      "}"
                      "})")))))