aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host
diff options
context:
space:
mode:
authorEduardo Julian2020-05-30 15:19:28 -0400
committerEduardo Julian2020-05-30 15:19:28 -0400
commitb4d0eba7485caf0c6cf58de1193a9114fa273d8b (patch)
treef6f7fa2967bb5923347db1ed1d4c9b08e56bf8c6 /new-luxc/source/luxc/lang/host
parent6eaa3b57f3f1ea2ce13b942bdb4ef502fc1729bc (diff)
Split new-luxc into lux-jvm and lux-r.
Diffstat (limited to 'new-luxc/source/luxc/lang/host')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux131
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux298
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux464
-rw-r--r--new-luxc/source/luxc/lang/host/r.lux299
4 files changed, 0 insertions, 1192 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
deleted file mode 100644
index d957bdb1d..000000000
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ /dev/null
@@ -1,131 +0,0 @@
-(.module:
- [lux (#- Definition Type)
- [host (#+ import:)]
- [abstract
- monad]
- [control
- ["p" parser
- ["s" code]]]
- [data
- [binary (#+ Binary)]
- [collection
- ["." list ("#/." functor)]]]
- [macro
- ["." code]
- [syntax (#+ syntax:)]]
- [target
- [jvm
- ["." type (#+ Type)
- [category (#+ Class)]]]]
- [tool
- [compiler
- [reference (#+ Register)]
- [language
- [lux
- ["." generation]]]
- [meta
- [archive (#+ Archive)]]]]])
-
-(import: org/objectweb/asm/MethodVisitor)
-
-(import: org/objectweb/asm/ClassWriter)
-
-(import: #long org/objectweb/asm/Label
- (new []))
-
-(type: #export Def
- (-> ClassWriter ClassWriter))
-
-(type: #export Inst
- (-> MethodVisitor MethodVisitor))
-
-(type: #export Label
- org/objectweb/asm/Label)
-
-(type: #export Visibility
- #Public
- #Protected
- #Private
- #Default)
-
-(type: #export Version
- #V1_1
- #V1_2
- #V1_3
- #V1_4
- #V1_5
- #V1_6
- #V1_7
- #V1_8)
-
-(type: #export ByteCode Binary)
-
-(type: #export Definition [Text ByteCode])
-
-(type: #export Anchor [Label Register])
-
-(type: #export Host
- (generation.Host Inst Definition))
-
-(template [<name> <base>]
- [(type: #export <name>
- (<base> ..Anchor Inst Definition))]
-
- [State generation.State]
- [Operation generation.Operation]
- [Phase generation.Phase]
- [Handler generation.Handler]
- [Bundle generation.Bundle]
- [Extender generation.Extender]
- )
-
-(type: #export (Generator i)
- (-> Phase Archive i (Operation Inst)))
-
-(syntax: (config: {type s.local-identifier}
- {none s.local-identifier}
- {++ s.local-identifier}
- {options (s.tuple (p.many s.local-identifier))})
- (let [g!type (code.local-identifier type)
- g!none (code.local-identifier none)
- g!tags+ (list/map code.local-tag options)
- g!_left (code.local-identifier "_left")
- g!_right (code.local-identifier "_right")
- g!options+ (list/map (function (_ option)
- (` (def: (~' #export) (~ (code.local-identifier option))
- (~ g!type)
- (|> (~ g!none)
- (set@ (~ (code.local-tag option)) #1)))))
- options)]
- (wrap (list& (` (type: (~' #export) (~ g!type)
- (~ (code.record (list/map (function (_ tag)
- [tag (` .Bit)])
- g!tags+)))))
-
- (` (def: (~' #export) (~ g!none)
- (~ g!type)
- (~ (code.record (list/map (function (_ tag)
- [tag (` #0)])
- g!tags+)))))
-
- (` (def: (~' #export) ((~ (code.local-identifier ++)) (~ g!_left) (~ g!_right))
- (-> (~ g!type) (~ g!type) (~ g!type))
- (~ (code.record (list/map (function (_ tag)
- [tag (` (or (get@ (~ tag) (~ g!_left))
- (get@ (~ tag) (~ g!_right))))])
- g!tags+)))))
-
- g!options+))))
-
-(config: Class-Config noneC ++C [finalC])
-(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM])
-(config: Field-Config noneF ++F [finalF staticF transientF volatileF])
-
-(def: #export new-label
- (-> Any Label)
- (function (_ _)
- (org/objectweb/asm/Label::new)))
-
-(def: #export (simple-class name)
- (-> Text (Type Class))
- (type.class name (list)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
deleted file mode 100644
index f274da61f..000000000
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ /dev/null
@@ -1,298 +0,0 @@
-(.module:
- [lux (#- Type)
- ["." host (#+ import: do-to)]
- [control
- ["." function]]
- [data
- ["." product]
- [number
- ["i" int]]
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." array (#+ Array)]
- ["." list ("#@." functor)]]]
- [target
- [jvm
- [encoding
- ["." name]]
- ["." type (#+ Type Constraint)
- [category (#+ Class Value Method)]
- ["." signature]
- ["." descriptor]]]]]
- ["." //])
-
-(def: signature (|>> type.signature signature.signature))
-(def: descriptor (|>> type.descriptor descriptor.descriptor))
-(def: class-name (|>> type.descriptor descriptor.class-name name.read))
-
-(import: #long java/lang/Object)
-(import: #long java/lang/String)
-
-(import: org/objectweb/asm/Opcodes
- (#static ACC_PUBLIC int)
- (#static ACC_PROTECTED int)
- (#static ACC_PRIVATE int)
-
- (#static ACC_TRANSIENT int)
- (#static ACC_VOLATILE int)
-
- (#static ACC_ABSTRACT int)
- (#static ACC_FINAL int)
- (#static ACC_STATIC int)
- (#static ACC_SYNCHRONIZED int)
- (#static ACC_STRICT int)
-
- (#static ACC_SUPER int)
- (#static ACC_INTERFACE int)
-
- (#static V1_1 int)
- (#static V1_2 int)
- (#static V1_3 int)
- (#static V1_4 int)
- (#static V1_5 int)
- (#static V1_6 int)
- (#static V1_7 int)
- (#static V1_8 int)
- )
-
-(import: org/objectweb/asm/FieldVisitor
- (visitEnd [] void))
-
-(import: org/objectweb/asm/MethodVisitor
- (visitCode [] void)
- (visitMaxs [int int] void)
- (visitEnd [] void))
-
-(import: org/objectweb/asm/ClassWriter
- (#static COMPUTE_MAXS int)
- (#static COMPUTE_FRAMES int)
- (new [int])
- (visit [int int String String String [String]] void)
- (visitEnd [] void)
- (visitField [int String String String Object] FieldVisitor)
- (visitMethod [int String String String [String]] MethodVisitor)
- (toByteArray [] [byte]))
-
-(def: (string-array values)
- (-> (List Text) (Array Text))
- (let [output (host.array String (list.size values))]
- (exec (list@map (function (_ [idx value])
- (host.array-write idx value output))
- (list.enumerate values))
- output)))
-
-(def: (version-flag version)
- (-> //.Version Int)
- (case version
- #//.V1_1 (Opcodes::V1_1)
- #//.V1_2 (Opcodes::V1_2)
- #//.V1_3 (Opcodes::V1_3)
- #//.V1_4 (Opcodes::V1_4)
- #//.V1_5 (Opcodes::V1_5)
- #//.V1_6 (Opcodes::V1_6)
- #//.V1_7 (Opcodes::V1_7)
- #//.V1_8 (Opcodes::V1_8)))
-
-(def: (visibility-flag visibility)
- (-> //.Visibility Int)
- (case visibility
- #//.Public (Opcodes::ACC_PUBLIC)
- #//.Protected (Opcodes::ACC_PROTECTED)
- #//.Private (Opcodes::ACC_PRIVATE)
- #//.Default +0))
-
-(def: (class-flags config)
- (-> //.Class-Config Int)
- ($_ i.+
- (if (get@ #//.finalC config) (Opcodes::ACC_FINAL) +0)))
-
-(def: (method-flags config)
- (-> //.Method-Config Int)
- ($_ i.+
- (if (get@ #//.staticM config) (Opcodes::ACC_STATIC) +0)
- (if (get@ #//.finalM config) (Opcodes::ACC_FINAL) +0)
- (if (get@ #//.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0)
- (if (get@ #//.strictM config) (Opcodes::ACC_STRICT) +0)))
-
-(def: (field-flags config)
- (-> //.Field-Config Int)
- ($_ i.+
- (if (get@ #//.staticF config) (Opcodes::ACC_STATIC) +0)
- (if (get@ #//.finalF config) (Opcodes::ACC_FINAL) +0)
- (if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0)
- (if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0)))
-
-(def: param-signature
- (-> (Type Class) Text)
- (|>> ..signature (format ":")))
-
-(def: (formal-param [name super interfaces])
- (-> Constraint Text)
- (format name
- (param-signature super)
- (|> interfaces
- (list@map param-signature)
- (text.join-with ""))))
-
-(def: (constraints-signature constraints super interfaces)
- (-> (List Constraint) (Type Class) (List (Type Class))
- Text)
- (let [formal-params (if (list.empty? constraints)
- ""
- (format "<"
- (|> constraints
- (list@map formal-param)
- (text.join-with ""))
- ">"))]
- (format formal-params
- (..signature super)
- (|> interfaces
- (list@map ..signature)
- (text.join-with "")))))
-
-(def: class-computes
- Int
- ($_ i.+
- (ClassWriter::COMPUTE_MAXS)
- ## (ClassWriter::COMPUTE_FRAMES)
- ))
-
-(def: binary-name (|>> name.internal name.read))
-
-(template [<name> <flag>]
- [(def: #export (<name> version visibility config name constraints super interfaces
- definitions)
- (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def
- (host.type [byte]))
- (let [writer (|> (do-to (ClassWriter::new class-computes)
- (ClassWriter::visit (version-flag version)
- ($_ i.+
- (Opcodes::ACC_SUPER)
- <flag>
- (visibility-flag visibility)
- (class-flags config))
- (..binary-name name)
- (constraints-signature constraints super interfaces)
- (..class-name super)
- (|> interfaces
- (list@map ..class-name)
- string-array)))
- definitions)
- _ (ClassWriter::visitEnd writer)]
- (ClassWriter::toByteArray writer)))]
-
- [class +0]
- [abstract (Opcodes::ACC_ABSTRACT)]
- )
-
-(def: $Object
- (Type Class)
- (type.class "java.lang.Object" (list)))
-
-(def: #export (interface version visibility config name constraints interfaces
- definitions)
- (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def
- (host.type [byte]))
- (let [writer (|> (do-to (ClassWriter::new class-computes)
- (ClassWriter::visit (version-flag version)
- ($_ i.+
- (Opcodes::ACC_SUPER)
- (Opcodes::ACC_INTERFACE)
- (visibility-flag visibility)
- (class-flags config))
- (..binary-name name)
- (constraints-signature constraints $Object interfaces)
- (..class-name $Object)
- (|> interfaces
- (list@map ..class-name)
- string-array)))
- definitions)
- _ (ClassWriter::visitEnd writer)]
- (ClassWriter::toByteArray writer)))
-
-(def: #export (method visibility config name type then)
- (-> //.Visibility //.Method-Config Text (Type Method) //.Inst
- //.Def)
- (function (_ writer)
- (let [=method (ClassWriter::visitMethod ($_ i.+
- (visibility-flag visibility)
- (method-flags config))
- (..binary-name name)
- (..descriptor type)
- (..signature type)
- (string-array (list))
- writer)
- _ (MethodVisitor::visitCode =method)
- _ (then =method)
- _ (MethodVisitor::visitMaxs +0 +0 =method)
- _ (MethodVisitor::visitEnd =method)]
- writer)))
-
-(def: #export (abstract-method visibility config name type)
- (-> //.Visibility //.Method-Config Text (Type Method)
- //.Def)
- (function (_ writer)
- (let [=method (ClassWriter::visitMethod ($_ i.+
- (visibility-flag visibility)
- (method-flags config)
- (Opcodes::ACC_ABSTRACT))
- (..binary-name name)
- (..descriptor type)
- (..signature type)
- (string-array (list))
- writer)
- _ (MethodVisitor::visitEnd =method)]
- writer)))
-
-(def: #export (field visibility config name type)
- (-> //.Visibility //.Field-Config Text (Type Value) //.Def)
- (function (_ writer)
- (let [=field (do-to (ClassWriter::visitField ($_ i.+
- (visibility-flag visibility)
- (field-flags config))
- (..binary-name name)
- (..descriptor type)
- (..signature type)
- (host.null)
- writer)
- (FieldVisitor::visitEnd))]
- writer)))
-
-(template [<name> <lux-type> <jvm-type> <prepare>]
- [(def: #export (<name> visibility config name value)
- (-> //.Visibility //.Field-Config Text <lux-type> //.Def)
- (function (_ writer)
- (let [=field (do-to (ClassWriter::visitField ($_ i.+
- (visibility-flag visibility)
- (field-flags config))
- (..binary-name name)
- (..descriptor <jvm-type>)
- (..signature <jvm-type>)
- (<prepare> value)
- writer)
- (FieldVisitor::visitEnd))]
- writer)))]
-
- [boolean-field Bit type.boolean function.identity]
- [byte-field Int type.byte host.long-to-byte]
- [short-field Int type.short host.long-to-short]
- [int-field Int type.int host.long-to-int]
- [long-field Int type.long function.identity]
- [float-field Frac type.float host.double-to-float]
- [double-field Frac type.double function.identity]
- [char-field Nat type.char (|>> .int host.long-to-int host.int-to-char)]
- [string-field Text (type.class "java.lang.String" (list)) function.identity]
- )
-
-(def: #export (fuse defs)
- (-> (List //.Def) //.Def)
- (case defs
- #.Nil
- function.identity
-
- (#.Cons singleton #.Nil)
- singleton
-
- (#.Cons head tail)
- (function.compose (fuse tail) head)))
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)))
diff --git a/new-luxc/source/luxc/lang/host/r.lux b/new-luxc/source/luxc/lang/host/r.lux
deleted file mode 100644
index 6e4c7fb5b..000000000
--- a/new-luxc/source/luxc/lang/host/r.lux
+++ /dev/null
@@ -1,299 +0,0 @@
-(.module:
- [lux #- not or and list if function cond when]
- (lux (control pipe)
- (data [maybe "maybe/" Functor<Maybe>]
- [text]
- text/format
- [number]
- (coll [list "list/" Functor<List> Fold<List>]))
- (type abstract)))
-
-(abstract: #export Single {} Any)
-(abstract: #export Poly {} Any)
-
-(abstract: #export (Var kind)
- {}
-
- Text
-
- (def: name (All [k] (-> (Var k) Text)) (|>> :representation))
-
- (def: #export var (-> Text (Var Single)) (|>> :abstraction))
- (def: #export var-args (Var Poly) (:abstraction "..."))
- )
-
-(type: #export SVar (Var Single))
-(type: #export PVar (Var Poly))
-
-(abstract: #export Expression
- {}
-
- Text
-
- (def: #export expression (-> Expression Text) (|>> :representation))
-
- (def: #export code (-> Text Expression) (|>> :abstraction))
-
- (def: (self-contained code)
- (-> Text Expression)
- (:abstraction
- (format "(" code ")")))
-
- (def: nest
- (-> Text Text)
- (|>> (format "\n")
- (text.replace-all "\n" "\n ")))
-
- (def: (_block expression)
- (-> Text Text)
- (format "{" (nest expression) "\n" "}"))
-
- (def: #export (block expression)
- (-> Expression Expression)
- (:abstraction
- (format "{" (:representation expression) "}")))
-
- (def: #export null
- Expression
- (|> "NULL" self-contained))
-
- (def: #export n/a
- Expression
- (|> "NA" self-contained))
-
- (def: #export not-available Expression n/a)
- (def: #export not-applicable Expression n/a)
- (def: #export no-answer Expression n/a)
-
- (def: #export bool
- (-> Bit Expression)
- (|>> (case> #0 "FALSE"
- #1 "TRUE")
- self-contained))
-
- (def: #export (int value)
- (-> Int Expression)
- (self-contained
- (format "as.integer(" (%i value) ")")))
-
- (def: #export float
- (-> Frac Expression)
- (|>> (cond> [(f/= number.positive-infinity)]
- [(new> "1.0/0.0")]
-
- [(f/= number.negative-infinity)]
- [(new> "-1.0/0.0")]
-
- [(f/= number.not-a-number)]
- [(new> "0.0/0.0")]
-
- ## else
- [%f])
- self-contained))
-
- (def: #export string
- (-> Text Expression)
- (|>> %t self-contained))
-
- (def: (composite-literal left-delimiter right-delimiter entry-serializer)
- (All [a] (-> Text Text (-> a Text)
- (-> (List a) Expression)))
- (.function (_ entries)
- (self-contained
- (format left-delimiter
- (|> entries (list/map entry-serializer) (text.join-with ","))
- right-delimiter))))
-
- (def: #export named-list
- (-> (List [Text Expression]) Expression)
- (composite-literal "list(" ")" (.function (_ [key value])
- (format key "=" (:representation value)))))
-
- (template [<name> <function>]
- [(def: #export <name>
- (-> (List Expression) Expression)
- (composite-literal (format <function> "(") ")" expression))]
-
- [vector "c"]
- [list "list"]
- )
-
- (def: #export (slice from to list)
- (-> Expression Expression Expression Expression)
- (self-contained
- (format (:representation list)
- "[" (:representation from) ":" (:representation to) "]")))
-
- (def: #export (slice-from from list)
- (-> Expression Expression Expression)
- (self-contained
- (format (:representation list)
- "[-1" ":-" (:representation from) "]")))
-
- (def: #export (apply args func)
- (-> (List Expression) Expression Expression)
- (self-contained
- (format (:representation func) "(" (text.join-with "," (list/map expression args)) ")")))
-
- (def: #export (apply-kw args kw-args func)
- (-> (List Expression) (List [Text Expression]) Expression Expression)
- (self-contained
- (format (:representation func)
- (format "("
- (text.join-with "," (list/map expression args)) ","
- (text.join-with "," (list/map (.function (_ [key val])
- (format key "=" (expression val)))
- kw-args))
- ")"))))
-
- (def: #export (nth idx list)
- (-> Expression Expression Expression)
- (self-contained
- (format (:representation list) "[[" (:representation idx) "]]")))
-
- (def: #export (if test then else)
- (-> Expression Expression Expression Expression)
- (self-contained
- (format "if(" (:representation test) ")"
- " " (.._block (:representation then))
- " else " (.._block (:representation else)))))
-
- (def: #export (when test then)
- (-> Expression Expression Expression)
- (self-contained
- (format "if(" (:representation test) ") {"
- (.._block (:representation then))
- "\n" "}")))
-
- (def: #export (cond clauses else)
- (-> (List [Expression Expression]) Expression Expression)
- (list/fold (.function (_ [test then] next)
- (if test then next))
- else
- (list.reverse clauses)))
-
- (template [<name> <op>]
- [(def: #export (<name> param subject)
- (-> Expression Expression Expression)
- (self-contained
- (format (:representation subject)
- " " <op> " "
- (:representation param))))]
-
- [= "=="]
- [< "<"]
- [<= "<="]
- [> ">"]
- [>= ">="]
- [+ "+"]
- [- "-"]
- [* "*"]
- [/ "/"]
- [%% "%%"]
- [** "**"]
- [or "||"]
- [and "&&"]
- )
-
- (def: #export @@
- (All [k] (-> (Var k) Expression))
- (|>> ..name self-contained))
-
- (def: #export global
- (-> Text Expression)
- (|>> var @@))
-
- (template [<name> <func>]
- [(def: #export (<name> param subject)
- (-> Expression Expression Expression)
- (..apply (.list subject param) (..global <func>)))]
-
- [bit-or "bitwOr"]
- [bit-and "bitwAnd"]
- [bit-xor "bitwXor"]
- [bit-shl "bitwShiftL"]
- [bit-ushr "bitwShiftR"]
- )
-
- (def: #export (bit-not subject)
- (-> Expression Expression)
- (..apply (.list subject) (..global "bitwNot")))
-
- (template [<name> <op>]
- [(def: #export <name>
- (-> Expression Expression)
- (|>> :representation (format <op>) self-contained))]
-
- [not "!"]
- [negate "-"]
- )
-
- (def: #export (length list)
- (-> Expression Expression)
- (..apply (.list list) (..global "length")))
-
- (def: #export (range from to)
- (-> Expression Expression Expression)
- (self-contained
- (format (:representation from) ":" (:representation to))))
-
- (def: #export (function inputs body)
- (-> (List (Ex [k] (Var k))) Expression Expression)
- (let [args (|> inputs (list/map ..name) (text.join-with ", "))]
- (self-contained
- (format "function(" args ") "
- (.._block (:representation body))))))
-
- (def: #export (try body warning error finally)
- (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression)
- (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text)
- (.function (_ parameter value preparation)
- (|> value
- (maybe/map (|>> :representation preparation (format ", " parameter " = ")))
- (maybe.default ""))))]
- (self-contained
- (format "tryCatch("
- (.._block (:representation body))
- (optional "warning" warning id)
- (optional "error" error id)
- (optional "finally" finally .._block)
- ")"))))
-
- (def: #export (while test body)
- (-> Expression Expression Expression)
- (self-contained
- (format "while (" (:representation test) ") "
- (.._block (:representation body)))))
-
- (def: #export (for-in var inputs body)
- (-> SVar Expression Expression Expression)
- (self-contained
- (format "for (" (..name var) " in " (..expression inputs) ")"
- (.._block (:representation body)))))
-
- (template [<name> <keyword>]
- [(def: #export (<name> message)
- (-> Expression Expression)
- (..apply (.list message) (..global <keyword>)))]
-
- [stop "stop"]
- [print "print"]
- )
-
- (def: #export (set! var value)
- (-> (Var Single) Expression Expression)
- (self-contained
- (format (..name var) " <- " (:representation value))))
-
- (def: #export (set-nth! idx value list)
- (-> Expression Expression SVar Expression)
- (self-contained
- (format (..name list) "[[" (:representation idx) "]] <- " (:representation value))))
-
- (def: #export (then pre post)
- (-> Expression Expression Expression)
- (:abstraction
- (format (:representation pre)
- "\n"
- (:representation post))))
- )