aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/structure.jvm.lux
blob: 1584cb1709ace0a80c6c888503fc5067161e111b (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
(;module:
  lux
  (lux (control monad)
       (data text/format
             (coll [list]))
       [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
       [host #+ jvm-import do-to])
  (luxc ["&" base]
        (lang ["la" analysis]
              ["ls" synthesis])
        ["&;" analyser]
        ["&;" synthesizer]
        (generator ["&;" common])))

(jvm-import #long java.lang.Object)

(jvm-import org.objectweb.asm.Opcodes
  (#static ANEWARRAY int)
  (#static DUP int)
  (#static AASTORE int)
  (#static ACONST_NULL int)
  (#static INVOKESTATIC int))

(jvm-import org.objectweb.asm.MethodVisitor
  (visitInsn [int] void)
  (visitLdcInsn [Object] void)
  (visitTypeInsn [int String] void)
  (visitMethodInsn [int String String String boolean] void))

(def: #export (generate-tuple generate members)
  (-> (-> ls;Synthesis (Lux Unit)) (List ls;Synthesis) (Lux Unit))
  (do Monad<Lux>
    [#let [size (list;size members)]
     _ (&;assert "Cannot generate tuples with less than 2 elements."
                 (n.>= +2 size))
     visitor &common;get-visitor
     #let [_ (do-to visitor
               (MethodVisitor.visitLdcInsn [(|> size nat-to-int host;l2i (:! java.lang.Object))])
               (MethodVisitor.visitTypeInsn [Opcodes.ANEWARRAY "java/lang/Object"]))]
     _ (mapM @ (function [[idx member]]
                 (do @
                   [#let [_ (do-to visitor
                              (MethodVisitor.visitInsn [Opcodes.DUP])
                              (MethodVisitor.visitLdcInsn [(|> idx nat-to-int host;l2i (:! java.lang.Object))]))]
                    _ (generate member)
                    #let [_ (MethodVisitor.visitInsn [Opcodes.AASTORE] visitor)]]
                   (wrap [])))
             (list;enumerate members))]
    (wrap [])))

(def: (generate-variant-flag tail? visitor)
  (-> Bool MethodVisitor MethodVisitor)
  (if tail?
    (do-to visitor (MethodVisitor.visitLdcInsn [(:! java.lang.Object "")]))
    (do-to visitor (MethodVisitor.visitInsn [Opcodes.ACONST_NULL]))))

(def: #export (generate-variant generate tag tail? member)
  (-> (-> ls;Synthesis (Lux Unit)) Nat Bool ls;Synthesis (Lux Unit))
  (do Monad<Lux>
    [visitor &common;get-visitor
     #let [_ (do-to visitor
               (MethodVisitor.visitLdcInsn [(|> tag nat-to-int host;l2i (:! java.lang.Object))]))
           _ (generate-variant-flag tail? visitor)]
     _ (generate member)
     #let [_ (do-to visitor
               (MethodVisitor.visitMethodInsn [Opcodes.INVOKESTATIC
                                               &common;runtime-class-name
                                               "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"
                                               false]))]]
    (wrap [])))