diff options
Diffstat (limited to 'new-luxc/source/luxc/generator')
17 files changed, 55 insertions, 993 deletions
diff --git a/new-luxc/source/luxc/generator/case.jvm.lux b/new-luxc/source/luxc/generator/case.jvm.lux index a619768bb..a9ea4482a 100644 --- a/new-luxc/source/luxc/generator/case.jvm.lux +++ b/new-luxc/source/luxc/generator/case.jvm.lux @@ -6,10 +6,10 @@ [meta "meta/" Monad<Meta>]) (luxc ["_" base] [";L" host] - (lang ["ls" synthesis]) - (generator (host ["$" jvm] - (jvm ["$t" type] - ["$i" inst])))) + (host ["$" jvm] + (jvm ["$t" type] + ["$i" inst])) + (lang ["ls" synthesis])) [../runtime]) (def: $Object $;Type ($t;class "java.lang.Object" (list))) diff --git a/new-luxc/source/luxc/generator/common.jvm.lux b/new-luxc/source/luxc/generator/common.jvm.lux index 4439ae51d..1870530c2 100644 --- a/new-luxc/source/luxc/generator/common.jvm.lux +++ b/new-luxc/source/luxc/generator/common.jvm.lux @@ -9,10 +9,10 @@ (coll [dict #+ Dict])) [host] (world [blob #+ Blob])) - (luxc (generator (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst]))))) + (luxc (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])))) (host;import org.objectweb.asm.Opcodes (#static V1_6 int)) diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux index 842199a47..3cf5fb189 100644 --- a/new-luxc/source/luxc/generator/eval.jvm.lux +++ b/new-luxc/source/luxc/generator/eval.jvm.lux @@ -6,15 +6,15 @@ [meta #+ Monad<Meta> "Meta/" Monad<Meta>] [host #+ do-to]) (luxc ["&" base] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) (lang ["la" analysis] ["ls" synthesis]) ["&;" analyser] ["&;" synthesizer] - (generator ["&;" common] - (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst]))) + (generator ["&;" common]) )) (host;import java.lang.Object) diff --git a/new-luxc/source/luxc/generator/expression.jvm.lux b/new-luxc/source/luxc/generator/expression.jvm.lux index 61120ef86..624070145 100644 --- a/new-luxc/source/luxc/generator/expression.jvm.lux +++ b/new-luxc/source/luxc/generator/expression.jvm.lux @@ -8,6 +8,7 @@ [meta] (meta ["s" syntax])) (luxc ["&" base] + (host ["$" jvm]) (lang ["ls" synthesis]) ["&;" analyser] ["&;" synthesizer] @@ -19,8 +20,7 @@ ["&;" procedure] ["&;" function] ["&;" reference] - [";G" case] - (host ["$" jvm])))) + [";G" case]))) (exception: #export Unrecognized-Synthesis) diff --git a/new-luxc/source/luxc/generator/function.jvm.lux b/new-luxc/source/luxc/generator/function.jvm.lux index ce92b9010..1b0939856 100644 --- a/new-luxc/source/luxc/generator/function.jvm.lux +++ b/new-luxc/source/luxc/generator/function.jvm.lux @@ -6,17 +6,17 @@ [meta]) (luxc ["&" base] [";L" host] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) (lang ["la" analysis] ["ls" synthesis]) ["&;" analyser] ["&;" synthesizer] (synthesizer [function]) (generator ["&;" common] - ["&;" runtime] - (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst]))))) + ["&;" runtime]))) (def: arity-field Text "arity") diff --git a/new-luxc/source/luxc/generator/host/jvm.lux b/new-luxc/source/luxc/generator/host/jvm.lux deleted file mode 100644 index 24d4a9ea9..000000000 --- a/new-luxc/source/luxc/generator/host/jvm.lux +++ /dev/null @@ -1,130 +0,0 @@ -(;module: - [lux #- Type Def] - (lux (control monad - ["p" parser]) - (data (coll [list "list/" Functor<List>])) - [meta] - (meta [code] - ["s" syntax #+ syntax:]) - [host])) - -## [Host] -(host;import org.objectweb.asm.MethodVisitor) - -(host;import org.objectweb.asm.ClassWriter) - -(host;import #long org.objectweb.asm.Label - (new [])) - -## [Type] -(type: #export Bound - #Upper - #Lower) - -(type: #export Primitive - #Boolean - #Byte - #Short - #Int - #Long - #Float - #Double - #Char) - -(type: #export #rec Generic - (#Var Text) - (#Wildcard (Maybe [Bound Generic])) - (#Class Text (List Generic))) - -(type: #export Class - [Text (List Generic)]) - -(type: #export Parameter - [Text Class (List Class)]) - -(type: #export #rec Type - (#Primitive Primitive) - (#Generic Generic) - (#Array Type)) - -(type: #export Method - {#args (List Type) - #return (Maybe Type) - #exceptions (List Generic)}) - -(type: #export Def - (-> ClassWriter ClassWriter)) - -(type: #export Inst - (-> MethodVisitor MethodVisitor)) - -(type: #export Label - org.objectweb.asm.Label) - -(type: #export Register Nat) - -(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) - -## [Values] -(syntax: (config: [type s;local-symbol] - [none s;local-symbol] - [++ s;local-symbol] - [options (s;tuple (p;many s;local-symbol))]) - (let [g!type (code;local-symbol type) - g!none (code;local-symbol none) - g!tags+ (list/map code;local-tag options) - g!_left (code;local-symbol "_left") - g!_right (code;local-symbol "_right") - g!options+ (list/map (function [option] - (` (def: (~' #export) (~ (code;local-symbol option)) - (~ g!type) - (|> (~ g!none) - (set@ (~ (code;local-tag option)) true))))) - options)] - (wrap (list& (` (type: (~' #export) (~ g!type) - (~ (code;record (list/map (function [tag] - [tag (` ;Bool)]) - g!tags+))))) - - (` (def: (~' #export) (~ g!none) - (~ g!type) - (~ (code;record (list/map (function [tag] - [tag (` false)]) - g!tags+))))) - - (` (def: (~' #export) ((~ (code;local-symbol ++)) (~ 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+)))) - -## Configs -(config: Class-Config noneC ++C [finalC]) -(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM]) -(config: Field-Config noneF ++F [finalF staticF transientF volatileF]) - -## Labels -(def: #export new-label - (-> Unit Label) - org.objectweb.asm.Label.new) - -(def: #export (simple-class name) - (-> Text Class) - [name (list)]) diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux deleted file mode 100644 index 1d50ba9f6..000000000 --- a/new-luxc/source/luxc/generator/host/jvm/def.lux +++ /dev/null @@ -1,287 +0,0 @@ -(;module: - lux - (lux (data [text] - text/format - [product] - (coll ["a" array] - [list "list/" Functor<List>])) - [host #+ do-to]) - ["$" ..] - (.. ["$t" type])) - -## [Host] -(host;import #long java.lang.Object) -(host;import #long java.lang.String) - -(host;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) - ) - -(host;import org.objectweb.asm.FieldVisitor - (visitEnd [] void)) - -(host;import org.objectweb.asm.MethodVisitor - (visitCode [] void) - (visitMaxs [int int] void) - (visitEnd [] void)) - -(host;import org.objectweb.asm.ClassWriter - (#static COMPUTE_MAXS int) - (#static COMPUTE_FRAMES int) - (new [int]) - (visit [int int String String String (Array String)] void) - (visitEnd [] void) - (visitField [int String String String Object] FieldVisitor) - (visitMethod [int String String String (Array String)] MethodVisitor) - (toByteArray [] (Array byte))) - -## [Defs] -(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: exceptions-array - (-> $;Method (Array Text)) - (|>. (get@ #$;exceptions) - (list/map (|>. #$;Generic $t;descriptor)) - string-array)) - -(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: class-to-type - (-> $;Class $;Type) - (|>. #$;Class #$;Generic)) - -(def: param-signature - (-> $;Class Text) - (|>. class-to-type $t;signature (format ":"))) - -(def: (formal-param [name super interfaces]) - (-> $;Parameter Text) - (format name - (param-signature super) - (|> interfaces - (list/map param-signature) - (text;join-with "")))) - -(def: (parameters-signature parameters super interfaces) - (-> (List $;Parameter) $;Class (List $;Class) - Text) - (let [formal-params (if (list;empty? parameters) - "" - (format "<" - (|> parameters - (list/map formal-param) - (text;join-with "")) - ">"))] - (format formal-params - (|> super class-to-type $t;signature) - (|> interfaces - (list/map (|>. class-to-type $t;signature)) - (text;join-with ""))))) - -(def: class-computes - Int - ($_ i.+ - ClassWriter.COMPUTE_MAXS - ClassWriter.COMPUTE_FRAMES)) - -(do-template [<name> <flag>] - [(def: #export (<name> version visibility config name parameters super interfaces - definitions) - (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) $;Class (List $;Class) $;Def - (host;type (Array 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)) - ($t;binary-name name) - (parameters-signature parameters super interfaces) - (|> super product;left $t;binary-name) - (|> interfaces - (list/map (|>. product;left $t;binary-name)) - string-array)])) - definitions) - _ (ClassWriter.visitEnd [] writer)] - (ClassWriter.toByteArray [] writer)))] - - [class 0] - [abstract Opcodes.ACC_ABSTRACT] - ) - -(def: $Object $;Class ["java.lang.Object" (list)]) - -(def: #export (interface version visibility config name parameters interfaces - definitions) - (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) (List $;Class) $;Def - (host;type (Array 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)) - ($t;binary-name name) - (parameters-signature parameters $Object interfaces) - (|> $Object product;left $t;binary-name) - (|> interfaces - (list/map (|>. product;left $t;binary-name)) - string-array)])) - definitions) - _ (ClassWriter.visitEnd [] writer)] - (ClassWriter.toByteArray [] writer))) - -(def: #export (method visibility config name type then) - (-> $;Visibility $;Method-Config Text $;Method $;Inst - $;Def) - (function [writer] - (let [=method (ClassWriter.visitMethod [($_ i.+ - (visibility-flag visibility) - (method-flags config)) - ($t;binary-name name) - ($t;method-descriptor type) - ($t;method-signature type) - (exceptions-array type)] - 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 $;Method - $;Def) - (function [writer] - (let [=method (ClassWriter.visitMethod [($_ i.+ - (visibility-flag visibility) - (method-flags config) - Opcodes.ACC_ABSTRACT) - ($t;binary-name name) - ($t;method-descriptor type) - ($t;method-signature type) - (exceptions-array type)] - writer) - _ (MethodVisitor.visitEnd [] =method)] - writer))) - -(def: #export (field visibility config name type) - (-> $;Visibility $;Field-Config Text $;Type $;Def) - (function [writer] - (let [=field (do-to (ClassWriter.visitField [($_ i.+ - (visibility-flag visibility) - (field-flags config)) - ($t;binary-name name) - ($t;descriptor type) - ($t;signature type) - (host;null)] writer) - (FieldVisitor.visitEnd []))] - writer))) - -(do-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)) - ($t;binary-name name) - ($t;descriptor <jvm-type>) - ($t;signature <jvm-type>) - (<prepare> value)] - writer) - (FieldVisitor.visitEnd []))] - writer)))] - - [boolean-field Bool $t;boolean id] - [byte-field Int $t;byte host;l2b] - [short-field Int $t;short host;l2s] - [int-field Int $t;int host;l2i] - [long-field Int $t;long id] - [float-field Frac $t;float host;d2f] - [double-field Frac $t;double id] - [char-field Nat $t;char (|>. nat-to-int host;l2i host;i2c)] - [string-field Text ($t;class "java.lang.String" (list)) id] - ) - -(def: #export (fuse defs) - (-> (List $;Def) $;Def) - (case defs - #;Nil - id - - (#;Cons singleton #;Nil) - singleton - - (#;Cons head tail) - (. (fuse tail) head))) diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux deleted file mode 100644 index 37ab75020..000000000 --- a/new-luxc/source/luxc/generator/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))) diff --git a/new-luxc/source/luxc/generator/host/jvm/type.lux b/new-luxc/source/luxc/generator/host/jvm/type.lux deleted file mode 100644 index 3825d443b..000000000 --- a/new-luxc/source/luxc/generator/host/jvm/type.lux +++ /dev/null @@ -1,138 +0,0 @@ -(;module: - [lux #- char] - (lux (data [text] - text/format - (coll [list "L/" Functor<List>]))) - ["$" ..]) - -## Types -(do-template [<name> <primitive>] - [(def: #export <name> $;Type (#$;Primitive <primitive>))] - - [boolean #$;Boolean] - [byte #$;Byte] - [short #$;Short] - [int #$;Int] - [long #$;Long] - [float #$;Float] - [double #$;Double] - [char #$;Char] - ) - -(def: #export (class name params) - (-> Text (List $;Generic) $;Type) - (#$;Generic (#$;Class name params))) - -(def: #export (var name) - (-> Text $;Type) - (#$;Generic (#$;Var name))) - -(def: #export (wildcard bound) - (-> (Maybe [$;Bound $;Generic]) $;Type) - (#$;Generic (#$;Wildcard bound))) - -(def: #export (array depth elemT) - (-> Nat $;Type $;Type) - (case depth - +0 elemT - _ (#$;Array (array (n.dec depth) elemT)))) - -(def: #export (binary-name class) - (-> Text Text) - (text;replace-all "." "/" class)) - -(def: #export (descriptor type) - (-> $;Type Text) - (case type - (#$;Primitive prim) - (case prim - #$;Boolean "Z" - #$;Byte "B" - #$;Short "S" - #$;Int "I" - #$;Long "J" - #$;Float "F" - #$;Double "D" - #$;Char "C") - - (#$;Array sub) - (format "[" (descriptor sub)) - - (#$;Generic generic) - (case generic - (#$;Class class params) - (format "L" (binary-name class) ";") - - (^or (#$;Var name) (#$;Wildcard ?bound)) - (descriptor (#$;Generic (#$;Class "java.lang.Object" (list))))) - )) - -(def: #export (signature type) - (-> $;Type Text) - (case type - (#$;Primitive prim) - (case prim - #$;Boolean "Z" - #$;Byte "B" - #$;Short "S" - #$;Int "I" - #$;Long "J" - #$;Float "F" - #$;Double "D" - #$;Char "C") - - (#$;Array sub) - (format "[" (signature sub)) - - (#$;Generic generic) - (case generic - (#$;Class class params) - (let [=params (if (list;empty? params) - "" - (format "<" - (|> params - (L/map (|>. #$;Generic signature)) - (text;join-with "")) - ">"))] - (format "L" (binary-name class) =params ";")) - - (#$;Var name) - (format "T" name ";") - - (#$;Wildcard #;None) - "*" - - (^template [<tag> <prefix>] - (#$;Wildcard (#;Some [<tag> bound])) - (format <prefix> (signature (#$;Generic bound)))) - ([#$;Upper "+"] - [#$;Lower "-"])) - )) - -## Methods -(def: #export (method args return exceptions) - (-> (List $;Type) (Maybe $;Type) (List $;Generic) $;Method) - {#$;args args #$;return return #$;exceptions exceptions}) - -(def: #export (method-descriptor method) - (-> $;Method Text) - (format "(" (text;join-with "" (L/map descriptor (get@ #$;args method))) ")" - (case (get@ #$;return method) - #;None - "V" - - (#;Some return) - (descriptor return)))) - -(def: #export (method-signature method) - (-> $;Method Text) - (format "(" (|> (get@ #$;args method) (L/map signature) (text;join-with "")) ")" - (case (get@ #$;return method) - #;None - "V" - - (#;Some return) - (signature return)) - (|> (get@ #$;exceptions method) - (L/map (|>. #$;Generic signature (format "^"))) - (text;join-with "")))) diff --git a/new-luxc/source/luxc/generator/primitive.jvm.lux b/new-luxc/source/luxc/generator/primitive.jvm.lux index 571ba4835..2e4eb7ccf 100644 --- a/new-luxc/source/luxc/generator/primitive.jvm.lux +++ b/new-luxc/source/luxc/generator/primitive.jvm.lux @@ -5,14 +5,14 @@ [meta "meta/" Monad<Meta>]) (luxc ["&" base] [";L" host] + (host ["$" jvm] + (jvm ["$i" inst] + ["$t" type])) (lang ["la" analysis] ["ls" synthesis]) ["&;" analyser] ["&;" synthesizer] - (generator ["&;" common] - (host ["$" jvm] - (jvm ["$i" inst] - ["$t" type])))) + (generator ["&;" common])) [../runtime]) (def: #export generate-unit diff --git a/new-luxc/source/luxc/generator/procedure.jvm.lux b/new-luxc/source/luxc/generator/procedure.jvm.lux index cc10e45aa..973f0e968 100644 --- a/new-luxc/source/luxc/generator/procedure.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure.jvm.lux @@ -5,8 +5,8 @@ text/format (coll [dict]))) (luxc ["&" base] - (lang ["ls" synthesis]) - (generator (host ["$" jvm]))) + (host ["$" jvm]) + (lang ["ls" synthesis])) (. ["./;" common] ["./;" host])) diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux index 7ae471c64..d94ded890 100644 --- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux @@ -11,17 +11,17 @@ [host]) (luxc ["&" base] [";L" host] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) (lang ["la" analysis] ["ls" synthesis]) ["&;" analyser] ["&;" synthesizer] (synthesizer [function]) (generator ["&;" common] - ["&;" runtime] - (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst]))))) + ["&;" runtime]))) (host;import java.lang.Long (#static MIN_VALUE Long) diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux index 44da5744d..5fb779d41 100644 --- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux @@ -16,6 +16,10 @@ [host]) (luxc ["&" base] [";L" host] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) (lang ["la" analysis] ["ls" synthesis]) ["&;" analyser] @@ -23,11 +27,7 @@ ["&;" synthesizer] (synthesizer [function]) (generator ["&;" common] - ["&;" runtime] - (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst])))) + ["&;" runtime])) ["@" ../common]) (do-template [<name> <inst>] diff --git a/new-luxc/source/luxc/generator/reference.jvm.lux b/new-luxc/source/luxc/generator/reference.jvm.lux index 0e77b1819..3c8cbc552 100644 --- a/new-luxc/source/luxc/generator/reference.jvm.lux +++ b/new-luxc/source/luxc/generator/reference.jvm.lux @@ -4,12 +4,12 @@ (data text/format) [meta "meta/" Monad<Meta>]) (luxc ["&" base] + (host ["$" jvm] + (jvm ["$t" type] + ["$i" inst])) (lang ["ls" synthesis]) (generator [";G" common] - [";G" function] - (host ["$" jvm] - (jvm ["$t" type] - ["$i" inst]))))) + [";G" function]))) (def: #export (generate-captured variable) (-> ls;Variable (Meta $;Inst)) diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux index d3f99ae6a..c5777b4af 100644 --- a/new-luxc/source/luxc/generator/runtime.jvm.lux +++ b/new-luxc/source/luxc/generator/runtime.jvm.lux @@ -8,15 +8,15 @@ [host]) (luxc ["&" base] [";L" host] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) (lang ["la" analysis] ["ls" synthesis]) ["&;" analyser] ["&;" synthesizer] - (generator ["&;" common] - (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst]))))) + (generator ["&;" common]))) (host;import java.lang.Object) (host;import java.lang.String) diff --git a/new-luxc/source/luxc/generator/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux index 6df522fb8..e91e99fc9 100644 --- a/new-luxc/source/luxc/generator/statement.jvm.lux +++ b/new-luxc/source/luxc/generator/statement.jvm.lux @@ -13,12 +13,12 @@ ["&;" scope] ["&;" module] ["&;" io] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) (generator ["&;" eval] - ["&;" common] - (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst]))))) + ["&;" common]))) (exception: #export Invalid-Definition-Value) diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux index 28196b914..33cc7936c 100644 --- a/new-luxc/source/luxc/generator/structure.jvm.lux +++ b/new-luxc/source/luxc/generator/structure.jvm.lux @@ -7,15 +7,15 @@ [host #+ do-to]) (luxc ["&" base] [";L" host] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])) (lang ["la" analysis] ["ls" synthesis]) ["&;" analyser] ["&;" synthesizer] - (generator ["&;" common] - (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst])))) + (generator ["&;" common])) [../runtime]) (def: $Object $;Type ($t;class "java.lang.Object" (list))) |