aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
blob: a587d2e5b18eb2590e9710e3d3f67c7ccbc8bd44 (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
(.module:
  lux
  (lux (control monad
                ["ex" exception #+ exception:]
                ["p" parser])
       (data ["e" error]
             text/format)
       [macro]
       (macro ["s" syntax])
       ["//" lang]
       (lang ["//." reference #+ Register]
             ["//." synthesis #+ Synthesis]
             ["//." extension]))
  (luxc (lang (host ["$" jvm])))
  (// [".T" common]
      [".T" primitive]
      [".T" structure]
      [".T" eval]
      [".T" function]
      [".T" reference]
      [".T" case]
      [".T" procedure]))

(do-template [<name>]
  [(exception: #export (<name> {message Text})
     message)]

  [Invalid-Function-Syntax]
  [Unrecognized-Synthesis]
  )

(def: #export (translate synthesis)
  (-> Synthesis (Meta $.Inst))
  (case synthesis
    (^ (//synthesis.bool value))
    (primitiveT.translate-bool value)
    
    (^ (//synthesis.i64 value))
    (primitiveT.translate-i64 value)
    
    (^ (//synthesis.f64 value))
    (primitiveT.translate-f64 value)
    
    (^ (//synthesis.text value))
    (primitiveT.translate-text value)

    (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS)))
    (structureT.translate-variant translate tag last? valueS)

    (^code [(~+ members)])
    (structureT.translate-tuple translate members)

    (^ [_ (#.Form (list [_ (#.Int var)]))])
    (if (variableL.captured? var)
      (referenceT.translate-captured var)
      (referenceT.translate-local var))

    [_ (#.Symbol definition)]
    (referenceT.translate-definition definition)

    (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
    (caseT.translate-let translate register inputS exprS)

    (^code ("lux case" (~ inputS) (~ pathPS)))
    (caseT.translate-case translate inputS pathPS)

    (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
    (case (s.run environment (p.some s.int))
      (#e.Success environment)
      (functionT.translate-function translate environment arity bodyS)

      _
      (//.throw Invalid-Function-Syntax (%code synthesis)))

    (^code ("lux call" (~ functionS) (~+ argsS)))
    (functionT.translate-call translate functionS argsS)

    (^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
    (procedureT.translate-procedure translate procedure argsS)
    ## (do macro.Monad<Meta>
    ##   [translation (extensionL.find-translation procedure)]
    ##   (translation argsS))

    _
    (//.throw Unrecognized-Synthesis (%code synthesis))
    ))