aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/python/function.jvm.lux
blob: d081dd52bafa485117e8b76d785b8ae59d8ce3bb (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
(.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]
              [".L" variable #+ Variable]
              (host [python #+ Expression Statement @@])))
  [//]
  (// [".T" reference]))

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

(def: $curried (python.var "curried"))

(def: (input-declaration register)
  (python.set! (list (referenceT.variable (inc register)))
               (python.nth (|> register .int python.int)
                           (@@ $curried))))

(def: (with-closure function-name inits function-definition)
  (-> Text (List Expression) Statement (Meta Expression))
  (let [$closure (python.var (format function-name "___CLOSURE"))]
    (case inits
      #.Nil
      (do macro.Monad<Meta>
        [_ (//.save function-definition)]
        (wrap (python.global function-name)))

      _
      (do macro.Monad<Meta>
        [_ (//.save (python.def! $closure
                                 (|> (list.enumerate inits)
                                     (list/map (|>> product.left referenceT.closure)))
                                 ($_ python.then!
                                     function-definition
                                     (python.return! (python.global function-name)))))]
        (wrap (python.apply inits (@@ $closure)))))))

(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 bodyO] (//.with-sub-context
                             (do @
                               [function-name //.context]
                               (//.with-anchor [function-name +1]
                                 (translate bodyS))))
     closureO+ (monad.map @ referenceT.translate-variable env)
     #let [args-initsO+ (|> (list.n/range +0 (dec arity))
                            (list/map input-declaration)
                            (case> #.Nil
                                   python.no-op!

                                   (#.Cons head tail)
                                   (list/fold python.then! head tail)))
           arityO (|> arity .int python.int)
           @curried (@@ $curried)
           $num_args (python.var "num_args")
           @num_args (@@ $num_args)
           $function (python.var function-name)
           @function (@@ $function)]]
    (with-closure function-name closureO+
      (python.def! $function (list (python.poly $curried))
                   ($_ python.then!
                       (let [@len (python.global "len")]
                         (python.set! (list $num_args) (python.apply (list @curried) @len)))
                       (python.if! (python.= arityO @num_args)
                                   ($_ python.then!
                                       (python.set! (list (referenceT.variable +0)) @function)
                                       args-initsO+
                                       (python.while! (python.bool #1)
                                                      (python.return! bodyO)))
                                   (python.if! (python.> arityO @num_args)
                                               (let [arity-args (python.slice (python.int 0) arityO @curried)
                                                     output-func-args (python.slice arityO @num_args @curried)]
                                                 (python.return! (|> @function
                                                                     (python.apply-poly (list) arity-args)
                                                                     (python.apply-poly (list) output-func-args))))
                                               (let [$next (python.var "next")
                                                     $missing (python.var "missing")]
                                                 ($_ python.then!
                                                     (python.def! $next (list (python.poly $missing))
                                                                  (python.return! (|> @function
                                                                                      (python.apply-poly (list) (|> @curried
                                                                                                                    (python.+ (@@ $missing)))))))
                                                     (python.return! (@@ $next)))))))))
    ))