aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/php/function.jvm.lux
blob: 9a283439ffd9cf1164eb7e245bc9718c2246c87d (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
(.module:
  lux
  (lux (control [monad #+ do]
                pipe)
       (data [product]
             [text]
             text/format
             (coll [list "list/" Functor<List> Fold<List>]))
       [macro])
  (luxc ["&" lang]
        (lang ["ls" synthesis #+ Synthesis Arity]
              [".L" variable #+ Register Variable]
              (host ["_" php #+ Expression Var Computation Statement])))
  [//]
  (// [".T" reference]))

(def: #export (translate-apply translate functionS argsS+)
  (-> //.Translator Synthesis (List Synthesis) (Meta Computation))
  (do macro.Monad<Meta>
    [functionO (translate functionS)
     argsO+ (monad.map @ translate argsS+)]
    (wrap (_.apply argsO+ functionO))))

(def: @curried (_.var "curried"))

(def: (input-declaration! register)
  (-> Register Statement)
  (_.set! (referenceT.variable (n/inc register))
          (_.nth (|> register nat-to-int _.int)
                 @curried)))

(def: (with-closure function-name inits function-definition!)
  (-> Text (List Expression) (-> (List Var) Statement) (Meta Expression))
  (let [@function (_.var function-name)]
    (case inits
      #.Nil
      (do macro.Monad<Meta>
        [_ (//.save (function-definition! (list)))]
        (wrap @function))

      _
      (do macro.Monad<Meta>
        [#let [closure-name (format function-name "___CLOSURE")
               @closure (_.global (format function-name "___CLOSURE"))
               captured (|> (list.enumerate inits) (list/map (|>> product.left referenceT.closure)))]
         _ (//.save (_.function! @closure (list/map _.parameter captured)
                                 (|> (function-definition! captured)
                                     (_.then! (_.return! @function)))))]
        (wrap (_.apply inits @closure))))))

(def: #export (translate-function translate env arity bodyS)
  (-> //.Translator (List Variable) Arity Synthesis (Meta Expression))
  (do macro.Monad<Meta>
    [[base-function-name bodyO] (//.with-sub-context
                                  (do @
                                    [function-name //.context]
                                    (//.with-anchor [function-name +1]
                                      (translate bodyS))))
     current-module-name macro.current-module-name
     #let [function-name (format current-module-name "___" base-function-name)]
     closureO+ (monad.map @ referenceT.translate-variable env)
     #let [@function (_.var function-name)
           self-init! (_.set! (referenceT.variable +0) @function)
           args-inits! (|> (list.n/range +0 (n/dec arity))
                           (list/map input-declaration!)
                           (list/fold _.then! self-init!))
           arityO (|> arity nat-to-int _.int)
           @num_args (_.var "num_args")]]
    (with-closure function-name closureO+
      (function (_ captured)
        (_.set! @function
                (_.function (list) (|> captured
                                       (list/map _.reference)
                                       (list& (_.reference @function)))
                  (|> (_.set! @num_args _.func-num-args/0)
                      (_.then! (_.set! @curried _.func-get-args/0))
                      (_.then! (_.if! (|> @num_args (_.= arityO))
                                      (|> args-inits!
                                          (_.then! (_.return! bodyO)))
                                      (_.if! (|> @num_args (_.> arityO))
                                             (let [arity-args (_.array-slice/3 @curried (_.int 0) arityO)
                                                   output-func-args (_.array-slice/2 @curried arityO)]
                                               (_.return! (_.call-user-func-array/2 (_.call-user-func-array/2 @function arity-args)
                                                                                    output-func-args)))
                                             (let [@missing (_.var "missing")]
                                               (_.return! (_.function (list) (list (_.reference @function) (_.reference @curried))
                                                            (|> (_.set! @missing _.func-get-args/0)
                                                                (_.then! (_.return! (_.call-user-func-array/2 @function
                                                                                                              (_.array-merge/+ @curried (list @missing)))))))))))))))))))