Split new-luxc into lux-jvm and lux-r.

1 files changed, 0 insertions, 464 deletions

diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
deleted file mode 100644
index b673c7d7e..000000000
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ /dev/null
@@ -1,464 +0,0 @@
-(.module:
-  [lux (#- Type int char)
-   ["." host (#+ import: do-to)]
-   [abstract
-    [monad (#+ do)]]
-   [control
-    ["." function]
-    ["." try]
-    ["p" parser
-     ["s" code]]]
-   [data
-    ["." product]
-    ["." maybe]
-    [number
-     ["n" nat]
-     ["i" int]]
-    [collection
-     ["." list ("#@." functor)]]]
-   [macro
-    ["." code]
-    ["." template]
-    [syntax (#+ syntax:)]]
-   [target
-    [jvm
-     [encoding
-      ["." name (#+ External)]]
-     ["." type (#+ Type) ("#@." equivalence)
-      [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
-      ["." box]
-      ["." descriptor]
-      ["." reflection]]]]
-   [tool
-    [compiler
-     [phase (#+ Operation)]]]]
-  ["." // (#+ Inst)])
-
-(def: class-name (|>> type.descriptor descriptor.class-name name.read))
-(def: descriptor (|>> type.descriptor descriptor.descriptor))
-(def: reflection (|>> type.reflection reflection.reflection))
-
-## [Host]
-(import: #long java/lang/Object)
-(import: #long java/lang/String)
-
-(syntax: (declare {codes (p.many s.local-identifier)})
-  (|> codes
-      (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int)))))
-      wrap))
-
-(`` (import: #long org/objectweb/asm/Opcodes
-      (#static NOP int)
-
-      ## Conversion
-      (~~ (declare D2F D2I D2L
-                   F2D F2I F2L
-                   I2B I2C I2D I2F I2L I2S
-                   L2D L2F L2I))
-
-      ## Primitive
-      (~~ (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
-                   T_BYTE T_SHORT T_INT T_LONG))
-
-      ## Class
-      (~~ (declare CHECKCAST NEW INSTANCEOF))
-      
-      ## Stack
-      (~~ (declare DUP DUP_X1 DUP_X2
-                   DUP2 DUP2_X1 DUP2_X2
-                   POP POP2
-                   SWAP))
-      
-      ## Jump
-      (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT
-                   IF_ICMPNE IF_ICMPGE IF_ICMPLE
-                   IF_ACMPEQ IF_ACMPNE IFNULL IFNONNULL
-                   IFEQ IFNE IFLT IFLE IFGT IFGE
-                   GOTO))
-
-      (~~ (declare BIPUSH SIPUSH))
-      (~~ (declare ICONST_M1 ICONST_0 ICONST_1 ICONST_2 ICONST_3 ICONST_4 ICONST_5
-                   LCONST_0 LCONST_1
-                   FCONST_0 FCONST_1 FCONST_2
-                   DCONST_0 DCONST_1))
-      (#static ACONST_NULL int)
-      
-      ## Var
-      (~~ (declare IINC
-                   ILOAD LLOAD FLOAD DLOAD ALOAD
-                   ISTORE LSTORE FSTORE DSTORE ASTORE))
-      
-      ## Arithmetic
-      (~~ (declare IADD ISUB IMUL IDIV IREM INEG
-                   LADD LSUB LMUL LDIV LREM LNEG LCMP
-                   FADD FSUB FMUL FDIV FREM FNEG FCMPG FCMPL
-                   DADD DSUB DMUL DDIV DREM DNEG DCMPG DCMPL))
-      
-      ## Bit-wise
-      (~~ (declare IAND IOR IXOR ISHL ISHR IUSHR
-                   LAND LOR LXOR LSHL LSHR LUSHR))
-
-      ## Array
-      (~~ (declare ARRAYLENGTH NEWARRAY ANEWARRAY
-                   AALOAD AASTORE
-                   BALOAD BASTORE
-                   SALOAD SASTORE
-                   IALOAD IASTORE
-                   LALOAD LASTORE
-                   FALOAD FASTORE
-                   DALOAD DASTORE
-                   CALOAD CASTORE))
-      
-      ## Member
-      (~~ (declare GETSTATIC PUTSTATIC GETFIELD PUTFIELD
-                   INVOKESTATIC INVOKESPECIAL INVOKEVIRTUAL INVOKEINTERFACE))
-
-      (#static ATHROW int)
-
-      ## Concurrency
-      (~~ (declare MONITORENTER MONITOREXIT))
-      
-      ## Return
-      (~~ (declare RETURN IRETURN LRETURN FRETURN DRETURN ARETURN))
-      ))
-
-(import: #long org/objectweb/asm/Label
-  (new []))
-
-(import: #long org/objectweb/asm/MethodVisitor
-  (visitCode [] void)
-  (visitMaxs [int int] void)
-  (visitEnd [] void)
-  (visitInsn [int] 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 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 [int] [org/objectweb/asm/Label]] void)
-  (visitTableSwitchInsn [int int org/objectweb/asm/Label [org/objectweb/asm/Label]] void)
-  )
-
-## [Insts]
-(def: #export make-label
-  (All [s] (Operation s org/objectweb/asm/Label))
-  (function (_ state)
-    (#try.Success [state (org/objectweb/asm/Label::new)])))
-
-(def: #export (with-label action)
-  (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
-         (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))]
-
-  [boolean Bit  function.identity]
-  [int     Int  host.long-to-int]
-  [long    Int  function.identity]
-  [double  Frac function.identity]
-  [char    Nat  (|>> .int host.long-to-int host.int-to-char)]
-  [string  Text function.identity]
-  )
-
-(template: (!prefix short)
-  (`` ((~~ (template.identifier ["org/objectweb/asm/Opcodes::" short])))))
-
-(template [<constant>]
-  [(def: #export <constant>
-     Inst
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <constant>)))))]
-
-  [ICONST_M1] [ICONST_0] [ICONST_1] [ICONST_2] [ICONST_3] [ICONST_4] [ICONST_5]
-  [LCONST_0] [LCONST_1]
-  [FCONST_0] [FCONST_1] [FCONST_2]
-  [DCONST_0] [DCONST_1]
-  )
-
-(def: #export NULL
-  Inst
-  (function (_ visitor)
-    (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL)))))
-
-(template [<constant>]
-  [(def: #export (<constant> constant)
-     (-> Int Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix <constant>) constant))))]
-
-  [BIPUSH]
-  [SIPUSH]
-  )
-
-(template [<name>]
-  [(def: #export <name>
-     Inst
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))]
-
-  [NOP]
-  
-  ## Stack
-  [DUP] [DUP_X1] [DUP_X2] [DUP2] [DUP2_X1] [DUP2_X2]
-  [POP] [POP2]
-  [SWAP]
-
-  ## Conversions
-  [D2F] [D2I] [D2L]
-  [F2D] [F2I] [F2L]
-  [I2B] [I2C] [I2D] [I2F] [I2L] [I2S]
-  [L2D] [L2F] [L2I]
-
-  ## Integer arithmetic
-  [IADD] [ISUB] [IMUL] [IDIV] [IREM] [INEG]
-
-  ## Integer bitwise
-  [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR]
-  
-  ## Long arithmetic
-  [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LNEG]
-  [LCMP]
-
-  ## Long bitwise
-  [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
-
-  ## Float arithmetic
-  [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FNEG] [FCMPG] [FCMPL]
-
-  ## Double arithmetic
-  [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DNEG]
-  [DCMPG] [DCMPL]
-
-  ## Array
-  [ARRAYLENGTH]
-  [AALOAD] [AASTORE]
-  [BALOAD] [BASTORE]
-  [SALOAD] [SASTORE]
-  [IALOAD] [IASTORE]
-  [LALOAD] [LASTORE]
-  [FALOAD] [FASTORE]
-  [DALOAD] [DASTORE]
-  [CALOAD] [CASTORE]
-
-  ## Exceptions
-  [ATHROW]
-
-  ## Concurrency
-  [MONITORENTER] [MONITOREXIT]
-
-  ## Return
-  [RETURN] [IRETURN] [LRETURN] [FRETURN] [DRETURN] [ARETURN]
-  )
-
-(type: #export Register Nat)
-
-(template [<name>]
-  [(def: #export (<name> register)
-     (-> Register Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))]
-
-  [IINC]
-  [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD]
-  [ISTORE] [LSTORE] [FSTORE] [DSTORE] [ASTORE]
-  )
-
-(template [<name> <inst>]
-  [(def: #export (<name> class field type)
-     (-> (Type Class) Text (Type Value) Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class-name class) field (..descriptor type)))))]
-
-  [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC]
-  [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC]
-  
-  [PUTFIELD  org/objectweb/asm/Opcodes::PUTFIELD]
-  [GETFIELD  org/objectweb/asm/Opcodes::GETFIELD]
-  )
-
-(template [<category> <instructions>+]
-  [(`` (template [<name> <inst>]
-         [(def: #export (<name> class)
-            (-> (Type <category>) Inst)
-            (function (_ visitor)
-              (do-to visitor
-                (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class-name class)))))]
-
-         (~~ (template.splice <instructions>+))))]
-
-  [Object
-   [[CHECKCAST  org/objectweb/asm/Opcodes::CHECKCAST]
-    [ANEWARRAY  org/objectweb/asm/Opcodes::ANEWARRAY]]]
-
-  [Class
-   [[NEW        org/objectweb/asm/Opcodes::NEW]
-    [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]]]
-  )
-
-(def: #export (NEWARRAY type)
-  (-> (Type Primitive) Inst)
-  (function (_ visitor)
-    (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY)
-                                                     (`` (cond (~~ (template [<descriptor> <opcode>]
-                                                                     [(type@= <descriptor> type) (<opcode>)]
-                                                                     
-                                                                     [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]))
-                                                               ## else
-                                                               (undefined)))))))
-
-(template [<name> <inst> <interface?>]
-  [(def: #export (<name> class method-name method)
-     (-> (Type Class) Text (Type Method) Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>)
-                                                           (..class-name class)
-                                                           method-name
-                                                           (|> method type.descriptor descriptor.descriptor)
-                                                           <interface?>))))]
-
-  [INVOKESTATIC    org/objectweb/asm/Opcodes::INVOKESTATIC false]
-  [INVOKEVIRTUAL   org/objectweb/asm/Opcodes::INVOKEVIRTUAL false]
-  [INVOKESPECIAL   org/objectweb/asm/Opcodes::INVOKESPECIAL false]
-  [INVOKEINTERFACE org/objectweb/asm/Opcodes::INVOKEINTERFACE true]
-  )
-
-(template [<name>]
-  [(def: #export (<name> @where)
-     (-> //.Label Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))]
-
-  [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT]
-  [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE]
-  [IF_ACMPEQ] [IF_ACMPNE] [IFNULL] [IFNONNULL]
-  [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
-  [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 org/objectweb/asm/Label num-labels)
-          _ (loop [idx 0]
-              (if (n.< num-labels idx)
-                (exec (host.array-write idx
-                                        (maybe.assume (list.nth idx labels))
-                                        labels-array)
-                  (recur (inc idx)))
-                []))]
-      (do-to visitor
-        (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
-
-(def: #export (try @from @to @handler exception)
-  (-> //.Label //.Label //.Label (Type Class) Inst)
-  (function (_ visitor)
-    (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class-name exception)))))
-
-(def: #export (label @label)
-  (-> //.Label Inst)
-  (function (_ visitor)
-    (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitLabel @label))))
-
-(def: #export (array elementT)
-  (-> (Type Value) Inst)
-  (case (type.primitive? elementT)
-    (#.Left elementT)
-    (ANEWARRAY elementT)
-
-    (#.Right elementT)
-    (NEWARRAY elementT)))
-
-(template [<name> <boolean> <byte> <short> <int> <long> <float> <double> <char>]
-  [(def: (<name> type)
-     (-> (Type Primitive) Text)
-     (`` (cond (~~ (template [<descriptor> <output>]
-                     [(type@= <descriptor> type) <output>]
-                     
-                     [type.boolean <boolean>]
-                     [type.byte    <byte>]
-                     [type.short   <short>]
-                     [type.int     <int>]
-                     [type.long    <long>]
-                     [type.float   <float>]
-                     [type.double  <double>]
-                     [type.char    <char>]))
-               ## else
-               (undefined))))]
-
-  [primitive-wrapper
-   box.boolean box.byte box.short box.int
-   box.long box.float box.double box.char]
-  [primitive-unwrap
-   "booleanValue" "byteValue" "shortValue" "intValue"
-   "longValue" "floatValue" "doubleValue" "charValue"]
-  )
-
-(def: #export (wrap type)
-  (-> (Type Primitive) Inst)
-  (let [wrapper (type.class (primitive-wrapper type) (list))]
-    (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)]))))
-
-(def: #export (unwrap type)
-  (-> (Type Primitive) Inst)
-  (let [wrapper (type.class (primitive-wrapper type) (list))]
-    (|>> (CHECKCAST wrapper)
-         (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)])))))
-
-(def: #export (fuse insts)
-  (-> (List Inst) Inst)
-  (case insts
-    #.Nil
-    function.identity
-
-    (#.Cons singleton #.Nil)
-    singleton
-
-    (#.Cons head tail)
-    (function.compose (fuse tail) head)))