aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux1012
1 files changed, 506 insertions, 506 deletions
diff --git a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
index 2aa693d2c..f2f88904d 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["p" parser "parser/" Monad<Parser>]
@@ -15,13 +15,13 @@
["s" syntax #+ syntax:])
[host])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
["la" analysis]
- (analysis (procedure ["&;" host]))
+ (analysis (procedure ["&." host]))
["ls" synthesis]))
["@" //common])
@@ -30,732 +30,732 @@
(do-template [<name> <inst>]
[(def: <name>
- $;Inst
+ $.Inst
<inst>)]
- [L2S (|>. $i;L2I $i;I2S)]
- [L2B (|>. $i;L2I $i;I2B)]
- [L2C (|>. $i;L2I $i;I2C)]
+ [L2S (|>> $i.L2I $i.I2S)]
+ [L2B (|>> $i.L2I $i.I2B)]
+ [L2C (|>> $i.L2I $i.I2C)]
)
(do-template [<name> <unwrap> <conversion> <wrap>]
[(def: (<name> inputI)
- @;Unary
- (if (is $i;NOP <conversion>)
- (|>. inputI
- ($i;unwrap <unwrap>)
- ($i;wrap <wrap>))
- (|>. inputI
- ($i;unwrap <unwrap>)
+ @.Unary
+ (if (is $i.NOP <conversion>)
+ (|>> inputI
+ ($i.unwrap <unwrap>)
+ ($i.wrap <wrap>))
+ (|>> inputI
+ ($i.unwrap <unwrap>)
<conversion>
- ($i;wrap <wrap>))))]
+ ($i.wrap <wrap>))))]
- [convert//double-to-float #$;Double $i;D2F #$;Float]
- [convert//double-to-int #$;Double $i;D2I #$;Int]
- [convert//double-to-long #$;Double $i;D2L #$;Long]
- [convert//float-to-double #$;Float $i;F2D #$;Double]
- [convert//float-to-int #$;Float $i;F2I #$;Int]
- [convert//float-to-long #$;Float $i;F2L #$;Long]
- [convert//int-to-byte #$;Int $i;I2B #$;Byte]
- [convert//int-to-char #$;Int $i;I2C #$;Char]
- [convert//int-to-double #$;Int $i;I2D #$;Double]
- [convert//int-to-float #$;Int $i;I2F #$;Float]
- [convert//int-to-long #$;Int $i;I2L #$;Long]
- [convert//int-to-short #$;Int $i;I2S #$;Short]
- [convert//long-to-double #$;Long $i;L2D #$;Double]
- [convert//long-to-float #$;Long $i;L2F #$;Float]
- [convert//long-to-int #$;Long $i;L2I #$;Int]
- [convert//long-to-short #$;Long L2S #$;Short]
- [convert//long-to-byte #$;Long L2B #$;Byte]
- [convert//long-to-char #$;Long L2C #$;Char]
- [convert//char-to-byte #$;Char $i;I2B #$;Byte]
- [convert//char-to-short #$;Char $i;I2S #$;Short]
- [convert//char-to-int #$;Char $i;NOP #$;Int]
- [convert//char-to-long #$;Char $i;I2L #$;Long]
- [convert//byte-to-long #$;Byte $i;I2L #$;Long]
- [convert//short-to-long #$;Short $i;I2L #$;Long]
+ [convert//double-to-float #$.Double $i.D2F #$.Float]
+ [convert//double-to-int #$.Double $i.D2I #$.Int]
+ [convert//double-to-long #$.Double $i.D2L #$.Long]
+ [convert//float-to-double #$.Float $i.F2D #$.Double]
+ [convert//float-to-int #$.Float $i.F2I #$.Int]
+ [convert//float-to-long #$.Float $i.F2L #$.Long]
+ [convert//int-to-byte #$.Int $i.I2B #$.Byte]
+ [convert//int-to-char #$.Int $i.I2C #$.Char]
+ [convert//int-to-double #$.Int $i.I2D #$.Double]
+ [convert//int-to-float #$.Int $i.I2F #$.Float]
+ [convert//int-to-long #$.Int $i.I2L #$.Long]
+ [convert//int-to-short #$.Int $i.I2S #$.Short]
+ [convert//long-to-double #$.Long $i.L2D #$.Double]
+ [convert//long-to-float #$.Long $i.L2F #$.Float]
+ [convert//long-to-int #$.Long $i.L2I #$.Int]
+ [convert//long-to-short #$.Long L2S #$.Short]
+ [convert//long-to-byte #$.Long L2B #$.Byte]
+ [convert//long-to-char #$.Long L2C #$.Char]
+ [convert//char-to-byte #$.Char $i.I2B #$.Byte]
+ [convert//char-to-short #$.Char $i.I2S #$.Short]
+ [convert//char-to-int #$.Char $i.NOP #$.Int]
+ [convert//char-to-long #$.Char $i.I2L #$.Long]
+ [convert//byte-to-long #$.Byte $i.I2L #$.Long]
+ [convert//short-to-long #$.Short $i.I2L #$.Long]
)
(def: conversion-procs
- @;Bundle
- (<| (@;prefix "convert")
- (|> (dict;new text;Hash<Text>)
- (@;install "double-to-float" (@;unary convert//double-to-float))
- (@;install "double-to-int" (@;unary convert//double-to-int))
- (@;install "double-to-long" (@;unary convert//double-to-long))
- (@;install "float-to-double" (@;unary convert//float-to-double))
- (@;install "float-to-int" (@;unary convert//float-to-int))
- (@;install "float-to-long" (@;unary convert//float-to-long))
- (@;install "int-to-byte" (@;unary convert//int-to-byte))
- (@;install "int-to-char" (@;unary convert//int-to-char))
- (@;install "int-to-double" (@;unary convert//int-to-double))
- (@;install "int-to-float" (@;unary convert//int-to-float))
- (@;install "int-to-long" (@;unary convert//int-to-long))
- (@;install "int-to-short" (@;unary convert//int-to-short))
- (@;install "long-to-double" (@;unary convert//long-to-double))
- (@;install "long-to-float" (@;unary convert//long-to-float))
- (@;install "long-to-int" (@;unary convert//long-to-int))
- (@;install "long-to-short" (@;unary convert//long-to-short))
- (@;install "long-to-byte" (@;unary convert//long-to-byte))
- (@;install "long-to-char" (@;unary convert//long-to-char))
- (@;install "char-to-byte" (@;unary convert//char-to-byte))
- (@;install "char-to-short" (@;unary convert//char-to-short))
- (@;install "char-to-int" (@;unary convert//char-to-int))
- (@;install "char-to-long" (@;unary convert//char-to-long))
- (@;install "byte-to-long" (@;unary convert//byte-to-long))
- (@;install "short-to-long" (@;unary convert//short-to-long))
+ @.Bundle
+ (<| (@.prefix "convert")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "double-to-float" (@.unary convert//double-to-float))
+ (@.install "double-to-int" (@.unary convert//double-to-int))
+ (@.install "double-to-long" (@.unary convert//double-to-long))
+ (@.install "float-to-double" (@.unary convert//float-to-double))
+ (@.install "float-to-int" (@.unary convert//float-to-int))
+ (@.install "float-to-long" (@.unary convert//float-to-long))
+ (@.install "int-to-byte" (@.unary convert//int-to-byte))
+ (@.install "int-to-char" (@.unary convert//int-to-char))
+ (@.install "int-to-double" (@.unary convert//int-to-double))
+ (@.install "int-to-float" (@.unary convert//int-to-float))
+ (@.install "int-to-long" (@.unary convert//int-to-long))
+ (@.install "int-to-short" (@.unary convert//int-to-short))
+ (@.install "long-to-double" (@.unary convert//long-to-double))
+ (@.install "long-to-float" (@.unary convert//long-to-float))
+ (@.install "long-to-int" (@.unary convert//long-to-int))
+ (@.install "long-to-short" (@.unary convert//long-to-short))
+ (@.install "long-to-byte" (@.unary convert//long-to-byte))
+ (@.install "long-to-char" (@.unary convert//long-to-char))
+ (@.install "char-to-byte" (@.unary convert//char-to-byte))
+ (@.install "char-to-short" (@.unary convert//char-to-short))
+ (@.install "char-to-int" (@.unary convert//char-to-int))
+ (@.install "char-to-long" (@.unary convert//char-to-long))
+ (@.install "byte-to-long" (@.unary convert//byte-to-long))
+ (@.install "short-to-long" (@.unary convert//short-to-long))
)))
(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>]
[(def: (<name> [xI yI])
- @;Binary
- (|>. xI ($i;unwrap <unwrapX>)
- yI ($i;unwrap <unwrapY>)
- <op> ($i;wrap <wrap>)))]
-
- [int//+ $i;IADD #$;Int #$;Int #$;Int]
- [int//- $i;ISUB #$;Int #$;Int #$;Int]
- [int//* $i;IMUL #$;Int #$;Int #$;Int]
- [int/// $i;IDIV #$;Int #$;Int #$;Int]
- [int//% $i;IREM #$;Int #$;Int #$;Int]
- [int//and $i;IAND #$;Int #$;Int #$;Int]
- [int//or $i;IOR #$;Int #$;Int #$;Int]
- [int//xor $i;IXOR #$;Int #$;Int #$;Int]
- [int//shl $i;ISHL #$;Int #$;Int #$;Int]
- [int//shr $i;ISHR #$;Int #$;Int #$;Int]
- [int//ushr $i;IUSHR #$;Int #$;Int #$;Int]
+ @.Binary
+ (|>> xI ($i.unwrap <unwrapX>)
+ yI ($i.unwrap <unwrapY>)
+ <op> ($i.wrap <wrap>)))]
+
+ [int//+ $i.IADD #$.Int #$.Int #$.Int]
+ [int//- $i.ISUB #$.Int #$.Int #$.Int]
+ [int//* $i.IMUL #$.Int #$.Int #$.Int]
+ [int/// $i.IDIV #$.Int #$.Int #$.Int]
+ [int//% $i.IREM #$.Int #$.Int #$.Int]
+ [int//and $i.IAND #$.Int #$.Int #$.Int]
+ [int//or $i.IOR #$.Int #$.Int #$.Int]
+ [int//xor $i.IXOR #$.Int #$.Int #$.Int]
+ [int//shl $i.ISHL #$.Int #$.Int #$.Int]
+ [int//shr $i.ISHR #$.Int #$.Int #$.Int]
+ [int//ushr $i.IUSHR #$.Int #$.Int #$.Int]
- [long//+ $i;LADD #$;Long #$;Long #$;Long]
- [long//- $i;LSUB #$;Long #$;Long #$;Long]
- [long//* $i;LMUL #$;Long #$;Long #$;Long]
- [long/// $i;LDIV #$;Long #$;Long #$;Long]
- [long//% $i;LREM #$;Long #$;Long #$;Long]
- [long//and $i;LAND #$;Long #$;Long #$;Long]
- [long//or $i;LOR #$;Long #$;Long #$;Long]
- [long//xor $i;LXOR #$;Long #$;Long #$;Long]
- [long//shl $i;LSHL #$;Long #$;Int #$;Long]
- [long//shr $i;LSHR #$;Long #$;Int #$;Long]
- [long//ushr $i;LUSHR #$;Long #$;Int #$;Long]
-
- [float//+ $i;FADD #$;Float #$;Float #$;Float]
- [float//- $i;FSUB #$;Float #$;Float #$;Float]
- [float//* $i;FMUL #$;Float #$;Float #$;Float]
- [float/// $i;FDIV #$;Float #$;Float #$;Float]
- [float//% $i;FREM #$;Float #$;Float #$;Float]
+ [long//+ $i.LADD #$.Long #$.Long #$.Long]
+ [long//- $i.LSUB #$.Long #$.Long #$.Long]
+ [long//* $i.LMUL #$.Long #$.Long #$.Long]
+ [long/// $i.LDIV #$.Long #$.Long #$.Long]
+ [long//% $i.LREM #$.Long #$.Long #$.Long]
+ [long//and $i.LAND #$.Long #$.Long #$.Long]
+ [long//or $i.LOR #$.Long #$.Long #$.Long]
+ [long//xor $i.LXOR #$.Long #$.Long #$.Long]
+ [long//shl $i.LSHL #$.Long #$.Int #$.Long]
+ [long//shr $i.LSHR #$.Long #$.Int #$.Long]
+ [long//ushr $i.LUSHR #$.Long #$.Int #$.Long]
+
+ [float//+ $i.FADD #$.Float #$.Float #$.Float]
+ [float//- $i.FSUB #$.Float #$.Float #$.Float]
+ [float//* $i.FMUL #$.Float #$.Float #$.Float]
+ [float/// $i.FDIV #$.Float #$.Float #$.Float]
+ [float//% $i.FREM #$.Float #$.Float #$.Float]
- [double//+ $i;DADD #$;Double #$;Double #$;Double]
- [double//- $i;DSUB #$;Double #$;Double #$;Double]
- [double//* $i;DMUL #$;Double #$;Double #$;Double]
- [double/// $i;DDIV #$;Double #$;Double #$;Double]
- [double//% $i;DREM #$;Double #$;Double #$;Double]
+ [double//+ $i.DADD #$.Double #$.Double #$.Double]
+ [double//- $i.DSUB #$.Double #$.Double #$.Double]
+ [double//* $i.DMUL #$.Double #$.Double #$.Double]
+ [double/// $i.DDIV #$.Double #$.Double #$.Double]
+ [double//% $i.DREM #$.Double #$.Double #$.Double]
)
(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>]
[(def: (<name> [xI yI])
- @;Binary
- (<| $i;with-label (function [@then])
- $i;with-label (function [@end])
- (|>. xI ($i;unwrap <unwrapX>)
- yI ($i;unwrap <unwrapY>)
+ @.Binary
+ (<| $i.with-label (function [@then])
+ $i.with-label (function [@end])
+ (|>> xI ($i.unwrap <unwrapX>)
+ yI ($i.unwrap <unwrapY>)
(<op> @then)
- ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
- ($i;GOTO @end)
- ($i;label @then)
- ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
- ($i;label @end))))]
+ ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+ ($i.GOTO @end)
+ ($i.label @then)
+ ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+ ($i.label @end))))]
- [int//= $i;IF_ICMPEQ #$;Int #$;Int #$;Boolean]
- [int//< $i;IF_ICMPLT #$;Int #$;Int #$;Boolean]
+ [int//= $i.IF_ICMPEQ #$.Int #$.Int #$.Boolean]
+ [int//< $i.IF_ICMPLT #$.Int #$.Int #$.Boolean]
- [char//= $i;IF_ICMPEQ #$;Char #$;Char #$;Boolean]
- [char//< $i;IF_ICMPLT #$;Char #$;Char #$;Boolean]
+ [char//= $i.IF_ICMPEQ #$.Char #$.Char #$.Boolean]
+ [char//< $i.IF_ICMPLT #$.Char #$.Char #$.Boolean]
)
(do-template [<name> <op> <reference> <unwrapX> <unwrapY> <wrap>]
[(def: (<name> [xI yI])
- @;Binary
- (<| $i;with-label (function [@then])
- $i;with-label (function [@end])
- (|>. xI ($i;unwrap <unwrapX>)
- yI ($i;unwrap <unwrapY>)
+ @.Binary
+ (<| $i.with-label (function [@then])
+ $i.with-label (function [@end])
+ (|>> xI ($i.unwrap <unwrapX>)
+ yI ($i.unwrap <unwrapY>)
<op>
- ($i;int <reference>)
- ($i;IF_ICMPEQ @then)
- ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
- ($i;GOTO @end)
- ($i;label @then)
- ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
- ($i;label @end))))]
-
- [long//= $i;LCMP 0 #$;Long #$;Long #$;Boolean]
- [long//< $i;LCMP -1 #$;Long #$;Long #$;Boolean]
+ ($i.int <reference>)
+ ($i.IF_ICMPEQ @then)
+ ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+ ($i.GOTO @end)
+ ($i.label @then)
+ ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+ ($i.label @end))))]
+
+ [long//= $i.LCMP 0 #$.Long #$.Long #$.Boolean]
+ [long//< $i.LCMP -1 #$.Long #$.Long #$.Boolean]
- [float//= $i;FCMPG 0 #$;Float #$;Float #$;Boolean]
- [float//< $i;FCMPG -1 #$;Float #$;Float #$;Boolean]
+ [float//= $i.FCMPG 0 #$.Float #$.Float #$.Boolean]
+ [float//< $i.FCMPG -1 #$.Float #$.Float #$.Boolean]
- [double//= $i;DCMPG 0 #$;Double #$;Double #$;Boolean]
- [double//< $i;DCMPG -1 #$;Double #$;Double #$;Boolean]
+ [double//= $i.DCMPG 0 #$.Double #$.Double #$.Boolean]
+ [double//< $i.DCMPG -1 #$.Double #$.Double #$.Boolean]
)
(def: int-procs
- @;Bundle
- (<| (@;prefix "int")
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary int//+))
- (@;install "-" (@;binary int//-))
- (@;install "*" (@;binary int//*))
- (@;install "/" (@;binary int///))
- (@;install "%" (@;binary int//%))
- (@;install "=" (@;binary int//=))
- (@;install "<" (@;binary int//<))
- (@;install "and" (@;binary int//and))
- (@;install "or" (@;binary int//or))
- (@;install "xor" (@;binary int//xor))
- (@;install "shl" (@;binary int//shl))
- (@;install "shr" (@;binary int//shr))
- (@;install "ushr" (@;binary int//ushr))
+ @.Bundle
+ (<| (@.prefix "int")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary int//+))
+ (@.install "-" (@.binary int//-))
+ (@.install "*" (@.binary int//*))
+ (@.install "/" (@.binary int///))
+ (@.install "%" (@.binary int//%))
+ (@.install "=" (@.binary int//=))
+ (@.install "<" (@.binary int//<))
+ (@.install "and" (@.binary int//and))
+ (@.install "or" (@.binary int//or))
+ (@.install "xor" (@.binary int//xor))
+ (@.install "shl" (@.binary int//shl))
+ (@.install "shr" (@.binary int//shr))
+ (@.install "ushr" (@.binary int//ushr))
)))
(def: long-procs
- @;Bundle
- (<| (@;prefix "long")
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary long//+))
- (@;install "-" (@;binary long//-))
- (@;install "*" (@;binary long//*))
- (@;install "/" (@;binary long///))
- (@;install "%" (@;binary long//%))
- (@;install "=" (@;binary long//=))
- (@;install "<" (@;binary long//<))
- (@;install "and" (@;binary long//and))
- (@;install "or" (@;binary long//or))
- (@;install "xor" (@;binary long//xor))
- (@;install "shl" (@;binary long//shl))
- (@;install "shr" (@;binary long//shr))
- (@;install "ushr" (@;binary long//ushr))
+ @.Bundle
+ (<| (@.prefix "long")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary long//+))
+ (@.install "-" (@.binary long//-))
+ (@.install "*" (@.binary long//*))
+ (@.install "/" (@.binary long///))
+ (@.install "%" (@.binary long//%))
+ (@.install "=" (@.binary long//=))
+ (@.install "<" (@.binary long//<))
+ (@.install "and" (@.binary long//and))
+ (@.install "or" (@.binary long//or))
+ (@.install "xor" (@.binary long//xor))
+ (@.install "shl" (@.binary long//shl))
+ (@.install "shr" (@.binary long//shr))
+ (@.install "ushr" (@.binary long//ushr))
)))
(def: float-procs
- @;Bundle
- (<| (@;prefix "float")
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary float//+))
- (@;install "-" (@;binary float//-))
- (@;install "*" (@;binary float//*))
- (@;install "/" (@;binary float///))
- (@;install "%" (@;binary float//%))
- (@;install "=" (@;binary float//=))
- (@;install "<" (@;binary float//<))
+ @.Bundle
+ (<| (@.prefix "float")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary float//+))
+ (@.install "-" (@.binary float//-))
+ (@.install "*" (@.binary float//*))
+ (@.install "/" (@.binary float///))
+ (@.install "%" (@.binary float//%))
+ (@.install "=" (@.binary float//=))
+ (@.install "<" (@.binary float//<))
)))
(def: double-procs
- @;Bundle
- (<| (@;prefix "double")
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary double//+))
- (@;install "-" (@;binary double//-))
- (@;install "*" (@;binary double//*))
- (@;install "/" (@;binary double///))
- (@;install "%" (@;binary double//%))
- (@;install "=" (@;binary double//=))
- (@;install "<" (@;binary double//<))
+ @.Bundle
+ (<| (@.prefix "double")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary double//+))
+ (@.install "-" (@.binary double//-))
+ (@.install "*" (@.binary double//*))
+ (@.install "/" (@.binary double///))
+ (@.install "%" (@.binary double//%))
+ (@.install "=" (@.binary double//=))
+ (@.install "<" (@.binary double//<))
)))
(def: char-procs
- @;Bundle
- (<| (@;prefix "char")
- (|> (dict;new text;Hash<Text>)
- (@;install "=" (@;binary char//=))
- (@;install "<" (@;binary char//<))
+ @.Bundle
+ (<| (@.prefix "char")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "=" (@.binary char//=))
+ (@.install "<" (@.binary char//<))
)))
(def: (array//length arrayI)
- @;Unary
- (|>. arrayI
- $i;ARRAYLENGTH
- $i;I2L
- ($i;wrap #$;Long)))
+ @.Unary
+ (|>> arrayI
+ $i.ARRAYLENGTH
+ $i.I2L
+ ($i.wrap #$.Long)))
(def: (array//new proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Nat level)] [_ (#;Text class)] lengthS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Nat level)] [_ (#.Text class)] lengthS))
+ (do macro.Monad<Meta>
[lengthI (translate lengthS)
- #let [arrayJT ($t;array level (case class
- "boolean" $t;boolean
- "byte" $t;byte
- "short" $t;short
- "int" $t;int
- "long" $t;long
- "float" $t;float
- "double" $t;double
- "char" $t;char
- _ ($t;class class (list))))]]
- (wrap (|>. lengthI
- ($i;unwrap #$;Long)
- $i;L2I
- ($i;array arrayJT))))
+ #let [arrayJT ($t.array level (case class
+ "boolean" $t.boolean
+ "byte" $t.byte
+ "short" $t.short
+ "int" $t.int
+ "long" $t.long
+ "float" $t.float
+ "double" $t.double
+ "char" $t.char
+ _ ($t.class class (list))))]]
+ (wrap (|>> lengthI
+ ($i.unwrap #$.Long)
+ $i.L2I
+ ($i.array arrayJT))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (array//read proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] idxS arrayS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] idxS arrayS))
+ (do macro.Monad<Meta>
[arrayI (translate arrayS)
idxI (translate idxS)
#let [loadI (case class
- "boolean" (|>. $i;BALOAD ($i;wrap #$;Boolean))
- "byte" (|>. $i;BALOAD ($i;wrap #$;Byte))
- "short" (|>. $i;SALOAD ($i;wrap #$;Short))
- "int" (|>. $i;IALOAD ($i;wrap #$;Int))
- "long" (|>. $i;LALOAD ($i;wrap #$;Long))
- "float" (|>. $i;FALOAD ($i;wrap #$;Float))
- "double" (|>. $i;DALOAD ($i;wrap #$;Double))
- "char" (|>. $i;CALOAD ($i;wrap #$;Char))
- _ $i;AALOAD)]]
- (wrap (|>. arrayI
+ "boolean" (|>> $i.BALOAD ($i.wrap #$.Boolean))
+ "byte" (|>> $i.BALOAD ($i.wrap #$.Byte))
+ "short" (|>> $i.SALOAD ($i.wrap #$.Short))
+ "int" (|>> $i.IALOAD ($i.wrap #$.Int))
+ "long" (|>> $i.LALOAD ($i.wrap #$.Long))
+ "float" (|>> $i.FALOAD ($i.wrap #$.Float))
+ "double" (|>> $i.DALOAD ($i.wrap #$.Double))
+ "char" (|>> $i.CALOAD ($i.wrap #$.Char))
+ _ $i.AALOAD)]]
+ (wrap (|>> arrayI
idxI
- ($i;unwrap #$;Long)
- $i;L2I
+ ($i.unwrap #$.Long)
+ $i.L2I
loadI)))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (array//write proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] idxS valueS arrayS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] idxS valueS arrayS))
+ (do macro.Monad<Meta>
[arrayI (translate arrayS)
idxI (translate idxS)
valueI (translate valueS)
#let [storeI (case class
- "boolean" (|>. ($i;unwrap #$;Boolean) $i;BASTORE)
- "byte" (|>. ($i;unwrap #$;Byte) $i;BASTORE)
- "short" (|>. ($i;unwrap #$;Short) $i;SASTORE)
- "int" (|>. ($i;unwrap #$;Int) $i;IASTORE)
- "long" (|>. ($i;unwrap #$;Long) $i;LASTORE)
- "float" (|>. ($i;unwrap #$;Float) $i;FASTORE)
- "double" (|>. ($i;unwrap #$;Double) $i;DASTORE)
- "char" (|>. ($i;unwrap #$;Char) $i;CASTORE)
- _ $i;AASTORE)]]
- (wrap (|>. arrayI
- $i;DUP
+ "boolean" (|>> ($i.unwrap #$.Boolean) $i.BASTORE)
+ "byte" (|>> ($i.unwrap #$.Byte) $i.BASTORE)
+ "short" (|>> ($i.unwrap #$.Short) $i.SASTORE)
+ "int" (|>> ($i.unwrap #$.Int) $i.IASTORE)
+ "long" (|>> ($i.unwrap #$.Long) $i.LASTORE)
+ "float" (|>> ($i.unwrap #$.Float) $i.FASTORE)
+ "double" (|>> ($i.unwrap #$.Double) $i.DASTORE)
+ "char" (|>> ($i.unwrap #$.Char) $i.CASTORE)
+ _ $i.AASTORE)]]
+ (wrap (|>> arrayI
+ $i.DUP
idxI
- ($i;unwrap #$;Long)
- $i;L2I
+ ($i.unwrap #$.Long)
+ $i.L2I
valueI
storeI)))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: array-procs
- @;Bundle
- (<| (@;prefix "array")
- (|> (dict;new text;Hash<Text>)
- (@;install "length" (@;unary array//length))
- (@;install "new" array//new)
- (@;install "read" array//read)
- (@;install "write" array//write)
+ @.Bundle
+ (<| (@.prefix "array")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "length" (@.unary array//length))
+ (@.install "new" array//new)
+ (@.install "read" array//read)
+ (@.install "write" array//write)
)))
(def: (object//null _)
- @;Nullary
- $i;NULL)
+ @.Nullary
+ $i.NULL)
(def: (object//null? objectI)
- @;Unary
- (<| $i;with-label (function [@then])
- $i;with-label (function [@end])
- (|>. objectI
- ($i;IFNULL @then)
- ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
- ($i;GOTO @end)
- ($i;label @then)
- ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
- ($i;label @end))))
+ @.Unary
+ (<| $i.with-label (function [@then])
+ $i.with-label (function [@end])
+ (|>> objectI
+ ($i.IFNULL @then)
+ ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+ ($i.GOTO @end)
+ ($i.label @then)
+ ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+ ($i.label @end))))
(def: (object//synchronized [monitorI exprI])
- @;Binary
- (|>. monitorI
- $i;DUP
- $i;MONITORENTER
+ @.Binary
+ (|>> monitorI
+ $i.DUP
+ $i.MONITORENTER
exprI
- $i;SWAP
- $i;MONITOREXIT))
+ $i.SWAP
+ $i.MONITOREXIT))
(def: (object//throw exceptionI)
- @;Unary
- (|>. exceptionI
- $i;ATHROW))
+ @.Unary
+ (|>> exceptionI
+ $i.ATHROW))
(def: (object//class proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)]))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)]))
+ (do macro.Monad<Meta>
[]
- (wrap (|>. ($i;string class)
- ($i;INVOKESTATIC "java.lang.Class" "forName"
- ($t;method (list ($t;class "java.lang.String" (list)))
- (#;Some ($t;class "java.lang.Class" (list)))
+ (wrap (|>> ($i.string class)
+ ($i.INVOKESTATIC "java.lang.Class" "forName"
+ ($t.method (list ($t.class "java.lang.String" (list)))
+ (#.Some ($t.class "java.lang.Class" (list)))
(list))
false))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (object//instance? proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] objectS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] objectS))
+ (do macro.Monad<Meta>
[objectI (translate objectS)]
- (wrap (|>. objectI
- ($i;INSTANCEOF class)
- ($i;wrap #$;Boolean))))
+ (wrap (|>> objectI
+ ($i.INSTANCEOF class)
+ ($i.wrap #$.Boolean))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: object-procs
- @;Bundle
- (<| (@;prefix "object")
- (|> (dict;new text;Hash<Text>)
- (@;install "null" (@;nullary object//null))
- (@;install "null?" (@;unary object//null?))
- (@;install "synchronized" (@;binary object//synchronized))
- (@;install "throw" (@;unary object//throw))
- (@;install "class" object//class)
- (@;install "instance?" object//instance?)
+ @.Bundle
+ (<| (@.prefix "object")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "null" (@.nullary object//null))
+ (@.install "null?" (@.unary object//null?))
+ (@.install "synchronized" (@.binary object//synchronized))
+ (@.install "throw" (@.unary object//throw))
+ (@.install "class" object//class)
+ (@.install "instance?" object//instance?)
)))
(def: primitives
- (Dict Text $;Primitive)
- (|> (list ["boolean" #$;Boolean]
- ["byte" #$;Byte]
- ["short" #$;Short]
- ["int" #$;Int]
- ["long" #$;Long]
- ["float" #$;Float]
- ["double" #$;Double]
- ["char" #$;Char])
- (dict;from-list text;Hash<Text>)))
+ (Dict Text $.Primitive)
+ (|> (list ["boolean" #$.Boolean]
+ ["byte" #$.Byte]
+ ["short" #$.Short]
+ ["int" #$.Int]
+ ["long" #$.Long]
+ ["float" #$.Float]
+ ["double" #$.Double]
+ ["char" #$.Char])
+ (dict.from-list text.Hash<Text>)))
(def: (static//get proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)]))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)]))
+ (do macro.Monad<Meta>
[]
- (case (dict;get unboxed primitives)
- (#;Some primitive)
+ (case (dict.get unboxed primitives)
+ (#.Some primitive)
(let [primitive (case unboxed
- "boolean" #$;Boolean
- "byte" #$;Byte
- "short" #$;Short
- "int" #$;Int
- "long" #$;Long
- "float" #$;Float
- "double" #$;Double
- "char" #$;Char
+ "boolean" #$.Boolean
+ "byte" #$.Byte
+ "short" #$.Short
+ "int" #$.Int
+ "long" #$.Long
+ "float" #$.Float
+ "double" #$.Double
+ "char" #$.Char
_ (undefined))]
- (wrap (|>. ($i;GETSTATIC class field (#$;Primitive primitive))
- ($i;wrap primitive))))
+ (wrap (|>> ($i.GETSTATIC class field (#$.Primitive primitive))
+ ($i.wrap primitive))))
- #;None
- (wrap ($i;GETSTATIC class field ($t;class unboxed (list))))))
+ #.None
+ (wrap ($i.GETSTATIC class field ($t.class unboxed (list))))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (static//put proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] valueS))
+ (do macro.Monad<Meta>
[valueI (translate valueS)]
- (case (dict;get unboxed primitives)
- (#;Some primitive)
+ (case (dict.get unboxed primitives)
+ (#.Some primitive)
(let [primitive (case unboxed
- "boolean" #$;Boolean
- "byte" #$;Byte
- "short" #$;Short
- "int" #$;Int
- "long" #$;Long
- "float" #$;Float
- "double" #$;Double
- "char" #$;Char
+ "boolean" #$.Boolean
+ "byte" #$.Byte
+ "short" #$.Short
+ "int" #$.Int
+ "long" #$.Long
+ "float" #$.Float
+ "double" #$.Double
+ "char" #$.Char
_ (undefined))]
- (wrap (|>. valueI
- ($i;unwrap primitive)
- ($i;PUTSTATIC class field (#$;Primitive primitive))
- ($i;string hostL;unit))))
+ (wrap (|>> valueI
+ ($i.unwrap primitive)
+ ($i.PUTSTATIC class field (#$.Primitive primitive))
+ ($i.string hostL.unit))))
- #;None
- (wrap (|>. valueI
- ($i;CHECKCAST class)
- ($i;PUTSTATIC class field ($t;class class (list)))
- ($i;string hostL;unit)))))
+ #.None
+ (wrap (|>> valueI
+ ($i.CHECKCAST class)
+ ($i.PUTSTATIC class field ($t.class class (list)))
+ ($i.string hostL.unit)))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (virtual//get proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] objectS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] objectS))
+ (do macro.Monad<Meta>
[objectI (translate objectS)]
- (case (dict;get unboxed primitives)
- (#;Some primitive)
+ (case (dict.get unboxed primitives)
+ (#.Some primitive)
(let [primitive (case unboxed
- "boolean" #$;Boolean
- "byte" #$;Byte
- "short" #$;Short
- "int" #$;Int
- "long" #$;Long
- "float" #$;Float
- "double" #$;Double
- "char" #$;Char
+ "boolean" #$.Boolean
+ "byte" #$.Byte
+ "short" #$.Short
+ "int" #$.Int
+ "long" #$.Long
+ "float" #$.Float
+ "double" #$.Double
+ "char" #$.Char
_ (undefined))]
- (wrap (|>. objectI
- ($i;CHECKCAST class)
- ($i;GETFIELD class field (#$;Primitive primitive))
- ($i;wrap primitive))))
+ (wrap (|>> objectI
+ ($i.CHECKCAST class)
+ ($i.GETFIELD class field (#$.Primitive primitive))
+ ($i.wrap primitive))))
- #;None
- (wrap (|>. objectI
- ($i;CHECKCAST class)
- ($i;GETFIELD class field ($t;class unboxed (list)))))))
+ #.None
+ (wrap (|>> objectI
+ ($i.CHECKCAST class)
+ ($i.GETFIELD class field ($t.class unboxed (list)))))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (virtual//put proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS objectS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] valueS objectS))
+ (do macro.Monad<Meta>
[valueI (translate valueS)
objectI (translate objectS)]
- (case (dict;get unboxed primitives)
- (#;Some primitive)
+ (case (dict.get unboxed primitives)
+ (#.Some primitive)
(let [primitive (case unboxed
- "boolean" #$;Boolean
- "byte" #$;Byte
- "short" #$;Short
- "int" #$;Int
- "long" #$;Long
- "float" #$;Float
- "double" #$;Double
- "char" #$;Char
+ "boolean" #$.Boolean
+ "byte" #$.Byte
+ "short" #$.Short
+ "int" #$.Int
+ "long" #$.Long
+ "float" #$.Float
+ "double" #$.Double
+ "char" #$.Char
_ (undefined))]
- (wrap (|>. objectI
- ($i;CHECKCAST class)
- $i;DUP
+ (wrap (|>> objectI
+ ($i.CHECKCAST class)
+ $i.DUP
valueI
- ($i;unwrap primitive)
- ($i;PUTFIELD class field (#$;Primitive primitive)))))
+ ($i.unwrap primitive)
+ ($i.PUTFIELD class field (#$.Primitive primitive)))))
- #;None
- (wrap (|>. objectI
- ($i;CHECKCAST class)
- $i;DUP
+ #.None
+ (wrap (|>> objectI
+ ($i.CHECKCAST class)
+ $i.DUP
valueI
- ($i;CHECKCAST unboxed)
- ($i;PUTFIELD class field ($t;class unboxed (list)))))))
+ ($i.CHECKCAST unboxed)
+ ($i.PUTFIELD class field ($t.class unboxed (list)))))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: base-type
- (l;Lexer $;Type)
- ($_ p;either
- (p;after (l;this "boolean") (parser/wrap $t;boolean))
- (p;after (l;this "byte") (parser/wrap $t;byte))
- (p;after (l;this "short") (parser/wrap $t;short))
- (p;after (l;this "int") (parser/wrap $t;int))
- (p;after (l;this "long") (parser/wrap $t;long))
- (p;after (l;this "float") (parser/wrap $t;float))
- (p;after (l;this "double") (parser/wrap $t;double))
- (p;after (l;this "char") (parser/wrap $t;char))
+ (l.Lexer $.Type)
+ ($_ p.either
+ (p.after (l.this "boolean") (parser/wrap $t.boolean))
+ (p.after (l.this "byte") (parser/wrap $t.byte))
+ (p.after (l.this "short") (parser/wrap $t.short))
+ (p.after (l.this "int") (parser/wrap $t.int))
+ (p.after (l.this "long") (parser/wrap $t.long))
+ (p.after (l.this "float") (parser/wrap $t.float))
+ (p.after (l.this "double") (parser/wrap $t.double))
+ (p.after (l.this "char") (parser/wrap $t.char))
(parser/map (function [name]
- ($t;class name (list)))
- (l;many (l;none-of "[")))
+ ($t.class name (list)))
+ (l.many (l.none-of "[")))
))
(def: java-type
- (l;Lexer $;Type)
- (do p;Monad<Parser>
+ (l.Lexer $.Type)
+ (do p.Monad<Parser>
[raw base-type
- nesting (p;some (l;this "[]"))]
- (wrap ($t;array (list;size nesting) raw))))
+ nesting (p.some (l.this "[]"))]
+ (wrap ($t.array (list.size nesting) raw))))
(def: (translate-type argD)
- (-> Text (Meta $;Type))
- (case (l;run argD java-type)
- (#e;Error error)
- (&;throw Invalid-Syntax-For-JVM-Type argD)
+ (-> Text (Meta $.Type))
+ (case (l.run argD java-type)
+ (#e.Error error)
+ (&.throw Invalid-Syntax-For-JVM-Type argD)
- (#e;Success type)
+ (#e.Success type)
(macro/wrap type)))
(def: (prepare-input inputT inputI)
- (-> $;Type $;Inst $;Inst)
+ (-> $.Type $.Inst $.Inst)
(case inputT
- (#$;Primitive primitive)
- (|>. inputI ($i;unwrap primitive))
+ (#$.Primitive primitive)
+ (|>> inputI ($i.unwrap primitive))
- (#$;Generic generic)
+ (#$.Generic generic)
(case generic
- (^or (#$;Var _) (#$;Wildcard _))
- (|>. inputI ($i;CHECKCAST "java.lang.Object"))
+ (^or (#$.Var _) (#$.Wildcard _))
+ (|>> inputI ($i.CHECKCAST "java.lang.Object"))
- (#$;Class class-name _)
- (|>. inputI ($i;CHECKCAST class-name)))
+ (#$.Class class-name _)
+ (|>> inputI ($i.CHECKCAST class-name)))
_
- (|>. inputI ($i;CHECKCAST ($t;descriptor inputT)))))
+ (|>> inputI ($i.CHECKCAST ($t.descriptor inputT)))))
(def: (translate-args translate argsS)
- (-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis)
- (Meta (List [$;Type $;Inst])))
+ (-> (-> ls.Synthesis (Meta $.Inst)) (List ls.Synthesis)
+ (Meta (List [$.Type $.Inst])))
(case argsS
- #;Nil
- (macro/wrap #;Nil)
+ #.Nil
+ (macro/wrap #.Nil)
- (^ (list& [_ (#;Tuple (list [_ (#;Text argD)] argS))] tail))
- (do macro;Monad<Meta>
+ (^ (list& [_ (#.Tuple (list [_ (#.Text argD)] argS))] tail))
+ (do macro.Monad<Meta>
[argT (translate-type argD)
argI (:: @ map (prepare-input argT) (translate argS))
=tail (translate-args translate tail)]
(wrap (list& [argT argI] =tail)))
_
- (&;throw Invalid-Syntax-For-Argument-Generation "")))
+ (&.throw Invalid-Syntax-For-Argument-Generation "")))
(def: (method-return-type description)
- (-> Text (Meta (Maybe $;Type)))
+ (-> Text (Meta (Maybe $.Type)))
(case description
"void"
- (macro/wrap #;None)
+ (macro/wrap #.None)
_
- (macro/map (|>. #;Some) (translate-type description))))
+ (macro/map (|>> #.Some) (translate-type description))))
(def: (prepare-return returnT returnI)
- (-> (Maybe $;Type) $;Inst $;Inst)
+ (-> (Maybe $.Type) $.Inst $.Inst)
(case returnT
- #;None
- (|>. returnI
- ($i;string hostL;unit))
+ #.None
+ (|>> returnI
+ ($i.string hostL.unit))
- (#;Some type)
+ (#.Some type)
(case type
- (#$;Primitive primitive)
- (|>. returnI ($i;wrap primitive))
+ (#$.Primitive primitive)
+ (|>> returnI ($i.wrap primitive))
_
returnI)))
(def: (invoke//static proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list& [_ (#;Text class)] [_ (#;Text method)]
- [_ (#;Text unboxed)] argsS))
- (do macro;Monad<Meta>
+ (^ (list& [_ (#.Text class)] [_ (#.Text method)]
+ [_ (#.Text unboxed)] argsS))
+ (do macro.Monad<Meta>
[argsTI (translate-args translate argsS)
returnT (method-return-type unboxed)
- #let [callI (|>. ($i;fuse (list/map product;right argsTI))
- ($i;INVOKESTATIC class method
- ($t;method (list/map product;left argsTI) returnT (list))
+ #let [callI (|>> ($i.fuse (list/map product.right argsTI))
+ ($i.INVOKESTATIC class method
+ ($t.method (list/map product.left argsTI) returnT (list))
false))]]
(wrap (prepare-return returnT callI)))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(do-template [<name> <invoke> <interface?>]
[(def: (<name> proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list& [_ (#;Text class)] [_ (#;Text method)]
- [_ (#;Text unboxed)] objectS argsS))
- (do macro;Monad<Meta>
+ (^ (list& [_ (#.Text class)] [_ (#.Text method)]
+ [_ (#.Text unboxed)] objectS argsS))
+ (do macro.Monad<Meta>
[objectI (translate objectS)
argsTI (translate-args translate argsS)
returnT (method-return-type unboxed)
- #let [callI (|>. objectI
- ($i;CHECKCAST class)
- ($i;fuse (list/map product;right argsTI))
+ #let [callI (|>> objectI
+ ($i.CHECKCAST class)
+ ($i.fuse (list/map product.right argsTI))
(<invoke> class method
- ($t;method (list/map product;left argsTI) returnT (list))
+ ($t.method (list/map product.left argsTI) returnT (list))
<interface?>))]]
(wrap (prepare-return returnT callI)))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))]
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))]
- [invoke//virtual $i;INVOKEVIRTUAL false]
- [invoke//special $i;INVOKESPECIAL false]
- [invoke//interface $i;INVOKEINTERFACE true]
+ [invoke//virtual $i.INVOKEVIRTUAL false]
+ [invoke//special $i.INVOKESPECIAL false]
+ [invoke//interface $i.INVOKEINTERFACE true]
)
(def: (invoke//constructor proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list& [_ (#;Text class)] argsS))
- (do macro;Monad<Meta>
+ (^ (list& [_ (#.Text class)] argsS))
+ (do macro.Monad<Meta>
[argsTI (translate-args translate argsS)]
- (wrap (|>. ($i;NEW class)
- $i;DUP
- ($i;fuse (list/map product;right argsTI))
- ($i;INVOKESPECIAL class "<init>"
- ($t;method (list/map product;left argsTI) #;None (list))
+ (wrap (|>> ($i.NEW class)
+ $i.DUP
+ ($i.fuse (list/map product.right argsTI))
+ ($i.INVOKESPECIAL class "<init>"
+ ($t.method (list/map product.left argsTI) #.None (list))
false))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: member-procs
- @;Bundle
- (<| (@;prefix "member")
- (|> (dict;new text;Hash<Text>)
- (dict;merge (<| (@;prefix "static")
- (|> (dict;new text;Hash<Text>)
- (@;install "get" static//get)
- (@;install "put" static//put))))
- (dict;merge (<| (@;prefix "virtual")
- (|> (dict;new text;Hash<Text>)
- (@;install "get" virtual//get)
- (@;install "put" virtual//put))))
- (dict;merge (<| (@;prefix "invoke")
- (|> (dict;new text;Hash<Text>)
- (@;install "static" invoke//static)
- (@;install "virtual" invoke//virtual)
- (@;install "special" invoke//special)
- (@;install "interface" invoke//interface)
- (@;install "constructor" invoke//constructor))))
+ @.Bundle
+ (<| (@.prefix "member")
+ (|> (dict.new text.Hash<Text>)
+ (dict.merge (<| (@.prefix "static")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "get" static//get)
+ (@.install "put" static//put))))
+ (dict.merge (<| (@.prefix "virtual")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "get" virtual//get)
+ (@.install "put" virtual//put))))
+ (dict.merge (<| (@.prefix "invoke")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "static" invoke//static)
+ (@.install "virtual" invoke//virtual)
+ (@.install "special" invoke//special)
+ (@.install "interface" invoke//interface)
+ (@.install "constructor" invoke//constructor))))
)))
(def: #export procedures
- @;Bundle
- (<| (@;prefix "jvm")
- (|> (dict;new text;Hash<Text>)
- (dict;merge conversion-procs)
- (dict;merge int-procs)
- (dict;merge long-procs)
- (dict;merge float-procs)
- (dict;merge double-procs)
- (dict;merge char-procs)
- (dict;merge array-procs)
- (dict;merge object-procs)
- (dict;merge member-procs)
+ @.Bundle
+ (<| (@.prefix "jvm")
+ (|> (dict.new text.Hash<Text>)
+ (dict.merge conversion-procs)
+ (dict.merge int-procs)
+ (dict.merge long-procs)
+ (dict.merge float-procs)
+ (dict.merge double-procs)
+ (dict.merge char-procs)
+ (dict.merge array-procs)
+ (dict.merge object-procs)
+ (dict.merge member-procs)
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-24 04:05:47 +0000