From 6c753288a89eadb3f7d70a8844e466c48c809051 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 31 Oct 2017 19:09:47 -0400
Subject: - Moved the "host" directory from under "generator" to under "luxc".
---
new-luxc/source/luxc/generator/case.jvm.lux | 8 +-
new-luxc/source/luxc/generator/common.jvm.lux | 8 +-
new-luxc/source/luxc/generator/eval.jvm.lux | 10 +-
new-luxc/source/luxc/generator/expression.jvm.lux | 4 +-
new-luxc/source/luxc/generator/function.jvm.lux | 10 +-
new-luxc/source/luxc/generator/host/jvm.lux | 130 -------
new-luxc/source/luxc/generator/host/jvm/def.lux | 287 ---------------
new-luxc/source/luxc/generator/host/jvm/inst.lux | 383 ---------------------
new-luxc/source/luxc/generator/host/jvm/type.lux | 138 --------
new-luxc/source/luxc/generator/primitive.jvm.lux | 8 +-
new-luxc/source/luxc/generator/procedure.jvm.lux | 4 +-
.../source/luxc/generator/procedure/common.jvm.lux | 10 +-
.../source/luxc/generator/procedure/host.jvm.lux | 10 +-
new-luxc/source/luxc/generator/reference.jvm.lux | 8 +-
new-luxc/source/luxc/generator/runtime.jvm.lux | 10 +-
new-luxc/source/luxc/generator/statement.jvm.lux | 10 +-
new-luxc/source/luxc/generator/structure.jvm.lux | 10 +-
new-luxc/source/luxc/host/jvm.lux | 130 +++++++
new-luxc/source/luxc/host/jvm/def.lux | 287 +++++++++++++++
new-luxc/source/luxc/host/jvm/inst.lux | 383 +++++++++++++++++++++
new-luxc/source/luxc/host/jvm/type.lux | 138 ++++++++
new-luxc/test/test/luxc/generator/reference.lux | 8 +-
22 files changed, 997 insertions(+), 997 deletions(-)
delete mode 100644 new-luxc/source/luxc/generator/host/jvm.lux
delete mode 100644 new-luxc/source/luxc/generator/host/jvm/def.lux
delete mode 100644 new-luxc/source/luxc/generator/host/jvm/inst.lux
delete mode 100644 new-luxc/source/luxc/generator/host/jvm/type.lux
create mode 100644 new-luxc/source/luxc/host/jvm.lux
create mode 100644 new-luxc/source/luxc/host/jvm/def.lux
create mode 100644 new-luxc/source/luxc/host/jvm/inst.lux
create mode 100644 new-luxc/source/luxc/host/jvm/type.lux
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])
(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/" Monad]
[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]))
- [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]))
- [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 [ ]
- [(def: #export ( 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
-
- (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 [ ]
- [(def: #export ( visibility config name value)
- (-> $;Visibility $;Field-Config Text $;Def)
- (function [writer]
- (let [=field (do-to (ClassWriter.visitField [($_ i.+
- (visibility-flag visibility)
- (field-flags config))
- ($t;binary-name name)
- ($t;descriptor )
- ($t;signature )
- ( 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]))
- [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 [ ]
- [(def: #export ( value)
- (-> $;Inst)
- (function [visitor]
- (do-to visitor
- (MethodVisitor.visitLdcInsn [( 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 []
- [(def: #export
- $;Inst
- (function [visitor]
- (do-to visitor
- (MethodVisitor.visitInsn [(prefix )]))))]
-
- [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 []
- [(def: #export ( register)
- (-> Nat $;Inst)
- (function [visitor]
- (do-to visitor
- (MethodVisitor.visitVarInsn [(prefix ) (nat-to-int register)]))))]
-
- [ILOAD] [LLOAD] [DLOAD] [ALOAD]
- [ISTORE] [LSTORE] [ASTORE]
- )
-
-(do-template [ ]
- [(def: #export ( class field type)
- (-> Text Text $;Type $;Inst)
- (function [visitor]
- (do-to visitor
- (MethodVisitor.visitFieldInsn [ ($t;binary-name class) field ($t;descriptor type)]))))]
-
- [GETSTATIC Opcodes.GETSTATIC]
- [PUTSTATIC Opcodes.PUTSTATIC]
-
- [PUTFIELD Opcodes.PUTFIELD]
- [GETFIELD Opcodes.GETFIELD]
- )
-
-(do-template [ ]
- [(def: #export ( class)
- (-> Text $;Inst)
- (function [visitor]
- (do-to visitor
- (MethodVisitor.visitTypeInsn [ ($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 [ ]
- [(def: #export ( class method-name method-signature interface?)
- (-> Text Text $;Method Bool $;Inst)
- (function [visitor]
- (do-to visitor
- (MethodVisitor.visitMethodInsn [ ($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 []
- [(def: #export ( @where)
- (-> $;Label $;Inst)
- (function [visitor]
- (do-to visitor
- (MethodVisitor.visitJumpInsn [(prefix ) @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])))
- ["$" ..])
-
-## Types
-(do-template [ ]
- [(def: #export $;Type (#$;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 [ ]
- (#$;Wildcard (#;Some [ bound]))
- (format (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])
(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 [ ]
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])
(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)))
diff --git a/new-luxc/source/luxc/host/jvm.lux b/new-luxc/source/luxc/host/jvm.lux
new file mode 100644
index 000000000..24d4a9ea9
--- /dev/null
+++ b/new-luxc/source/luxc/host/jvm.lux
@@ -0,0 +1,130 @@
+(;module:
+ [lux #- Type Def]
+ (lux (control monad
+ ["p" parser])
+ (data (coll [list "list/" Functor]))
+ [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/host/jvm/def.lux b/new-luxc/source/luxc/host/jvm/def.lux
new file mode 100644
index 000000000..1d50ba9f6
--- /dev/null
+++ b/new-luxc/source/luxc/host/jvm/def.lux
@@ -0,0 +1,287 @@
+(;module:
+ lux
+ (lux (data [text]
+ text/format
+ [product]
+ (coll ["a" array]
+ [list "list/" Functor]))
+ [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 [ ]
+ [(def: #export ( 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
+
+ (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 [ ]
+ [(def: #export ( visibility config name value)
+ (-> $;Visibility $;Field-Config Text $;Def)
+ (function [writer]
+ (let [=field (do-to (ClassWriter.visitField [($_ i.+
+ (visibility-flag visibility)
+ (field-flags config))
+ ($t;binary-name name)
+ ($t;descriptor )
+ ($t;signature )
+ ( 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/host/jvm/inst.lux b/new-luxc/source/luxc/host/jvm/inst.lux
new file mode 100644
index 000000000..37ab75020
--- /dev/null
+++ b/new-luxc/source/luxc/host/jvm/inst.lux
@@ -0,0 +1,383 @@
+(;module:
+ [lux #- char]
+ (lux (control monad
+ ["p" parser])
+ (data [maybe]
+ ["e" error]
+ text/format
+ (coll [list "L/" Functor]))
+ [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 [ ]
+ [(def: #export ( value)
+ (-> $;Inst)
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitLdcInsn [( 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 []
+ [(def: #export
+ $;Inst
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitInsn [(prefix )]))))]
+
+ [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 []
+ [(def: #export ( register)
+ (-> Nat $;Inst)
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitVarInsn [(prefix ) (nat-to-int register)]))))]
+
+ [ILOAD] [LLOAD] [DLOAD] [ALOAD]
+ [ISTORE] [LSTORE] [ASTORE]
+ )
+
+(do-template [ ]
+ [(def: #export ( class field type)
+ (-> Text Text $;Type $;Inst)
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitFieldInsn [ ($t;binary-name class) field ($t;descriptor type)]))))]
+
+ [GETSTATIC Opcodes.GETSTATIC]
+ [PUTSTATIC Opcodes.PUTSTATIC]
+
+ [PUTFIELD Opcodes.PUTFIELD]
+ [GETFIELD Opcodes.GETFIELD]
+ )
+
+(do-template [ ]
+ [(def: #export ( class)
+ (-> Text $;Inst)
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitTypeInsn [ ($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 [ ]
+ [(def: #export ( class method-name method-signature interface?)
+ (-> Text Text $;Method Bool $;Inst)
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitMethodInsn [ ($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 []
+ [(def: #export ( @where)
+ (-> $;Label $;Inst)
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitJumpInsn [(prefix ) @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/host/jvm/type.lux b/new-luxc/source/luxc/host/jvm/type.lux
new file mode 100644
index 000000000..3825d443b
--- /dev/null
+++ b/new-luxc/source/luxc/host/jvm/type.lux
@@ -0,0 +1,138 @@
+(;module:
+ [lux #- char]
+ (lux (data [text]
+ text/format
+ (coll [list "L/" Functor])))
+ ["$" ..])
+
+## Types
+(do-template [ ]
+ [(def: #export $;Type (#$;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 [ ]
+ (#$;Wildcard (#;Some [ bound]))
+ (format (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/test/test/luxc/generator/reference.lux b/new-luxc/test/test/luxc/generator/reference.lux
index 9df6d8b10..a8bed89e1 100644
--- a/new-luxc/test/test/luxc/generator/reference.lux
+++ b/new-luxc/test/test/luxc/generator/reference.lux
@@ -8,15 +8,15 @@
[meta]
(meta [code])
test)
- (luxc (lang ["ls" synthesis])
+ (luxc (host ["$" jvm]
+ (jvm ["$i" inst]))
+ (lang ["ls" synthesis])
["_;" module]
(generator [";G" statement]
[";G" eval]
[";G" expression]
[";G" case]
- [";G" runtime]
- (host ["$" jvm]
- (jvm ["$i" inst]))))
+ [";G" runtime]))
(test/luxc common))
(def: nilI $;Inst runtimeG;noneI)
--
cgit v1.2.3