aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
diff options
context:
space:
mode:
Diffstat (limited to 'lux-jvm/source/luxc/lang/translation/jvm/runtime.lux')
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/runtime.lux425
1 files changed, 0 insertions, 425 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
deleted file mode 100644
index 76c170725..000000000
--- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
+++ /dev/null
@@ -1,425 +0,0 @@
-(.using
- [library
- [lux {"-" Type Label Primitive try}
- [abstract
- [monad {"+" do}]
- ["[0]" enum]]
- [data
- [binary {"+" Binary}]
- ["[0]" product]
- [text
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]@[0]" functor)]
- ["[0]" sequence]
- ["[0]" set]]]
- ["[0]" math
- [number
- ["n" nat]]]
- [target
- [jvm
- ["[0]" type {"+" Type}
- ["[0]" category {"+" Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method}]
- ["[0]" reflection]]]]
- [tool
- [compiler
- [arity {"+" Arity}]
- ["[0]" phase]
- [language
- [lux
- ["[0]" synthesis]
- ["[0]" generation]]]
- [meta
- [archive {"+" Output}
- ["[0]" artifact]
- ["[0]" registry {"+" Registry}]
- ["[0]" unit]]]]]]]
- [luxc
- [lang
- [host
- ["$" jvm {"+" Label Inst Def Operation}
- ["$d" def]
- ["_" inst]]]]]
- ["[0]" // {"+" ByteCode}])
-
-(def: $Text (type.class "java.lang.String" (list)))
-(def: .public $Lefts type.int)
-(def: .public $Right? (type.class "java.lang.Object" (list)))
-(def: .public $Value (type.class "java.lang.Object" (list)))
-(def: .public $Index type.int)
-(def: .public $Stack (type.array $Value))
-(def: $Throwable (type.class "java.lang.Throwable" (list)))
-
-(def: nullary_init_methodT
- (type.method [(list) (list) type.void (list)]))
-
-(def: throw_methodT
- (type.method [(list) (list) type.void (list)]))
-
-(def: .public logI
- Inst
- (let [PrintStream (type.class "java.io.PrintStream" (list))
- outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream)
- printI (function (_ method)
- (_.INVOKEVIRTUAL PrintStream method (type.method [(list) (list $Value) type.void (list)])))]
- (|>> outI (_.string "LOG: ") (printI "print")
- outI _.SWAP (printI "println"))))
-
-(def: variant_method
- (type.method [(list) (list $Lefts $Right? $Value) //.$Variant (list)]))
-
-(def: .public variantI
- Inst
- (_.INVOKESTATIC //.$Runtime "variant_make" variant_method))
-
-(def: .public leftI
- Inst
- (|>> _.ICONST_0
- _.NULL
- _.DUP2_X1
- _.POP2
- variantI))
-
-(def: .public rightI
- Inst
- (|>> _.ICONST_0
- (_.string "")
- _.DUP2_X1
- _.POP2
- variantI))
-
-(def: .public someI Inst rightI)
-
-(def: .public noneI
- Inst
- (|>> _.ICONST_0
- _.NULL
- (_.string synthesis.unit)
- variantI))
-
-(def: (tryI unsafeI)
- (-> Inst Inst)
- (<| _.with_label (function (_ @from))
- _.with_label (function (_ @to))
- _.with_label (function (_ @handler))
- (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list)))
- (_.label @from)
- unsafeI
- someI
- _.ARETURN
- (_.label @to)
- (_.label @handler)
- noneI
- _.ARETURN)))
-
-(def: .public partials_field Text "partials")
-(def: .public apply_method Text "apply")
-(def: .public num_apply_variants Nat 8)
-
-(def: .public (apply_signature arity)
- (-> Arity (Type Method))
- (type.method [(list) (list.repeated arity $Value) $Value (list)]))
-
-(def: adt_methods
- Def
- (let [store_leftsI (|>> _.DUP _.ICONST_0 (_.ILOAD 0) (_.wrap type.int) _.AASTORE)
- store_flagI (|>> _.DUP _.ICONST_1 (_.ALOAD 1) _.AASTORE)
- store_valueI (|>> _.DUP _.ICONST_2 (_.ALOAD 2) _.AASTORE)]
- (|>> ($d.method {$.#Public} $.staticM "variant_make"
- (type.method [(list) (list $Lefts $Right? $Value) //.$Variant (list)])
- (|>> _.ICONST_3
- (_.ANEWARRAY $Value)
- store_leftsI
- store_flagI
- store_valueI
- _.ARETURN)))))
-
-(def: frac_methods
- Def
- (|>> ($d.method {$.#Public} $.staticM "decode_frac" (type.method [(list) (list $Text) //.$Variant (list)])
- (tryI
- (|>> (_.ALOAD 0)
- (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list) (list $Text) type.double (list)]))
- (_.wrap type.double))))
- ))
-
-(def: (illegal_state_exception message)
- (-> Text Inst)
- (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))]
- (|>> (_.NEW IllegalStateException)
- _.DUP
- (_.string message)
- (_.INVOKESPECIAL IllegalStateException "<init>" (type.method [(list) (list $Text) type.void (list)])))))
-
-(def: pm_methods
- Def
- (let [tuple_sizeI (|>> (_.ALOAD 0)
- _.ARRAYLENGTH)
- last_rightI (|>> tuple_sizeI
- _.ICONST_1
- _.ISUB)
- leftsI (_.ILOAD 1)
- left_indexI leftsI
- sub_leftsI (|>> leftsI
- last_rightI
- _.ISUB)
- sub_tupleI (|>> (_.ALOAD 0)
- last_rightI
- _.AALOAD
- (_.CHECKCAST //.$Tuple))
- recurI (is (-> Label Inst)
- (function (_ @loop)
- (|>> sub_leftsI (_.ISTORE 1)
- sub_tupleI (_.ASTORE 0)
- (_.GOTO @loop))))]
- (|>> ($d.method {$.#Public} $.staticM "pm_fail" throw_methodT
- (|>> (illegal_state_exception "Invalid expression for pattern-matching.")
- _.ATHROW))
- ($d.method {$.#Public} $.staticM "apply_fail" throw_methodT
- (|>> (illegal_state_exception "Error while applying function.")
- _.ATHROW))
- ($d.method {$.#Public} $.staticM "pm_push" (type.method [(list) (list $Stack $Value) $Stack (list)])
- (|>> _.ICONST_2
- (_.ANEWARRAY $Value)
- _.DUP
- _.ICONST_1
- (_.ALOAD 0)
- _.AASTORE
- _.DUP
- _.ICONST_0
- (_.ALOAD 1)
- _.AASTORE
- _.ARETURN))
- ($d.method {$.#Public} $.staticM "pm_variant" (type.method [(list) (list //.$Variant $Lefts $Right?) $Value (list)])
- (<| _.with_label (function (_ @loop))
- _.with_label (function (_ @perfect_match!))
- _.with_label (function (_ @lefts_match!))
- _.with_label (function (_ @maybe_nested))
- _.with_label (function (_ @mismatch!))
- (let [$variant (_.ALOAD 0)
- $lefts (_.ILOAD 1)
- $right? (_.ALOAD 2)
-
- variant_partI (is (-> Nat Inst)
- (function (_ idx)
- (|>> (_.int (.int idx)) _.AALOAD)))
- ::lefts (is Inst
- (|>> (variant_partI 0)
- (_.unwrap type.int)))
- ::right? (variant_partI 1)
- ::value (variant_partI 2)
-
- not_found _.NULL
-
- super_nested_lefts (|>> _.SWAP ... variant::lefts, lefts
- _.ISUB
- (_.int +1)
- _.ISUB)
- super_nested (|>> super_nested_lefts ... super_lefts
- $variant ::right? ... super_lefts, super_right?
- $variant ::value ... super_lefts, super_right?, super_value
- ..variantI)
-
- update_$variant (|>> $variant ::value
- (_.CHECKCAST //.$Variant)
- (_.ASTORE 0))
- update_$lefts (|>> _.ISUB
- (_.int +1)
- _.ISUB)
- iterate! (is (-> Label Inst)
- (function (_ @loop)
- (|>> update_$variant
- update_$lefts
- (_.GOTO @loop))))])
- (|>> $lefts ... lefts
- (_.label @loop)
- $variant ::lefts ... lefts, variant::lefts
- _.DUP2 (_.IF_ICMPEQ @lefts_match!) ... lefts, variant::lefts
- _.DUP2 (_.IF_ICMPGT @maybe_nested) ... lefts, variant::lefts
- $right? (_.IFNULL @mismatch!) ... lefts, variant::lefts
- super_nested ... super_variant
- _.ARETURN
- ...........................
- ...... @lefts_match! ......
- ...........................
- (_.label @lefts_match!) ... lefts, variant::lefts
- $right? ... lefts, variant::lefts, right?
- $variant ::right? ... lefts, variant::lefts, right?, variant::right?
- (_.IF_ACMPEQ @perfect_match!) ... lefts, variant::lefts
- ........................
- ...... @mismatch! ......
- ........................
- (_.label @mismatch!) ... lefts, variant::lefts
- ... _.POP2
- not_found
- _.ARETURN
- (_.label @maybe_nested) ... lefts, variant::lefts
- $variant ::right? ... lefts, variant::lefts, variant::right?
- (_.IFNULL @mismatch!) ... lefts, variant::lefts
- (iterate! @loop)
- .............................
- ...... @perfect_match! ......
- .............................
- (_.label @perfect_match!) ... lefts, variant::lefts
- ... _.POP2
- $variant ::value
- _.ARETURN)))
- ($d.method {$.#Public} $.staticM "tuple_left" (type.method [(list) (list //.$Tuple $Index) $Value (list)])
- (<| _.with_label (function (_ @loop))
- _.with_label (function (_ @recursive))
- (let [left_accessI (|>> (_.ALOAD 0) left_indexI _.AALOAD)])
- (|>> (_.label @loop)
- leftsI last_rightI (_.IF_ICMPGE @recursive)
- left_accessI
- _.ARETURN
- (_.label @recursive)
- ... Recursive
- (recurI @loop))))
- ($d.method {$.#Public} $.staticM "tuple_right" (type.method [(list) (list //.$Tuple $Index) $Value (list)])
- (<| _.with_label (function (_ @loop))
- _.with_label (function (_ @not_tail))
- _.with_label (function (_ @slice))
- (let [right_indexI (|>> leftsI
- _.ICONST_1
- _.IADD)
- right_accessI (|>> (_.ALOAD 0)
- _.SWAP
- _.AALOAD)
- sub_rightI (|>> (_.ALOAD 0)
- right_indexI
- tuple_sizeI
- (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange"
- (type.method [(list)
- (list //.$Tuple $Index $Index)
- //.$Tuple
- (list)])))])
- (|>> (_.label @loop)
- last_rightI right_indexI
- _.DUP2 (_.IF_ICMPNE @not_tail)
- ... _.POP
- right_accessI
- _.ARETURN
- (_.label @not_tail)
- (_.IF_ICMPGT @slice)
- ... Must recurse
- (recurI @loop)
- (_.label @slice)
- sub_rightI
- _.ARETURN
- )))
- )))
-
-(def: .public try
- (type.method [(list) (list //.$Function) //.$Variant (list)]))
-
-(def: io_methods
- Def
- (let [StringWriter (type.class "java.io.StringWriter" (list))
- PrintWriter (type.class "java.io.PrintWriter" (list))
- string_writerI (|>> (_.NEW StringWriter)
- _.DUP
- (_.INVOKESPECIAL StringWriter "<init>" nullary_init_methodT))
- print_writerI (|>> (_.NEW PrintWriter)
- _.SWAP
- _.DUP2
- _.POP
- _.SWAP
- (_.boolean true)
- (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]))
- )]
- (|>> ($d.method {$.#Public} $.staticM "try" ..try
- (<| _.with_label (function (_ @from))
- _.with_label (function (_ @to))
- _.with_label (function (_ @handler))
- (|>> (_.try @from @to @handler $Throwable)
- (_.label @from)
- (_.ALOAD 0)
- _.NULL
- (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature 1))
- rightI
- _.ARETURN
- (_.label @to)
- (_.label @handler)
- string_writerI ... TW
- _.DUP2 ... TWTW
- print_writerI ... TWTP
- (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list) (list (type.class "java.io.PrintWriter" (list))) type.void (list)])) ... TW
- (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) (list) $Text (list)])) ... TS
- _.SWAP _.POP leftI
- _.ARETURN)))
- )))
-
-(def: reflection
- (All (_ category)
- (-> (Type (<| Return' Value' category)) Text))
- (|>> type.reflection reflection.reflection))
-
-(def: runtime_id
- 0)
-
-(def: translate_runtime
- (Operation [artifact.ID (Maybe Text) Binary])
- (let [runtime_class (..reflection //.$Runtime)
- bytecode ($d.class {$.#V1_6} {$.#Public} $.finalC runtime_class (list) (type.class "java.lang.Object" (list)) (list)
- (|>> adt_methods
- frac_methods
- pm_methods
- io_methods))
- directive [runtime_class bytecode]]
- (do phase.monad
- [_ (generation.execute! directive)
- _ (generation.save! ..runtime_id {.#None} directive)]
- (in [..runtime_id {.#None} bytecode]))))
-
-(def: function_id
- 1)
-
-(def: translate_function
- (Operation [artifact.ID (Maybe Text) Binary])
- (let [applyI (|> (enum.range n.enum 2 num_apply_variants)
- (list@each (function (_ arity)
- ($d.method {$.#Public} $.noneM apply_method (apply_signature arity)
- (let [preI (|> (enum.range n.enum 0 (-- arity))
- (list@each _.ALOAD)
- _.fuse)]
- (|>> preI
- (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature (-- arity)))
- (_.CHECKCAST //.$Function)
- (_.ALOAD arity)
- (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature 1))
- _.ARETURN)))))
- (list& ($d.abstract_method {$.#Public} $.noneM apply_method (apply_signature 1)))
- $d.fuse)
- $Object (type.class "java.lang.Object" (list))
- function_class (..reflection //.$Function)
- bytecode ($d.abstract {$.#V1_6} {$.#Public} $.noneC function_class (list) $Object (list)
- (|>> ($d.field {$.#Public} $.finalF partials_field type.int)
- ($d.method {$.#Public} $.noneM "<init>" (type.method [(list) (list type.int) type.void (list)])
- (|>> (_.ALOAD 0)
- (_.INVOKESPECIAL $Object "<init>" nullary_init_methodT)
- (_.ALOAD 0)
- (_.ILOAD 1)
- (_.PUTFIELD //.$Function partials_field type.int)
- _.RETURN))
- applyI))
- directive [function_class bytecode]]
- (do phase.monad
- [_ (generation.execute! directive)
- _ (generation.save! ..function_id {.#None} directive)]
- (in [..function_id {.#None} bytecode]))))
-
-(def: .public translate
- (Operation [Registry Output])
- (do phase.monad
- [runtime_payload ..translate_runtime
- ... function_payload ..translate_function
- ]
- (in [(|> registry.empty
- (registry.resource true unit.none)
- product.right
- ... (registry.resource true unit.none)
- ... product.right
- )
- (sequence.sequence runtime_payload
- ... function_payload
- )])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 22:08:39 +0000