Implemented machinery for "lux syntax char case!".

1 files changed, 74 insertions, 51 deletions

diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 33aa290df..040f6f04a 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -8,6 +8,7 @@
     ["p" parser
      ["s" code]]]
    [data
+    ["." product]
     ["." maybe]
     ["." error]
     [text
@@ -16,6 +17,7 @@
      ["." list ("#@." functor)]]]
    [macro
     ["." code]
+    ["." template]
     [syntax (#+ syntax:)]]
    [target
     [jvm
@@ -34,7 +36,7 @@
       (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int)))))
       wrap))
 
-(`` (import: org/objectweb/asm/Opcodes
+(`` (import: #long org/objectweb/asm/Opcodes
       (#static NOP int)
 
       ## Conversion
@@ -103,42 +105,43 @@
       (~~ (declare RETURN IRETURN LRETURN DRETURN ARETURN))
       ))
 
-(import: org/objectweb/asm/Label
+(import: #long org/objectweb/asm/Label
   (new []))
 
-(import: org/objectweb/asm/MethodVisitor
+(import: #long org/objectweb/asm/MethodVisitor
   (visitCode [] void)
   (visitMaxs [int int] void)
   (visitEnd [] void)
   (visitInsn [int] void)
-  (visitLdcInsn [Object] void)
-  (visitFieldInsn [int String String String] void)
-  (visitTypeInsn [int String] void)
+  (visitLdcInsn [java/lang/Object] void)
+  (visitFieldInsn [int java/lang/String java/lang/String java/lang/String] void)
+  (visitTypeInsn [int java/lang/String] void)
   (visitVarInsn [int int] void)
   (visitIntInsn [int int] void)
-  (visitMethodInsn [int String String String boolean] void)
-  (visitLabel [Label] void)
-  (visitJumpInsn [int Label] void)
-  (visitTryCatchBlock [Label Label Label String] void)
-  (visitTableSwitchInsn [int int Label (Array  Label)] void)
+  (visitMethodInsn [int java/lang/String java/lang/String java/lang/String boolean] void)
+  (visitLabel [org/objectweb/asm/Label] void)
+  (visitJumpInsn [int org/objectweb/asm/Label] void)
+  (visitTryCatchBlock [org/objectweb/asm/Label org/objectweb/asm/Label org/objectweb/asm/Label java/lang/String] void)
+  (visitLookupSwitchInsn [org/objectweb/asm/Label (Array int) (Array org/objectweb/asm/Label)] void)
+  (visitTableSwitchInsn [int int org/objectweb/asm/Label (Array org/objectweb/asm/Label)] void)
   )
 
 ## [Insts]
 (def: #export make-label
-  (All [s] (Operation s Label))
+  (All [s] (Operation s org/objectweb/asm/Label))
   (function (_ state)
-    (#error.Success [state (Label::new)])))
+    (#error.Success [state (org/objectweb/asm/Label::new)])))
 
 (def: #export (with-label action)
-  (-> (-> Label Inst) Inst)
-  (action (Label::new)))
+  (All [a] (-> (-> org/objectweb/asm/Label a) a))
+  (action (org/objectweb/asm/Label::new)))
 
 (template [<name> <type> <prepare>]
   [(def: #export (<name> value)
      (-> <type> Inst)
      (function (_ visitor)
        (do-to visitor
-         (MethodVisitor::visitLdcInsn (<prepare> value)))))]
+         (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))]
 
   [boolean Bit  function.identity]
   [int     Int  host.long-to-int]
@@ -148,21 +151,21 @@
   [string  Text function.identity]
   )
 
-(syntax: (prefix {base s.local-identifier})
-  (wrap (list (` ((~ (code.local-identifier (format "Opcodes::" base))))))))
+(template: (prefix short)
+  (`` ((~~ (template.identifier ["org/objectweb/asm/Opcodes::" short])))))
 
 (def: #export NULL
   Inst
   (function (_ visitor)
     (do-to visitor
-      (MethodVisitor::visitInsn (prefix ACONST_NULL)))))
+      (org/objectweb/asm/MethodVisitor::visitInsn (prefix ACONST_NULL)))))
 
 (template [<name>]
   [(def: #export <name>
      Inst
      (function (_ visitor)
        (do-to visitor
-         (MethodVisitor::visitInsn (prefix <name>)))))]
+         (org/objectweb/asm/MethodVisitor::visitInsn (prefix <name>)))))]
 
   [NOP]
   
@@ -223,7 +226,7 @@
      (-> Nat Inst)
      (function (_ visitor)
        (do-to visitor
-         (MethodVisitor::visitVarInsn (prefix <name>) (.int register)))))]
+         (org/objectweb/asm/MethodVisitor::visitVarInsn (prefix <name>) (.int register)))))]
 
   [ILOAD] [LLOAD] [DLOAD] [ALOAD]
   [ISTORE] [LSTORE] [ASTORE]
@@ -234,13 +237,13 @@
      (-> Text Text Type Inst)
      (function (_ visitor)
        (do-to visitor
-         (MethodVisitor::visitFieldInsn (<inst>) (type.binary-name class) field (type.descriptor type)))))]
+         (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (type.binary-name class) field (type.descriptor type)))))]
 
-  [GETSTATIC Opcodes::GETSTATIC]
-  [PUTSTATIC Opcodes::PUTSTATIC]
+  [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC]
+  [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC]
   
-  [PUTFIELD  Opcodes::PUTFIELD]
-  [GETFIELD  Opcodes::GETFIELD]
+  [PUTFIELD  org/objectweb/asm/Opcodes::PUTFIELD]
+  [GETFIELD  org/objectweb/asm/Opcodes::GETFIELD]
   )
 
 (template [<name> <inst>]
@@ -248,40 +251,40 @@
      (-> Text Inst)
      (function (_ visitor)
        (do-to visitor
-         (MethodVisitor::visitTypeInsn (<inst>) (type.binary-name class)))))]
+         (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (type.binary-name class)))))]
 
-  [CHECKCAST  Opcodes::CHECKCAST]
-  [NEW        Opcodes::NEW]
-  [INSTANCEOF Opcodes::INSTANCEOF]
-  [ANEWARRAY  Opcodes::ANEWARRAY]
+  [CHECKCAST  org/objectweb/asm/Opcodes::CHECKCAST]
+  [NEW        org/objectweb/asm/Opcodes::NEW]
+  [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]
+  [ANEWARRAY  org/objectweb/asm/Opcodes::ANEWARRAY]
   )
 
 (def: #export (NEWARRAY type)
   (-> Primitive Inst)
   (function (_ visitor)
     (do-to visitor
-      (MethodVisitor::visitIntInsn (Opcodes::NEWARRAY)
-                                   (case type
-                                     #type.Boolean (Opcodes::T_BOOLEAN)
-                                     #type.Byte    (Opcodes::T_BYTE)
-                                     #type.Short   (Opcodes::T_SHORT)
-                                     #type.Int     (Opcodes::T_INT)
-                                     #type.Long    (Opcodes::T_LONG)
-                                     #type.Float   (Opcodes::T_FLOAT)
-                                     #type.Double  (Opcodes::T_DOUBLE)
-                                     #type.Char    (Opcodes::T_CHAR))))))
+      (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY)
+                                                     (case type
+                                                       #type.Boolean (org/objectweb/asm/Opcodes::T_BOOLEAN)
+                                                       #type.Byte    (org/objectweb/asm/Opcodes::T_BYTE)
+                                                       #type.Short   (org/objectweb/asm/Opcodes::T_SHORT)
+                                                       #type.Int     (org/objectweb/asm/Opcodes::T_INT)
+                                                       #type.Long    (org/objectweb/asm/Opcodes::T_LONG)
+                                                       #type.Float   (org/objectweb/asm/Opcodes::T_FLOAT)
+                                                       #type.Double  (org/objectweb/asm/Opcodes::T_DOUBLE)
+                                                       #type.Char    (org/objectweb/asm/Opcodes::T_CHAR))))))
 
 (template [<name> <inst>]
   [(def: #export (<name> class method-name method-signature interface?)
      (-> Text Text Method Bit Inst)
      (function (_ visitor)
        (do-to visitor
-         (MethodVisitor::visitMethodInsn (<inst>) (type.binary-name class) method-name (type.method-descriptor method-signature) interface?))))]
+         (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) (type.binary-name class) method-name (type.method-descriptor method-signature) interface?))))]
 
-  [INVOKESTATIC    Opcodes::INVOKESTATIC]
-  [INVOKEVIRTUAL   Opcodes::INVOKEVIRTUAL]
-  [INVOKESPECIAL   Opcodes::INVOKESPECIAL]
-  [INVOKEINTERFACE Opcodes::INVOKEINTERFACE]
+  [INVOKESTATIC    org/objectweb/asm/Opcodes::INVOKESTATIC]
+  [INVOKEVIRTUAL   org/objectweb/asm/Opcodes::INVOKEVIRTUAL]
+  [INVOKESPECIAL   org/objectweb/asm/Opcodes::INVOKESPECIAL]
+  [INVOKEINTERFACE org/objectweb/asm/Opcodes::INVOKEINTERFACE]
   )
 
 (template [<name>]
@@ -289,7 +292,7 @@
      (-> //.Label Inst)
      (function (_ visitor)
        (do-to visitor
-         (MethodVisitor::visitJumpInsn (prefix <name>) @where))))]
+         (org/objectweb/asm/MethodVisitor::visitJumpInsn (prefix <name>) @where))))]
 
   [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT]
   [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE]
@@ -298,11 +301,31 @@
   [GOTO]
   )
 
+(def: #export (LOOKUPSWITCH default keys+labels)
+  (-> //.Label (List [Int //.Label]) Inst)
+  (function (_ visitor)
+    (let [keys+labels (list.sort (function (_ left right)
+                                   (i/< (product.left left) (product.left right)))
+                                 keys+labels)
+          array-size (list.size keys+labels)
+          keys-array (host.array int array-size)
+          labels-array (host.array org/objectweb/asm/Label array-size)
+          _ (loop [idx 0]
+              (if (n/< array-size idx)
+                (let [[key label] (maybe.assume (list.nth idx keys+labels))]
+                  (exec
+                    (host.array-write idx (host.long-to-int key) keys-array)
+                    (host.array-write idx label labels-array)
+                    (recur (inc idx))))
+                []))]
+      (do-to visitor
+        (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys-array labels-array)))))
+
 (def: #export (TABLESWITCH min max default labels)
   (-> Int Int //.Label (List //.Label) Inst)
   (function (_ visitor)
     (let [num-labels (list.size labels)
-          labels-array (host.array Label num-labels)
+          labels-array (host.array org/objectweb/asm/Label num-labels)
           _ (loop [idx 0]
               (if (n/< num-labels idx)
                 (exec (host.array-write idx
@@ -311,19 +334,19 @@
                   (recur (inc idx)))
                 []))]
       (do-to visitor
-        (MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
+        (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
 
 (def: #export (try @from @to @handler exception)
   (-> //.Label //.Label //.Label Text Inst)
   (function (_ visitor)
     (do-to visitor
-      (MethodVisitor::visitTryCatchBlock @from @to @handler (type.binary-name exception)))))
+      (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (type.binary-name exception)))))
 
 (def: #export (label @label)
   (-> //.Label Inst)
   (function (_ visitor)
     (do-to visitor
-      (MethodVisitor::visitLabel @label))))
+      (org/objectweb/asm/MethodVisitor::visitLabel @label))))
 
 (def: #export (array type)
   (-> Type Inst)