aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/runtime.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.lux387
1 files changed, 0 insertions, 387 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
deleted file mode 100644
index a657a7a38..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
+++ /dev/null
@@ -1,387 +0,0 @@
-(.module:
- [lux (#- Type)
- [abstract
- [monad (#+ do)]]
- [data
- [binary (#+ Binary)]
- ["." product]
- [text
- ["%" format (#+ format)]]
- [collection
- ["." list ("#@." functor)]
- ["." row]]]
- ["." math]
- [target
- [jvm
- ["." type (#+ Type)
- ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)]
- ["." reflection]]]]
- [tool
- [compiler (#+ Output)
- [arity (#+ Arity)]
- ["." phase]
- [language
- [lux
- ["." synthesis]
- ["." generation]]]
- [meta
- [archive
- ["." artifact (#+ Registry)]]]]]]
- [luxc
- [lang
- [host
- ["$" jvm (#+ Label Inst Def Operation)
- ["$d" def]
- ["_" inst]]]]]
- ["." // (#+ ByteCode)])
-
-(def: $Text (type.class "java.lang.String" (list)))
-(def: #export $Tag type.int)
-(def: #export $Flag (type.class "java.lang.Object" (list)))
-(def: #export $Value (type.class "java.lang.Object" (list)))
-(def: #export $Index type.int)
-(def: #export $Stack (type.array $Value))
-(def: $Throwable (type.class "java.lang.Throwable" (list)))
-
-(def: nullary-init-methodT
- (type.method [(list) type.void (list)]))
-
-(def: throw-methodT
- (type.method [(list) type.void (list)]))
-
-(def: #export 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 $Value) type.void (list)])))]
- (|>> outI (_.string "LOG: ") (printI "print")
- outI _.SWAP (printI "println"))))
-
-(def: variant-method
- (type.method [(list $Tag $Flag $Value) //.$Variant (list)]))
-
-(def: #export variantI
- Inst
- (_.INVOKESTATIC //.$Runtime "variant_make" variant-method))
-
-(def: #export leftI
- Inst
- (|>> (_.int +0)
- _.NULL
- _.DUP2_X1
- _.POP2
- variantI))
-
-(def: #export rightI
- Inst
- (|>> (_.int +1)
- (_.string "")
- _.DUP2_X1
- _.POP2
- variantI))
-
-(def: #export someI Inst rightI)
-
-(def: #export noneI
- Inst
- (|>> (_.int +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: #export partials-field Text "partials")
-(def: #export apply-method Text "apply")
-(def: #export num-apply-variants Nat 8)
-
-(def: #export (apply-signature arity)
- (-> Arity (Type Method))
- (type.method [(list.repeat arity $Value) $Value (list)]))
-
-(def: adt-methods
- Def
- (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap type.int) _.AASTORE)
- store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
- store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
- (|>> ($d.method #$.Public $.staticM "variant_make"
- (type.method [(list $Tag $Flag $Value) //.$Variant (list)])
- (|>> (_.int +3)
- (_.ANEWARRAY $Value)
- store-tagI
- store-flagI
- store-valueI
- _.ARETURN)))))
-
-(def: frac-methods
- Def
- (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)])
- (tryI
- (|>> (_.ALOAD 0)
- (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(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 $Text) type.void (list)])))))
-
-(def: pm-methods
- Def
- (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH)
- last-rightI (|>> tuple-sizeI (_.int +1) _.ISUB)
- leftsI (_.ILOAD 1)
- left-indexI leftsI
- sub-leftsI (|>> leftsI
- last-rightI
- _.ISUB)
- sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST //.$Tuple))
- recurI (: (-> 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 $Stack $Value) $Stack (list)])
- (|>> (_.int +2)
- (_.ANEWARRAY $Value)
- _.DUP
- (_.int +1)
- (_.ALOAD 0)
- _.AASTORE
- _.DUP
- (_.int +0)
- (_.ALOAD 1)
- _.AASTORE
- _.ARETURN))
- ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)])
- (<| _.with-label (function (_ @loop))
- _.with-label (function (_ @perfect-match!))
- _.with-label (function (_ @tags-match!))
- _.with-label (function (_ @maybe-nested))
- _.with-label (function (_ @mismatch!))
- (let [$variant (_.ALOAD 0)
- $tag (_.ILOAD 1)
- $last? (_.ALOAD 2)
-
- variant-partI (: (-> Nat Inst)
- (function (_ idx)
- (|>> (_.int (.int idx)) _.AALOAD)))
- ::tag (: Inst
- (|>> (variant-partI 0) (_.unwrap type.int)))
- ::last? (variant-partI 1)
- ::value (variant-partI 2)
-
- super-nested-tag (|>> _.SWAP ## variant::tag, tag
- _.ISUB)
- super-nested (|>> super-nested-tag ## super-tag
- $variant ::last? ## super-tag, super-last
- $variant ::value ## super-tag, super-last, super-value
- ..variantI)
-
- update-$tag _.ISUB
- update-$variant (|>> $variant ::value
- (_.CHECKCAST //.$Variant)
- (_.ASTORE 0))
- iterate! (: (-> Label Inst)
- (function (_ @loop)
- (|>> update-$variant
- update-$tag
- (_.GOTO @loop))))
-
- not-found _.NULL])
- (|>> $tag ## tag
- (_.label @loop)
- $variant ::tag ## tag, variant::tag
- _.DUP2 (_.IF_ICMPEQ @tags-match!) ## tag, variant::tag
- _.DUP2 (_.IF_ICMPGT @maybe-nested) ## tag, variant::tag
- $last? (_.IFNULL @mismatch!) ## tag, variant::tag
- super-nested ## super-variant
- _.ARETURN
- (_.label @tags-match!) ## tag, variant::tag
- $last? ## tag, variant::tag, last?
- $variant ::last? ## tag, variant::tag, last?, variant::last?
- (_.IF_ACMPEQ @perfect-match!) ## tag, variant::tag
- (_.label @maybe-nested) ## tag, variant::tag
- $variant ::last? ## tag, variant::tag, variant::last?
- (_.IFNULL @mismatch!) ## tag, variant::tag
- (iterate! @loop)
- (_.label @perfect-match!) ## tag, variant::tag
- ## _.POP2
- $variant ::value
- _.ARETURN
- (_.label @mismatch!) ## tag, variant::tag
- ## _.POP2
- not-found
- _.ARETURN)))
- ($d.method #$.Public $.staticM "tuple_left" (type.method [(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 //.$Tuple $Index) $Value (list)])
- (<| _.with-label (function (_ @loop))
- _.with-label (function (_ @not-tail))
- _.with-label (function (_ @slice))
- (let [right-indexI (|>> leftsI
- (_.int +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 //.$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: #export try (type.method [(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 (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 (type.class "java.io.PrintWriter" (list))) type.void (list)])) ## TW
- (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)])) ## TS
- _.SWAP _.POP leftI
- _.ARETURN)))
- )))
-
-(def: reflection
- (All [category]
- (-> (Type (<| Return' Value' category)) Text))
- (|>> type.reflection reflection.reflection))
-
-(def: translate-runtime
- (Operation [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))
- payload ["0" bytecode]]
- (do phase.monad
- [_ (generation.execute! runtime-class [runtime-class bytecode])
- _ (generation.save! false ["" "0"] payload)]
- (wrap payload))))
-
-(def: translate-function
- (Operation [Text Binary])
- (let [applyI (|> (list.n/range 2 num-apply-variants)
- (list@map (function (_ arity)
- ($d.method #$.Public $.noneM apply-method (apply-signature arity)
- (let [preI (|> (list.n/range 0 (dec arity))
- (list@map _.ALOAD)
- _.fuse)]
- (|>> preI
- (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature (dec 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 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))
- payload ["1" bytecode]]
- (do phase.monad
- [_ (generation.execute! function-class [function-class bytecode])
- _ (generation.save! false ["" "1"] payload)]
- (wrap payload))))
-
-(def: #export translate
- (Operation [Registry Output])
- (do phase.monad
- [runtime-payload ..translate-runtime
- function-payload ..translate-function]
- (wrap [(|> artifact.empty
- artifact.resource
- product.right
- artifact.resource
- product.right)
- (row.row runtime-payload
- function-payload)])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-12 13:17:28 +0000