aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux
blob: 65ab9d147409c156124ece9be905384f0dec898f (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
100
101
102
103
104
105
106
107
108
109
110
(.module:
  lux
  (lux (control monad
                ["ex" exception #+ exception:])
       (data ["e" error]
             [maybe]
             [text "text/" Monoid<Text> Hash<Text>]
             text/format
             (coll [list "list/" Functor<List> Fold<List>]))
       [macro])
  (luxc ["&" lang]
        ["&." io]
        (lang (host ["$" jvm]
                    (jvm ["$t" type]
                         ["$d" def]
                         ["$i" inst]))
              ["&." scope]
              ["&." module]
              [".L" host]))
  (// [".T" common]
      [".T" runtime]))

## (def: (lux//program procedure)
##   (-> Text //.Statement)
##   (function (_ inputsC+)
##     (case inputsC+
##       (^ (list [_ (#.Identifier ["" args])] programC))
##       (do macro.Monad<Meta>
##         [[_ programA] (<| lang.with-scope
##                           (scopeL.with-local [args (type (List Text))])
##                           (lang.with-type (type (IO Any)))
##                           (expressionA.analyser evalL.eval programC))
##          syntheses //.all-syntheses
##          programI (expressionT.translate (expressionS.synthesize syntheses programA))
##          _ (statementT.translate-program programI)]
##         (wrap []))

##       _
##       (throw-invalid-statement procedure inputsC+))))

(def: #export (translate-program programI)
  (-> $.Inst (Meta Any))
  (let [nilI runtimeT.noneI
        num-inputsI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH)
        decI (|>> ($i.int 1) $i.ISUB)
        headI (|>> $i.DUP
                   ($i.ALOAD +0)
                   $i.SWAP
                   $i.AALOAD
                   $i.SWAP
                   $i.DUP_X2
                   $i.POP)
        pairI (|>> ($i.int 2)
                   ($i.ANEWARRAY "java.lang.Object")
                   $i.DUP_X1
                   $i.SWAP
                   ($i.int 0)
                   $i.SWAP
                   $i.AASTORE
                   $i.DUP_X1
                   $i.SWAP
                   ($i.int 1)
                   $i.SWAP
                   $i.AASTORE)
        consI (|>> ($i.int 1)
                   ($i.string "")
                   $i.DUP2_X1
                   $i.POP2
                   runtimeT.variantI)
        prepare-input-listI (<| $i.with-label (function (_ @loop))
                                $i.with-label (function (_ @end))
                                (|>> nilI
                                     num-inputsI
                                     ($i.label @loop)
                                     decI
                                     $i.DUP
                                     ($i.IFLT @end)
                                     headI
                                     pairI
                                     consI
                                     $i.SWAP
                                     ($i.GOTO @loop)
                                     ($i.label @end)
                                     $i.POP
                                     ($i.ASTORE +0)))
        run-ioI (|>> ($i.CHECKCAST hostL.function-class)
                     $i.NULL
                     ($i.INVOKEVIRTUAL hostL.function-class runtimeT.apply-method (runtimeT.apply-signature +1) #0))
        main-type ($t.method (list ($t.array +1 ($t.class "java.lang.String" (list))))
                             #.None
                             (list))]
    (do macro.Monad<Meta>
      [current-module macro.current-module-name
       #let [normal-name "_"
             bytecode-name (format current-module "/" normal-name)
             class-name (text.replace-all "/" "." bytecode-name)
             bytecode ($d.class #$.V1_6
                                #$.Public $.finalC
                                bytecode-name
                                (list) ["java.lang.Object" (list)]
                                (list)
                                (|>> ($d.method #$.Public $.staticM "main" main-type
                                                (|>> prepare-input-listI
                                                     programI
                                                     run-ioI
                                                     $i.POP
                                                     $i.RETURN))))]
       #let [_ (log! (format "PROGRAM " current-module))]
       _ (commonT.store-class class-name bytecode)]
      (commonT.record-artifact (format bytecode-name ".class") bytecode))))