aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/common-lisp/structure.jvm.lux
blob: fe7009627f5913609cec58ea5e2028a882855372 (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
(.module:
  lux
  (lux (control [monad #+ do])
       (data [text]
             text/format)
       [macro])
  (luxc ["&" lang]
        (lang [synthesis #+ Synthesis]
              (host ["_" common-lisp #+ Expression])))
  [//]
  (// [".T" runtime]))

(def: #export (translate-tuple translate elemsS+)
  (-> (-> Synthesis (Meta Expression)) (List Synthesis) (Meta Expression))
  (case elemsS+
    #.Nil
    (:: macro.Monad<Meta> wrap runtimeT.unit)

    (#.Cons singletonS #.Nil)
    (translate singletonS)

    _
    (do macro.Monad<Meta>
      [elemsT+ (monad.map @ translate elemsS+)]
      (wrap (_.vector elemsT+)))))

(def: #export (translate-variant translate tag tail? valueS)
  (-> (-> Synthesis (Meta Expression)) Nat Bool Synthesis (Meta Expression))
  (do macro.Monad<Meta>
    [valueT (translate valueS)]
    (wrap (runtimeT.variant tag tail? valueT))))