- Heavy refactoring.

1 files changed, 0 insertions, 383 deletions

diff --git a/new-luxc/source/luxc/host/jvm/inst.lux b/new-luxc/source/luxc/host/jvm/inst.lux
deleted file mode 100644
index 37ab75020..000000000
--- a/new-luxc/source/luxc/host/jvm/inst.lux
+++ /dev/null
@@ -1,383 +0,0 @@
-(;module:
-  [lux #- char]
-  (lux (control monad
-                ["p" parser])
-       (data [maybe]
-             ["e" error]
-             text/format
-             (coll [list "L/" Functor<List>]))
-       [host #+ do-to]
-       [meta]
-       (meta [code]
-             ["s" syntax #+ syntax:]))
-  ["$" ..]
-  (.. ["$t" type]))
-
-## [Host]
-(host;import #long java.lang.Object)
-(host;import #long java.lang.String)
-
-(syntax: (declare [codes (p;many s;local-symbol)])
-  (|> codes
-      (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int)))))
-      wrap))
-
-(`` (host;import 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_ACMPEQ IFNULL
-                   IFEQ IFNE IFLT IFLE IFGT IFGE
-                   GOTO))
-
-      (#static ACONST_NULL int)
-      
-      ## Var
-      (~~ (declare ILOAD LLOAD DLOAD ALOAD
-                   ISTORE LSTORE ASTORE))
-      
-      ## Arithmetic
-      (~~ (declare IADD ISUB IMUL IDIV IREM
-                   LADD LSUB LMUL LDIV LREM LCMP
-                   FADD FSUB FMUL FDIV FREM FCMPG FCMPL
-                   DADD DSUB DMUL DDIV DREM 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 DRETURN ARETURN))
-      ))
-
-(host;import org.objectweb.asm.FieldVisitor
-  (visitEnd [] void))
-
-(host;import org.objectweb.asm.Label
-  (new []))
-
-(host;import 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)
-  (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)
-  )
-
-## [Insts]
-(def: #export make-label
-  (Meta Label)
-  (function [compiler]
-    (#e;Success [compiler (Label.new [])])))
-
-(def: #export (with-label action)
-  (-> (-> Label $;Inst) $;Inst)
-  (action (Label.new [])))
-
-(do-template [<name> <type> <prepare>]
-  [(def: #export (<name> value)
-     (-> <type> $;Inst)
-     (function [visitor]
-       (do-to visitor
-         (MethodVisitor.visitLdcInsn [(<prepare> value)]))))]
-
-  [boolean Bool id]
-  [int     Int  host;l2i]
-  [long    Int  id]
-  [double  Frac id]
-  [char    Nat  (|>. nat-to-int host;l2i host;i2c)]
-  [string  Text id]
-  )
-
-(syntax: (prefix [base s;local-symbol])
-  (wrap (list (code;local-symbol (format "Opcodes." base)))))
-
-(def: #export NULL
-  $;Inst
-  (function [visitor]
-    (do-to visitor
-      (MethodVisitor.visitInsn [(prefix ACONST_NULL)]))))
-
-(do-template [<name>]
-  [(def: #export <name>
-     $;Inst
-     (function [visitor]
-       (do-to visitor
-         (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]
-
-  ## Integer bitwise
-  [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR]
-  
-  ## Long arithmetic
-  [LADD] [LSUB] [LMUL] [LDIV] [LREM]
-  [LCMP]
-
-  ## Long bitwise
-  [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
-
-  ## Float arithmetic
-  [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FCMPG] [FCMPL]
-
-  ## Double arithmetic
-  [DADD] [DSUB] [DMUL] [DDIV] [DREM]
-  [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] [DRETURN] [ARETURN]
-  )
-
-(do-template [<name>]
-  [(def: #export (<name> register)
-     (-> Nat $;Inst)
-     (function [visitor]
-       (do-to visitor
-         (MethodVisitor.visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
-
-  [ILOAD] [LLOAD] [DLOAD] [ALOAD]
-  [ISTORE] [LSTORE] [ASTORE]
-  )
-
-(do-template [<name> <inst>]
-  [(def: #export (<name> class field type)
-     (-> Text Text $;Type $;Inst)
-     (function [visitor]
-       (do-to visitor
-         (MethodVisitor.visitFieldInsn [<inst> ($t;binary-name class) field ($t;descriptor type)]))))]
-
-  [GETSTATIC Opcodes.GETSTATIC]
-  [PUTSTATIC Opcodes.PUTSTATIC]
-  
-  [PUTFIELD  Opcodes.PUTFIELD]
-  [GETFIELD  Opcodes.GETFIELD]
-  )
-
-(do-template [<name> <inst>]
-  [(def: #export (<name> class)
-     (-> Text $;Inst)
-     (function [visitor]
-       (do-to visitor
-         (MethodVisitor.visitTypeInsn [<inst> ($t;binary-name class)]))))]
-
-  [CHECKCAST  Opcodes.CHECKCAST]
-  [NEW        Opcodes.NEW]
-  [INSTANCEOF Opcodes.INSTANCEOF]
-  [ANEWARRAY  Opcodes.ANEWARRAY]
-  )
-
-(def: #export (NEWARRAY type)
-  (-> $;Primitive $;Inst)
-  (function [visitor]
-    (do-to visitor
-      (MethodVisitor.visitIntInsn [Opcodes.NEWARRAY (case type
-                                                      #$;Boolean Opcodes.T_BOOLEAN
-                                                      #$;Byte    Opcodes.T_BYTE
-                                                      #$;Short   Opcodes.T_SHORT
-                                                      #$;Int     Opcodes.T_INT
-                                                      #$;Long    Opcodes.T_LONG
-                                                      #$;Float   Opcodes.T_FLOAT
-                                                      #$;Double  Opcodes.T_DOUBLE
-                                                      #$;Char    Opcodes.T_CHAR)]))))
-
-(do-template [<name> <inst>]
-  [(def: #export (<name> class method-name method-signature interface?)
-     (-> Text Text $;Method Bool $;Inst)
-     (function [visitor]
-       (do-to visitor
-         (MethodVisitor.visitMethodInsn [<inst> ($t;binary-name class) method-name ($t;method-descriptor method-signature) interface?]))))]
-
-  [INVOKESTATIC    Opcodes.INVOKESTATIC]
-  [INVOKEVIRTUAL   Opcodes.INVOKEVIRTUAL]
-  [INVOKESPECIAL   Opcodes.INVOKESPECIAL]
-  [INVOKEINTERFACE Opcodes.INVOKEINTERFACE]
-  )
-
-(do-template [<name>]
-  [(def: #export (<name> @where)
-     (-> $;Label $;Inst)
-     (function [visitor]
-       (do-to visitor
-         (MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))]
-
-  [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL]
-  [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
-  [GOTO]
-  )
-
-(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)
-          _ (loop [idx +0]
-              (if (n.< num-labels idx)
-                (exec (host;array-write idx
-                                        (maybe;assume (list;nth idx labels))
-                                        labels-array)
-                  (recur (n.inc idx)))
-                []))]
-      (do-to visitor
-        (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 ($t;binary-name exception)]))))
-
-(def: #export (label @label)
-  (-> $;Label $;Inst)
-  (function [visitor]
-    (do-to visitor
-      (MethodVisitor.visitLabel [@label]))))
-
-(def: #export (array type)
-  (-> $;Type $;Inst)
-  (case type
-    (#$;Primitive prim)
-    (NEWARRAY prim)
-
-    (#$;Generic generic)
-    (let [elem-class (case generic
-                       (#$;Class class params)
-                       ($t;binary-name class)
-
-                       _
-                       ($t;binary-name "java.lang.Object"))]
-      (ANEWARRAY elem-class))
-
-    _
-    (ANEWARRAY ($t;descriptor type))))
-
-(def: (primitive-wrapper type)
-  (-> $;Primitive Text)
-  (case type
-    #$;Boolean "java.lang.Boolean"
-    #$;Byte    "java.lang.Byte"
-    #$;Short   "java.lang.Short"
-    #$;Int     "java.lang.Integer"
-    #$;Long    "java.lang.Long"
-    #$;Float   "java.lang.Float"
-    #$;Double  "java.lang.Double"
-    #$;Char    "java.lang.Character"))
-
-(def: (primitive-unwrap type)
-  (-> $;Primitive Text)
-  (case type
-    #$;Boolean "booleanValue"
-    #$;Byte    "byteValue"
-    #$;Short   "shortValue"
-    #$;Int     "intValue"
-    #$;Long    "longValue"
-    #$;Float   "floatValue"
-    #$;Double  "doubleValue"
-    #$;Char    "charValue"))
-
-(def: #export (wrap type)
-  (-> $;Primitive $;Inst)
-  (let [class (primitive-wrapper type)]
-    (|>. (INVOKESTATIC class "valueOf"
-                       ($t;method (list (#$;Primitive type))
-                                  (#;Some ($t;class class (list)))
-                                  (list))
-                       false))))
-
-(def: #export (unwrap type)
-  (-> $;Primitive $;Inst)
-  (let [class (primitive-wrapper type)]
-    (|>. (CHECKCAST class)
-         (INVOKEVIRTUAL class (primitive-unwrap type)
-                        ($t;method (list) (#;Some (#$;Primitive type)) (list))
-                        false))))
-
-(def: #export (fuse insts)
-  (-> (List $;Inst) $;Inst)
-  (case insts
-    #;Nil
-    id
-
-    (#;Cons singleton #;Nil)
-    singleton
-
-    (#;Cons head tail)
-    (. (fuse tail) head)))