aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host.jvm.lux19
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux2
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux126
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/type.lux134
4 files changed, 141 insertions, 140 deletions
diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux
index 01afaeccc..ba617aa42 100644
--- a/new-luxc/source/luxc/lang/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/host.jvm.lux
@@ -11,10 +11,11 @@
[array]))
[macro]
[host #+ do-to object]
- [io])
- (luxc ["&" lang]
- (lang [".L" variable #+ Register]
- (translation (jvm [".T" common])))))
+ [io]
+ ["//" lang]
+ (lang ["//." reference #+ Register]))
+ (luxc [lang]
+ (lang (translation (jvm [".T" common])))))
(host.import org/objectweb/asm/Label)
@@ -57,7 +58,7 @@
(array.from-list (list (:! Object class-name)
(:! Object byte-code)
(:! Object (host.long-to-int 0))
- (:! Object (host.long-to-int (nat-to-int (host.array-length byte-code))))))]
+ (:! Object (host.long-to-int (.int (host.array-length byte-code))))))]
ClassLoader::defineClass))
(def: (fetch-byte-code class-name store)
@@ -122,14 +123,14 @@
anchor])
#.None
- ((&.throw No-Anchor "") compiler))))
+ ((//.throw No-Anchor "") compiler))))
(def: #export (with-context name expr)
(All [a] (-> Text (Meta a) (Meta a)))
(.function (_ compiler)
(let [old (:! commonT.Host (get@ #.host compiler))]
(case (expr (set@ #.host
- (:! Nothing (set@ #commonT.context [(&.normalize-name name) +0] old))
+ (:! Nothing (set@ #commonT.context [(lang.normalize-name name) +0] old))
compiler))
(#e.Success [compiler' output])
(#e.Success [(update@ #.host
@@ -147,14 +148,14 @@
(.function (_ compiler)
(let [old (:! commonT.Host (get@ #.host compiler))
[old-name old-sub] (get@ #commonT.context old)
- new-name (format old-name "$" (%i (nat-to-int old-sub)))]
+ new-name (format old-name "$" (%i (.int old-sub)))]
(case (expr (set@ #.host
(:! Nothing (set@ #commonT.context [new-name +0] old))
compiler))
(#e.Success [compiler' output])
(#e.Success [(update@ #.host
(|>> (:! commonT.Host)
- (set@ #commonT.context [old-name (n/inc old-sub)])
+ (set@ #commonT.context [old-name (inc old-sub)])
(:! Nothing))
compiler')
[new-name output]])
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index 4cb7aba3e..86f7999ba 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -272,7 +272,7 @@
[long-field Int $t.long id]
[float-field Frac $t.float host.double-to-float]
[double-field Frac $t.double id]
- [char-field Nat $t.char (|>> nat-to-int host.long-to-int host.int-to-char)]
+ [char-field Nat $t.char (|>> .int host.long-to-int host.int-to-char)]
[string-field Text ($t.class "java.lang.String" (list)) id]
)
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index d088c5324..671a2bb3c 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #- char]
+ [lux #- int char]
(lux (control monad
["p" parser])
(data [maybe]
@@ -11,8 +11,8 @@
(macro [code]
["s" syntax #+ syntax:])
[function])
- ["$" //]
- (// ["$t" type]))
+ [//]
+ [//type])
## [Host]
(host.import #long java/lang/Object)
@@ -117,12 +117,12 @@
(#e.Success [compiler (Label::new [])])))
(def: #export (with-label action)
- (-> (-> Label $.Inst) $.Inst)
+ (-> (-> Label //.Inst) //.Inst)
(action (Label::new [])))
(do-template [<name> <type> <prepare>]
[(def: #export (<name> value)
- (-> <type> $.Inst)
+ (-> <type> //.Inst)
(function (_ visitor)
(do-to visitor
(MethodVisitor::visitLdcInsn [(<prepare> value)]))))]
@@ -131,7 +131,7 @@
[int Int host.long-to-int]
[long Int id]
[double Frac id]
- [char Nat (|>> nat-to-int host.long-to-int host.int-to-char)]
+ [char Nat (|>> .int host.long-to-int host.int-to-char)]
[string Text id]
)
@@ -139,14 +139,14 @@
(wrap (list (code.local-symbol (format "Opcodes::" base)))))
(def: #export NULL
- $.Inst
+ //.Inst
(function (_ visitor)
(do-to visitor
(MethodVisitor::visitInsn [(prefix ACONST_NULL)]))))
(do-template [<name>]
[(def: #export <name>
- $.Inst
+ //.Inst
(function (_ visitor)
(do-to visitor
(MethodVisitor::visitInsn [(prefix <name>)]))))]
@@ -207,10 +207,10 @@
(do-template [<name>]
[(def: #export (<name> register)
- (-> Nat $.Inst)
+ (-> Nat //.Inst)
(function (_ visitor)
(do-to visitor
- (MethodVisitor::visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
+ (MethodVisitor::visitVarInsn [(prefix <name>) (.int register)]))))]
[ILOAD] [LLOAD] [DLOAD] [ALOAD]
[ISTORE] [LSTORE] [ASTORE]
@@ -218,10 +218,10 @@
(do-template [<name> <inst>]
[(def: #export (<name> class field type)
- (-> Text Text $.Type $.Inst)
+ (-> Text Text //.Type //.Inst)
(function (_ visitor)
(do-to visitor
- (MethodVisitor::visitFieldInsn [<inst> ($t.binary-name class) field ($t.descriptor type)]))))]
+ (MethodVisitor::visitFieldInsn [<inst> (//type.binary-name class) field (//type.descriptor type)]))))]
[GETSTATIC Opcodes::GETSTATIC]
[PUTSTATIC Opcodes::PUTSTATIC]
@@ -232,10 +232,10 @@
(do-template [<name> <inst>]
[(def: #export (<name> class)
- (-> Text $.Inst)
+ (-> Text //.Inst)
(function (_ visitor)
(do-to visitor
- (MethodVisitor::visitTypeInsn [<inst> ($t.binary-name class)]))))]
+ (MethodVisitor::visitTypeInsn [<inst> (//type.binary-name class)]))))]
[CHECKCAST Opcodes::CHECKCAST]
[NEW Opcodes::NEW]
@@ -244,25 +244,25 @@
)
(def: #export (NEWARRAY type)
- (-> $.Primitive $.Inst)
+ (-> //.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)]))))
+ #//.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)
+ (-> 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?]))))]
+ (MethodVisitor::visitMethodInsn [<inst> (//type.binary-name class) method-name (//type.method-descriptor method-signature) interface?]))))]
[INVOKESTATIC Opcodes::INVOKESTATIC]
[INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL]
@@ -272,7 +272,7 @@
(do-template [<name>]
[(def: #export (<name> @where)
- (-> $.Label $.Inst)
+ (-> //.Label //.Inst)
(function (_ visitor)
(do-to visitor
(MethodVisitor::visitJumpInsn [(prefix <name>) @where]))))]
@@ -283,7 +283,7 @@
)
(def: #export (TABLESWITCH min max default labels)
- (-> Int Int $.Label (List $.Label) $.Inst)
+ (-> Int Int //.Label (List //.Label) //.Inst)
(function (_ visitor)
(let [num-labels (list.size labels)
labels-array (host.array Label num-labels)
@@ -292,84 +292,84 @@
(exec (host.array-write idx
(maybe.assume (list.nth idx labels))
labels-array)
- (recur (n/inc idx)))
+ (recur (inc idx)))
[]))]
(do-to visitor
(MethodVisitor::visitTableSwitchInsn [min max default labels-array])))))
(def: #export (try @from @to @handler exception)
- (-> $.Label $.Label $.Label Text $.Inst)
+ (-> //.Label //.Label //.Label Text //.Inst)
(function (_ visitor)
(do-to visitor
- (MethodVisitor::visitTryCatchBlock [@from @to @handler ($t.binary-name exception)]))))
+ (MethodVisitor::visitTryCatchBlock [@from @to @handler (//type.binary-name exception)]))))
(def: #export (label @label)
- (-> $.Label $.Inst)
+ (-> //.Label //.Inst)
(function (_ visitor)
(do-to visitor
(MethodVisitor::visitLabel [@label]))))
(def: #export (array type)
- (-> $.Type $.Inst)
+ (-> //.Type //.Inst)
(case type
- (#$.Primitive prim)
+ (#//.Primitive prim)
(NEWARRAY prim)
- (#$.Generic generic)
+ (#//.Generic generic)
(let [elem-class (case generic
- (#$.Class class params)
- ($t.binary-name class)
+ (#//.Class class params)
+ (//type.binary-name class)
_
- ($t.binary-name "java.lang.Object"))]
+ (//type.binary-name "java.lang.Object"))]
(ANEWARRAY elem-class))
_
- (ANEWARRAY ($t.descriptor type))))
+ (ANEWARRAY (//type.descriptor type))))
(def: (primitive-wrapper type)
- (-> $.Primitive Text)
+ (-> //.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"))
+ #//.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)
+ (-> //.Primitive Text)
(case type
- #$.Boolean "booleanValue"
- #$.Byte "byteValue"
- #$.Short "shortValue"
- #$.Int "intValue"
- #$.Long "longValue"
- #$.Float "floatValue"
- #$.Double "doubleValue"
- #$.Char "charValue"))
+ #//.Boolean "booleanValue"
+ #//.Byte "byteValue"
+ #//.Short "shortValue"
+ #//.Int "intValue"
+ #//.Long "longValue"
+ #//.Float "floatValue"
+ #//.Double "doubleValue"
+ #//.Char "charValue"))
(def: #export (wrap type)
- (-> $.Primitive $.Inst)
+ (-> //.Primitive //.Inst)
(let [class (primitive-wrapper type)]
(|>> (INVOKESTATIC class "valueOf"
- ($t.method (list (#$.Primitive type))
- (#.Some ($t.class class (list)))
- (list))
+ (//type.method (list (#//.Primitive type))
+ (#.Some (//type.class class (list)))
+ (list))
false))))
(def: #export (unwrap type)
- (-> $.Primitive $.Inst)
+ (-> //.Primitive //.Inst)
(let [class (primitive-wrapper type)]
(|>> (CHECKCAST class)
(INVOKEVIRTUAL class (primitive-unwrap type)
- ($t.method (list) (#.Some (#$.Primitive type)) (list))
+ (//type.method (list) (#.Some (#//.Primitive type)) (list))
false))))
(def: #export (fuse insts)
- (-> (List $.Inst) $.Inst)
+ (-> (List //.Inst) //.Inst)
(case insts
#.Nil
id
diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux
index b29ffc4a0..0c36e6799 100644
--- a/new-luxc/source/luxc/lang/host/jvm/type.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/type.lux
@@ -1,123 +1,123 @@
(.module:
- [lux #- char]
+ [lux #- int char]
(lux (data [text]
text/format
(coll [list "list/" 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 <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)))
+ (-> Text (List //.Generic) //.Type)
+ (#//.Generic (#//.Class name params)))
(def: #export (var name)
- (-> Text $.Type)
- (#$.Generic (#$.Var name)))
+ (-> Text //.Type)
+ (#//.Generic (#//.Var name)))
(def: #export (wildcard bound)
- (-> (Maybe [$.Bound $.Generic]) $.Type)
- (#$.Generic (#$.Wildcard bound)))
+ (-> (Maybe [//.Bound //.Generic]) //.Type)
+ (#//.Generic (#//.Wildcard bound)))
(def: #export (array depth elemT)
- (-> Nat $.Type $.Type)
+ (-> Nat //.Type //.Type)
(case depth
+0 elemT
- _ (#$.Array (array (n/dec depth) elemT))))
+ _ (#//.Array (array (dec depth) elemT))))
(def: #export (binary-name class)
(-> Text Text)
(text.replace-all "." "/" class))
(def: #export (descriptor type)
- (-> $.Type Text)
+ (-> //.Type Text)
(case type
- (#$.Primitive prim)
+ (#//.Primitive prim)
(case prim
- #$.Boolean "Z"
- #$.Byte "B"
- #$.Short "S"
- #$.Int "I"
- #$.Long "J"
- #$.Float "F"
- #$.Double "D"
- #$.Char "C")
-
- (#$.Array sub)
+ #//.Boolean "Z"
+ #//.Byte "B"
+ #//.Short "S"
+ #//.Int "I"
+ #//.Long "J"
+ #//.Float "F"
+ #//.Double "D"
+ #//.Char "C")
+
+ (#//.Array sub)
(format "[" (descriptor sub))
- (#$.Generic generic)
+ (#//.Generic generic)
(case generic
- (#$.Class class params)
+ (#//.Class class params)
(format "L" (binary-name class) ";")
- (^or (#$.Var name) (#$.Wildcard ?bound))
- (descriptor (#$.Generic (#$.Class "java.lang.Object" (list)))))
+ (^or (#//.Var name) (#//.Wildcard ?bound))
+ (descriptor (#//.Generic (#//.Class "java.lang.Object" (list)))))
))
(def: #export (signature type)
- (-> $.Type Text)
+ (-> //.Type Text)
(case type
- (#$.Primitive prim)
+ (#//.Primitive prim)
(case prim
- #$.Boolean "Z"
- #$.Byte "B"
- #$.Short "S"
- #$.Int "I"
- #$.Long "J"
- #$.Float "F"
- #$.Double "D"
- #$.Char "C")
-
- (#$.Array sub)
+ #//.Boolean "Z"
+ #//.Byte "B"
+ #//.Short "S"
+ #//.Int "I"
+ #//.Long "J"
+ #//.Float "F"
+ #//.Double "D"
+ #//.Char "C")
+
+ (#//.Array sub)
(format "[" (signature sub))
- (#$.Generic generic)
+ (#//.Generic generic)
(case generic
- (#$.Class class params)
+ (#//.Class class params)
(let [=params (if (list.empty? params)
""
(format "<"
(|> params
- (list/map (|>> #$.Generic signature))
+ (list/map (|>> #//.Generic signature))
(text.join-with ""))
">"))]
(format "L" (binary-name class) =params ";"))
- (#$.Var name)
+ (#//.Var name)
(format "T" name ";")
- (#$.Wildcard #.None)
+ (#//.Wildcard #.None)
"*"
(^template [<tag> <prefix>]
- (#$.Wildcard (#.Some [<tag> bound]))
- (format <prefix> (signature (#$.Generic bound))))
- ([#$.Upper "+"]
- [#$.Lower "-"]))
+ (#//.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})
+ (-> (List //.Type) (Maybe //.Type) (List //.Generic) //.Method)
+ {#//.args args #//.return return #//.exceptions exceptions})
(def: #export (method-descriptor method)
- (-> $.Method Text)
- (format "(" (text.join-with "" (list/map descriptor (get@ #$.args method))) ")"
- (case (get@ #$.return method)
+ (-> //.Method Text)
+ (format "(" (text.join-with "" (list/map descriptor (get@ #//.args method))) ")"
+ (case (get@ #//.return method)
#.None
"V"
@@ -125,14 +125,14 @@
(descriptor return))))
(def: #export (method-signature method)
- (-> $.Method Text)
- (format "(" (|> (get@ #$.args method) (list/map signature) (text.join-with "")) ")"
- (case (get@ #$.return method)
+ (-> //.Method Text)
+ (format "(" (|> (get@ #//.args method) (list/map signature) (text.join-with "")) ")"
+ (case (get@ #//.return method)
#.None
"V"
(#.Some return)
(signature return))
- (|> (get@ #$.exceptions method)
- (list/map (|>> #$.Generic signature (format "^")))
+ (|> (get@ #//.exceptions method)
+ (list/map (|>> #//.Generic signature (format "^")))
(text.join-with ""))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 22:02:58 +0000